Detecção de Fraudes no Tráfego de Cliques em Propagandas de Aplicações Mobile
André Freire
14/09/2019
Este trabalho é parte da conclusão do curso de Big Data Analytics com R e Microsoft Azure Machine Learning da Data Science Academy (https://www.datascienceacademy.com.br/start) e tem como objetivo colocar em prática os conceitos aprendidos durante o curso, sendo uma excelente forma para que o aluno possa descobrir suas dificuldades e ter contato com problemas reais de quem trabalha com ciência de dados ou utiliza análise de dados para resolver problemas de forma geral.
Utilizaremos a linguagem R e seus pacotes para a criação do modelo preditivo e o RMarkdown para apresentar todas as etapas da construção do modelo, o problema está publicado como uma competição do Kaggle e pode ser visualizado no link: (https://www.kaggle.com/c/talkingdata-adtracking-fraud-detection/overview).
Introdução
O risco de fraude está em toda parte, mas para as empresas que anunciam on-line, a fraude de cliques pode ocorrer em um volume esmagador, resultando em dados de cliques enganosos e desperdício de dinheiro. Os canais de anúncios podem aumentar os custos simplesmente clicando no anúncio em larga escala. Com mais de 1 bilhão de dispositivos móveis inteligentes em uso ativo todos os meses, a China é o maior mercado móvel do mundo e, portanto, sofre com grandes volumes de tráfego fraudulento.
O TalkingData, a maior plataforma independente de serviço de big data da China, cobre mais de 70% dos dispositivos móveis ativos em todo o país. Eles processam 3 bilhões de cliques por dia, dos quais 90% são potencialmente fraudulentos. Sua abordagem atual para evitar a fraude de cliques para desenvolvedores de aplicativos é medir a jornada do clique de um usuário em seu portfólio e sinalizar endereços IP que produzem muitos cliques, mas nunca acabam instalando aplicativos. Com essas informações, eles criaram uma lista negra de IP e lista negra de dispositivos.
Apesar de bem-sucedidos, eles querem estar sempre um passo à frente dos fraudadores e procuraram a comunidade Kaggle para obter ajuda no desenvolvimento de sua solução. Na segunda competição com o Kaggle, você é desafiado a criar um algoritmo que prevê se um usuário fará o download de um aplicativo depois de clicar em um anúncio de aplicativo para celular. Para dar suporte à sua modelagem, eles forneceram um conjunto de dados generoso, cobrindo aproximadamente 200 milhões de cliques em 4 dias!
Avaliação
O método de avaliação utilizado para o modelo preditivo será a curva ROC entre o valor previsto e o valor real observado.
Dicionário de dados
Cada linha dos dados de treinamento contém um registro de clique, com os seguintes atributos:
- ip: endereço IP do clique.
- app: ID do aplicativo para marketing.
- device: ID do tipo de dispositivo do celular do usuário (por exemplo, iphone 6 plus, iphone 7, huawei mate 7 etc.)
- os: ID da versão do telefone móvel do usuário
- channel: ID do canal do editor de anúncios para celular
- click_time: registro de data e hora do clique (UTC)
- attribute_time: se o usuário baixar o aplicativo depois de clicar em um anúncio, este é o horário do download do aplicativo
- is_attributed: o destino a ser previsto, indicando que o aplicativo foi baixado
As colunas ip, app, dispositivo, so e canal estão codificadas.
Os dados do teste são semelhantes, com as seguintes diferenças:
- click_id: referência para fazer previsões
- is_attributed: não incluso, pois são esses os valores que queremos prever
Coleta de dados
# Dados de treino
glimpse(treino)## Observations: 100,000
## Variables: 8
## $ ip <int> 87540, 105560, 101424, 94584, 68413, 93663, 17...
## $ app <int> 12, 25, 12, 13, 12, 3, 1, 9, 2, 3, 3, 3, 3, 6,...
## $ device <int> 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 2...
## $ os <int> 13, 17, 19, 13, 1, 17, 17, 25, 22, 19, 22, 13,...
## $ channel <int> 497, 259, 212, 477, 178, 115, 135, 442, 364, 1...
## $ click_time <fct> 2017-11-07 09:30:38, 2017-11-07 13:40:27, 2017...
## $ attributed_time <fct> , , , , , , , , , , , , , , , , , , , , , , , ,
## $ is_attributed <int> 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0...# Dados de teste
glimpse(teste)## Observations: 18,790,469
## Variables: 7
## $ click_id <int> 0, 1, 2, 3, 4, 5, 6, 7, 9, 8, 10, 11, 12, 13, 14, 1...
## $ ip <int> 5744, 119901, 72287, 78477, 123080, 110769, 12540, ...
## $ app <int> 9, 9, 21, 15, 12, 18, 3, 27, 18, 12, 26, 3, 12, 9, ...
## $ device <int> 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ...
## $ os <int> 3, 3, 19, 13, 13, 13, 1, 19, 10, 53, 19, 19, 13, 13...
## $ channel <int> 107, 466, 128, 111, 328, 107, 137, 153, 107, 424, 4...
## $ click_time <fct> 2017-11-10 04:00:00, 2017-11-10 04:00:00, 2017-11-1...Pré-processamento
Vamos começar realizando um pouco de engenharia de atributos (Feature engineering), criando novos atributos (colunas no nosso conjunto de dados) e posteriormente avaliaremos quais serão os atributos com maior importância para a resolução do nosso problema (Feature selection)
#Transformando colunas fatores em POSIXct
# dados de treino
treino$click_time <- as.POSIXct(treino$click_time)
# dados de teste
teste$click_time <- as.POSIXct(teste$click_time)# Criando novas variáveis e eliminando as que não vou mais utilizar
# dados de treino
treino01 <- treino %>%
select(-c(attributed_time)) %>%
mutate(diaSemana = weekdays(click_time), hora = hour(click_time)) %>%
select(-c(click_time)) %>%
add_count(ip, diaSemana, hora) %>% rename("ip_diaSem_h" = n) %>%
add_count(ip, hora, channel) %>% rename("ip_h_chan" = n) %>%
add_count(ip, hora, os) %>% rename("ip_h_os" = n) %>%
add_count(ip, hora, app) %>% rename("ip_h_app" = n) %>%
add_count(ip, hora, device) %>% rename("ip_h_dev" = n) %>%
select(-c(ip))# Realizando as mesmas operações para os dados de teste
teste01 <- teste %>%
mutate(diaSemana = weekdays(click_time), hora = hour(click_time)) %>%
select(-c(click_time)) %>%
add_count(ip, diaSemana, hora) %>% rename("ip_diaSem_h" = n) %>%
add_count(ip, hora, channel) %>% rename("ip_h_chan" = n) %>%
add_count(ip, hora, os) %>% rename("ip_h_os" = n) %>%
add_count(ip, hora, app) %>% rename("ip_h_app" = n) %>%
add_count(ip, hora, device) %>% rename("ip_h_dev" = n) %>%
select(-c(ip))# Transformando variáveis categóricas em fator
treino01$is_attributed <- as.factor(treino01$is_attributed)
treino01$diaSemana <- as.factor(treino01$diaSemana)
teste01$diaSemana <- as.factor(teste01$diaSemana)Valores nulos
Vamos agora verificar a existência de valores nulos entre os nossos dados.
# Contagem de valores nulos por coluna nos dados de treino
colSums(is.na(treino01))## app device os channel is_attributed
## 0 0 0 0 0
## diaSemana hora ip_diaSem_h ip_h_chan ip_h_os
## 0 0 0 0 0
## ip_h_app ip_h_dev
## 0 0# Contagem de valores nulos por coluna nos dados de teste
colSums(is.na(teste01))## click_id app device os channel diaSemana
## 0 0 0 0 0 0
## hora ip_diaSem_h ip_h_chan ip_h_os ip_h_app ip_h_dev
## 0 0 0 0 0 0O problema do balanceamento
Para que o aprendizado seja realizado da melhor maneira possível e o modelo não aprenda mais informações sobre uma classe do que outra, devemos garantir que os dados estejam balanceados, ou seja, possuir aproximadamente o mesmo número de observações para cada classe que queremos prever.
# Proporção original
table(treino01$is_attributed)##
## 0 1
## 99773 227Podemos ver que o número de observações da classe “0” (app não baixad) é muito maior do que o número de classes “1” (app baixado), vamos utilizar a função SMOTE do pacote DMwR para realizar o balanceamentoe e resolver o problema.
treino01 <- SMOTE(is_attributed ~ ., as.data.frame(treino01), k = 3, perc.over = 400, perc.under = 150)# Verificando a nova proporção
table(treino01$is_attributed)##
## 0 1
## 1362 1135Seleção de variáveis
Vamos utilizar eliminação recursiva de atributos para nos ajudar a escolher quais colunas vamos utilizar para a criação do modelo preditivo. Basicamente, um modelo é criado e ajustado aos dados. Então, com os coeficientes criados para cada atributo, eliminamos o que possui o menor coeficiente ou importância, o processo é repetido até alcançarmos um número predeterminado de atributos ou por algum outro critério que definirmos.
# Separando os dados com as classes que quero prever
treino_rfe <- treino01[-5]
# Definindo o objeto de controle para o modelo de seleção de variáveis
controle <- rfeControl(functions = rfFuncs, method = "cv", number = 10)
# Rodando o algoritmo RFE (Eliminação recursiva de atributos)
resultados <- rfe(treino_rfe, treino01$is_attributed, sizes = c(1:11), rfeControl = controle)# Resumo dos resultados
print(resultados)##
## Recursive feature selection
##
## Outer resampling method: Cross-Validated (10 fold)
##
## Resampling performance over subset size:
##
## Variables Accuracy Kappa AccuracySD KappaSD Selected
## 1 0.9612 0.9213 0.009999 0.02044
## 2 0.9575 0.9139 0.018904 0.03869
## 3 0.9459 0.8902 0.017370 0.03555
## 4 0.9619 0.9229 0.014035 0.02854
## 5 0.9692 0.9376 0.013087 0.02652 *
## 6 0.9680 0.9352 0.013465 0.02728
## 7 0.9636 0.9263 0.014411 0.02921
## 8 0.9588 0.9165 0.013990 0.02831
## 9 0.9640 0.9271 0.013079 0.02648
## 10 0.9628 0.9246 0.014120 0.02864
## 11 0.9612 0.9214 0.013597 0.02753
##
## The top 5 variables (out of 5):
## app, channel, device, os, hora# Lista com as variáveis escolhidas
predictors(resultados)## [1] "app" "channel" "device" "os" "hora"# Plotando os resultados
plot(resultados, type=c("g", "o"))
As variáveis escolhidas são aquelas que geraram um modelo com a maior acurácia, e são elas que vamos utilizar para criar modelo preditivo.
Modelagem preditiva
Vamos dividir os nossos dados de treino e comparar o desempenho entre diversos algoritmos, escolheremos o melhor entre eles, lembrando que o método de avaliação é a cuva ROC.
Split de dados
# As colunas utilizadas serão as calculadas pelo método rfe
cols <- predictors(resultados)
treino_rfe_cols <- treino01[cols]
treino_rfe_cols$is_attributed <- treino01$is_attributed
split <- createDataPartition(y = treino_rfe_cols$is_attributed, p = 0.7, list = FALSE)# Criando dados de treino e teste (utilizando o conjunto de dados de treino inicial)
treino_set <- treino_rfe_cols[split, ]
teste_set <- treino_rfe_cols[-split, ]# Verificando a proporção das classes nos dados de treino
round(prop.table(table(treino_set$is_attributed)),2)##
## 0 1
## 0.55 0.45# Verificando a proporção das classes nos dados de teste
round(prop.table(table(teste_set$is_attributed)),2)##
## 0 1
## 0.55 0.45Tudo certo, podemos começar a criação dos modelos.
Criação e treinamento dos modelos
SVM - Support Vector Machine
# Criando e treinando o modelo
svmModel <- train(is_attributed ~ ., data = treino_set,
method = "svmPoly",
tuneGrid = data.frame(degree = 1,
scale = 1,
C = 1),
preProcess = c("pca","scale","center"),
na.action = na.omit)
# Realizando previsões
SVMPredictions <-predict(svmModel, teste_set)
# Confusion Matrix
print(confusionMatrix(SVMPredictions, teste_set$is_attributed))## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 329 122
## 1 79 218
##
## Accuracy : 0.7313
## 95% CI : (0.698, 0.7628)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4523
##
## Mcnemar's Test P-Value : 0.003052
##
## Sensitivity : 0.8064
## Specificity : 0.6412
## Pos Pred Value : 0.7295
## Neg Pred Value : 0.7340
## Prevalence : 0.5455
## Detection Rate : 0.4398
## Detection Prevalence : 0.6029
## Balanced Accuracy : 0.7238
##
## 'Positive' Class : 0
## # Plotando curva ROC
svmROC <- evalmod(scores = c(SVMPredictions), labels = teste_set$is_attributed)
autoplot(svmROC)
Árvore de Decisão
# Criando e treinando o modelo
DecTreeModel <- train(is_attributed ~ ., data = treino_set,
method = "C5.0",
preProcess=c("scale","center"),
na.action = na.omit)
# Realizando previsões
dtPredictions <-predict(DecTreeModel, teste_set)
# Confusion Matrix
print(confusionMatrix(dtPredictions, teste_set$is_attributed))## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 397 9
## 1 11 331
##
## Accuracy : 0.9733
## 95% CI : (0.959, 0.9836)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.9461
##
## Mcnemar's Test P-Value : 0.8231
##
## Sensitivity : 0.9730
## Specificity : 0.9735
## Pos Pred Value : 0.9778
## Neg Pred Value : 0.9678
## Prevalence : 0.5455
## Detection Rate : 0.5307
## Detection Prevalence : 0.5428
## Balanced Accuracy : 0.9733
##
## 'Positive' Class : 0
## # Plotando curva ROC
decROC <- evalmod(scores = c(dtPredictions), labels = teste_set$is_attributed)
autoplot(decROC)
Random Forest
# Criando e treinando o modelo
RandomFModel <- train(is_attributed~., data = treino_set,
method = "rf",
preProcess=c("scale","center"),
na.action = na.omit)
# Realizando previsões
rfPredictions <- predict(RandomFModel, teste_set)
# Confusion Matrix
print(confusionMatrix(rfPredictions, teste_set$is_attributed))## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 403 15
## 1 5 325
##
## Accuracy : 0.9733
## 95% CI : (0.959, 0.9836)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : < 2e-16
##
## Kappa : 0.9459
##
## Mcnemar's Test P-Value : 0.04417
##
## Sensitivity : 0.9877
## Specificity : 0.9559
## Pos Pred Value : 0.9641
## Neg Pred Value : 0.9848
## Prevalence : 0.5455
## Detection Rate : 0.5388
## Detection Prevalence : 0.5588
## Balanced Accuracy : 0.9718
##
## 'Positive' Class : 0
## # Plotando curva ROC
rfROC <- evalmod(scores = c(rfPredictions), labels = teste_set$is_attributed)
autoplot(rfROC)
KNN
# Criando e treinando o modelo
knnModel <- train(is_attributed~., data = treino_set,
method = "knn",
preProcess=c("scale","center"),
na.action = na.omit)
# Realizando previsões
knnPredictions <-predict(knnModel, teste_set)
# Confusion Matrix
print(confusionMatrix(knnPredictions, teste_set$is_attributed))## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 365 27
## 1 43 313
##
## Accuracy : 0.9064
## 95% CI : (0.8832, 0.9263)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : <2e-16
##
## Kappa : 0.812
##
## Mcnemar's Test P-Value : 0.073
##
## Sensitivity : 0.8946
## Specificity : 0.9206
## Pos Pred Value : 0.9311
## Neg Pred Value : 0.8792
## Prevalence : 0.5455
## Detection Rate : 0.4880
## Detection Prevalence : 0.5241
## Balanced Accuracy : 0.9076
##
## 'Positive' Class : 0
## # Plotando curva ROC
knnROC <- evalmod(scores = c(knnPredictions), labels = teste_set$is_attributed)
autoplot(knnROC)
Regressão Logística
# Criando e treinando o modelo
lgmModel <- train(is_attributed~., data = treino_set,
method = "glm",
preProcess=c("scale","center"),
na.action = na.omit)
# Realizando previsões
lgmPredictions <-predict(lgmModel, teste_set)
# Confusion Matrix
print(confusionMatrix(lgmPredictions, teste_set$is_attributed))## Confusion Matrix and Statistics
##
## Reference
## Prediction 0 1
## 0 329 136
## 1 79 204
##
## Accuracy : 0.7126
## 95% CI : (0.6787, 0.7448)
## No Information Rate : 0.5455
## P-Value [Acc > NIR] : < 2.2e-16
##
## Kappa : 0.4121
##
## Mcnemar's Test P-Value : 0.0001339
##
## Sensitivity : 0.8064
## Specificity : 0.6000
## Pos Pred Value : 0.7075
## Neg Pred Value : 0.7208
## Prevalence : 0.5455
## Detection Rate : 0.4398
## Detection Prevalence : 0.6217
## Balanced Accuracy : 0.7032
##
## 'Positive' Class : 0
## # Plotando curva ROC
lgmROC <- evalmod(scores = c(lgmPredictions), labels = teste_set$is_attributed)
autoplot(knnROC)
Avaliação dos modelos
# Utilizando resamples para comparar modelos
compara_Modelos <- resamples(list(SVM = svmModel, DECT = DecTreeModel, RF = RandomFModel, KNN = knnModel, LGM = lgmModel))# Resumo da performance dos modelos
summary(compara_Modelos)##
## Call:
## summary.resamples(object = compara_Modelos)
##
## Models: SVM, DECT, RF, KNN, LGM
## Number of resamples: 25
##
## Accuracy
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## SVM 0.6697531 0.7065217 0.7303371 0.7244368 0.7402799 0.7635468 0
## DECT 0.9318182 0.9478673 0.9515625 0.9520349 0.9578125 0.9665145 0
## RF 0.9348172 0.9500000 0.9527439 0.9522506 0.9570552 0.9650986 0
## KNN 0.8599398 0.8724409 0.8873239 0.8861911 0.8920188 0.9254658 0
## LGM 0.6641566 0.7007634 0.7210031 0.7167957 0.7317460 0.7561350 0
##
## Kappa
## Min. 1st Qu. Median Mean 3rd Qu. Max. NA's
## SVM 0.3238876 0.4051259 0.4482943 0.4371833 0.4704961 0.5182809 0
## DECT 0.8625000 0.8933020 0.9028784 0.9026860 0.9151096 0.9313519 0
## RF 0.8682238 0.8979266 0.9049933 0.9034261 0.9121285 0.9291904 0
## KNN 0.7196048 0.7442483 0.7728471 0.7712524 0.7841657 0.8508209 0
## LGM 0.3128654 0.3909925 0.4269559 0.4217935 0.4510101 0.5033535 0# Comparando de maneira visual
scales <- list(x=list(relation = "free"), y = list(relation = "free"))
bwplot(compara_Modelos, scales = scales)
Podemos ver tanto pela comparação acima quanto pela visualização da curva ROC que o modelo criado com o algoritmo Random Forest e o de árvore de decisão foram os melhores e alcançaram uma boa precisão nos dados utilizados. Podemos agora realizar a previsão nos dados de teste que o kaggle disponibilizou e verificarmos como o nosso modelo irá se sair.
modelo_Escolhido <- RandomFModelRealizando previsões nos dados de teste
# Importando arquivo para colocarmos as previsões
#submission <- read.csv('C:/dataScience/talkingData/sample_submission.csv')
# Realizando previsões nos dados de teste
#previsoes <- predict(modelo_Escolhido, teste01)
#submission$is_attributed <- previsoes
# Criando arquivo csv
#write_csv(submission, "submission.csv")