Introdução

O TalkingData é a maior plataforma de big data da China, ela chega a cobrir cerca de 70% de todos os dispositivos móveis ativos do país. Ela dispõe de diversos serviços para a população. Por ser de grande porte o risco de fraude é alto, o que pode acarretar em um prejuizo financeiro considerável. Este trabalho vai se basear em um caso específico, de download de aplicativos. Funciona da seguinte maneira, um usuário pode anunciar seu aplicativo através da plataforma digital, e ele só recebe retorno financeiro da empresa de acordo com os acessos obtidos. A fraude pode ocorrer quando o usuário, em busca de ter um lucro maior, cria um meio de seu aplicativo receber um grande número de visitas, mas sem realmente instalar o aplicativo.

Objetivo

O objetivo do trabalho é a detecção de possiveis fraudes do ‘TalkingData’, com base no histórico de informações fornecindas. Portanto, o desafio inicial é a criação de um algoritmo que consiga prever a possibilidade do usuário fazer o download depois de clicar em um anúncio do aplicativo para dispositivos móveis.

Metodologia

Em busca de solucionar o problema, serão utilizadas ferramentas capazes de fazer uma estimação precisa e segura com big data. O método de estimação consiste em utilizar maior parte dos dados para aprendizado e a parte restante para validação. Onde a métrica a ser utilizada é a Área sob a Curva ROC, mais comumente chamada de AUC. As técnicas a serem utilizadas serão:

• Regressão Logística;

• Gradiente Boosting Machine;

• Extreme Gradiente Boosting;

• Validação Cruzada.

VAOr <- data.frame(Variável=c("ip", "app", "device", "os", "channel", "click_time", "attributed_time", "is_attributed"),
                   Descrição = c("Endereço ip de clique", "id do aplicativo para marketing", "id tipo de dispositivo do telefone móvel do usuário (por exemplo, iphone 6 plus, iphone 7, huawei mate 7, etc.)", "id da versão do telefone celular do usuário", "ID do canal do editor de anúncios para celular", "timestamp de clique (UTC)", "se o usuário fizer o download do aplicativo depois de clicar em um anúncio, essa é a hora do download do aplicativo", " o alvo a ser previsto, indicando que o aplicativo foi baixado" ))

kable(VAOr) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)

VACriada <- data.frame(Variáveis = c("Hora_cont","Dia", "App_2", "App_3 ", "App_9 ", "App_12 ",  "App_15 ", "OutrosApp", "Device0", "Device1", "Device2", "Device3032", "Device3543",  "Outrosdevice"),
                       Descrição = c("Valor contínuo da hora em que o aplicativo foi acessado", "Dia em que o aplicativo foi acessado", "Flag para indicar quando o aplicativo 2 foi acessado", "Flag para indicar quando o aplicativo 3 foi acessado", "Flag para indicar quando o aplicativo 9 foi acessado", "Flag para indicar quando o aplicativo 12 foi acessado", "Flag para indicar quando o aplicativo 15 foi acessado", "Flag para indicar quando outros aplicativos exceto os informados acima, foram acessados", "Flag para indicar o id do celular = 0 utilizado para acessar o aplicativo", "Flag para indicar o id do celular = 1 utilizado para acessar o aplicativo", "Flag para indicar o id do celular = 2 utilizado para acessar o aplicativo", "Flag para indicar id do celular = 3032 utilizado para acessar o aplicativo", "Flag para indicar id do celular = 3543 utilizado para acessar o aplicativo", "Flag para indicar que foi utilizado um celular com outro numero de id para acessar o aplicativo" ))


kable(VACriada) %>%
  kable_styling(bootstrap_options = "striped", full_width = F)

knitr::opts_chunk$set(echo = TRUE)


# Esse comando deixa a tabela ocupando a folha toda

 #Dados_TRN %>% group_by(ip) %>% count() %>% arrange(-n) %>% ungroup() %>%  top_n(20) %>% kable() %>%
  #kable_styling(bootstrap_options = c("striped", "hover", "condensed"))

# Esse comando comprime os espaços
 Dados_TRN %>% group_by(ip) %>% count() %>% arrange(-n) %>% ungroup() %>%  top_n(20) %>% kable() %>%
  kable_styling(bootstrap_options = "striped", full_width = F)

knitr::opts_chunk$set(echo = TRUE)

 VA_DATA <- data.frame(Data =c("06/11/2017", "07/11/2017", "08/11/2017",  "09/11/2017 " ),
                       Frequência =c(5011, 32393, 34035, 28561) )
   
 
 

VA_DATA %>%
    ggplot(aes(x = Data, y= Frequência)) +
    geom_bar(stat = "identity",fill="#003366", colour="black") +
guides(fill = "none") + #tirou a legenda
    labs(x = "Data", y = "Frequência", title = "Frequência dos dias de acesso") 

knitr::opts_chunk$set(echo = FALSE)


TopFraude <- Dados_TRN_4 %>% group_by(is_attributed) %>% count() %>% arrange(-n) %>%  ungroup() 


TopFraude %>%
    ggplot(aes(x = reorder(is_attributed, -n), y= n)) +
    geom_bar(stat = "identity",fill="#003366", colour="black") +
guides(fill = "none") + #tirou a legenda
    labs(x = "Número do Aplicativo", y = "Frequência", title = "Frequência dos 10 aplicativos mais acessados") +
   geom_label(aes(label = paste(round(n), sep = "")))

knitr::opts_chunk$set(echo = FALSE)


Top10_App_F <- Dados_TRN_4 %>% filter(app == 3 | app == 12 | app == 2 |app == 9 | app == 3 |app == 18 |app == 14 |app == 1 |app == 13 |app == 8)

Top10_App_F$app = as.factor(Top10_App_F$app)
Fraude <- as.factor(Top10_App_F$is_attributed)

ggplot(Top10_App_F, aes(x=app, fill=Fraude)) +
  geom_bar(position = position_dodge(), colour="black")+
 labs(x = "Sobrevivencia", y = "Contagem", title = "Frequência sobre Satisfação", color = "Satisfação") +
  labs(x = "Número do Aplicativo", y = "Frequência", title = "Frequência dos 10 aplicativos mais acessados")

knitr::opts_chunk$set(echo = TRUE)

Top10_Device <- Dados_TRN_4 %>% group_by(device) %>% count() %>% ungroup() %>%  arrange(-n) %>%  top_n(10, n)




#barplot(Top10_Device$n,names.arg = Top10_Device$device, main = "Frequência dos 10 id's de telefone mais utilizados", ylab = "Frequência", xlab = "Número do Aplicativo", ylim = c(0, 95000))


Top10_Device %>%
    ggplot(aes(x = reorder(device, -n), y= n)) +
    geom_bar(stat = "identity",fill="#003366", colour="black") +
guides(fill = "none") + #tirou a legenda
    labs(x = "Número do ID", y = "Frequência", title = "Frequência dos 10 id's de telefone mais utilizados")  +
    geom_label(aes(label = paste(round(n), sep = "")))

knitr::opts_chunk$set(echo = FALSE)


Top10_device_F <- Dados_TRN_4 %>% filter(device == 1 | device == 2 | device == 0 |device == 3032 | device == 3543 |device == 3866 |device == 59 |device == 6 |device == 16 |device == 40)

Top10_device_F$device = as.factor(Top10_device_F$device)
Fraude <- as.factor(Top10_device_F$is_attributed)

ggplot(Top10_device_F, aes(x=device, fill=Fraude)) +
  geom_bar(position = position_dodge(), colour="black")+
 labs(x = "Sobrevivencia", y = "Contagem", title = "Frequência sobre Satisfação", color = "Satisfação") +
  labs(x = "Número do ID", y = "Frequência", title = "Frequência dos 10 id's de telefone mais utilizados")

Desenvolvimento

A base de treinamento será dividida em duas partes tais que, uma conterá 80% de toda a base, chamada de base de treinamento, e a outra conterá os 20% restantes, a qual será chamada de base de validação. O objetivo é fazer um ajuste do modelo, estimando os parâmetros através da base de treinamento e para confirmar se o modelo está fazendo uma previsão correta será utilizada a base de validação para comparar respostas. A métrica utilizada para avaliar o poder de predição dos modelos será dada através valor da AUC, ou seja, a área sob a curva ROC. O modelo que apresentar maior valor de AUC, será considerado o melhor modelo, implicando um maior poder de predição.

Regressão Logística

Ajustando o modelo de regressão logística, onde a variável resposta é is_attributed e as variáveis que se mostraram estatisticamente significativas para o modelo, são: Dia, App_2, App_3, App_9, App_12, App_15, OutrosApp, Device0, Device1, Device2, Device3032, Device3543 e Outrosdevice.

Com base nisso é possível ajustar modelo completo e um reduzido apenas com as variáveis significativas e assim buscar um modelo com melhor previsão. Sendo:

\(Y_i\) = is_attributed;

\(X_1\) = Dia;

\(X_2\) = App_2;

\(X_3\) = App_3;

\(X_4\) = App_9;

\(X_5\) = App_12;

\(X_6\) = App_15;

\(X_7\) = OutrosApp;

\(X_8\) = Device0;

\(X_9\) = Device1;

\(X_{10}\) = Device2;

\(X_{11}\) = Device3032;

\(X_{12}\) = Device3543;

\(X_{13}\) = Outrosdevice;

\(\epsilon_i\) = Erro associado.

Uma proposta inicial para o modelo pode ser representado como:

\(Y_i = \beta_1 X_1 + \beta_2 X_2 + \beta_3 X_3 + \beta_4 X_4 + \beta_5 X_5 + \beta_6 X_6 + \beta_7 X_7 + \beta_8 X_8 + \beta_9 X_9 + \beta_{10} X_{10} + \beta_{11} X_{11} + \beta_{12} X_{12} + \beta_{13} X_{13} + \epsilon_i\)

onde,

\(p_i = \frac 1 { 1 + exp ^ -{\beta_1 X_1 + \beta_2 X_2 + \beta_3 X_3 + \beta_4 X_4 + \beta_5 X_5 + \beta_6 X_6 + \beta_7 X_7 + \beta_8 X_8 + \beta_9 X_9 +\beta_{10} X_{10} + \beta_{11} X_{11} + \beta_{12} X_{12} + \beta_{13} X_{13} + \epsilon_i }}\)

Modelo Reduzido

Após varios testes, e combinações de parâmetros o modelo que apresentou uma melhor previsão é dado por:

\(Y_i = \beta_1 X_1 +\beta_2 X_2 +\beta_3 X_3 +\beta_4 X_4 + \beta_5 X_5 +\beta_6 X_6 +\beta_7 X_7 +\beta_8 X_8 +\beta_9 X_9 +\beta_{10} X_{10} +\beta_{11}X_{11} +\beta_{12} X_{12} +\beta_{13} X_{13} + \epsilon_i\)

knitr::opts_chunk$set(echo = TRUE)


Ajuste_Reduzido_Base_TRN_80 <- glm(is_attributed ~  Hora_Cont + Dia + Device2 + App_3 + Device1 + App_12 +
                                     App_15 + App_9 + OutrosApp - 1
                                   ,data = Base_TRN_80, family=binomial(link="logit")) 

knitr::opts_chunk$set(echo = TRUE)

roc_curve(resultado,truth, estimate) %>% 
 ggplot(aes(x = 1 - specificity, y = sensitivity)) +
  geom_path() +
  geom_abline(lty = 3) +
  coord_equal() +
  annotate("text", x=0.35, y=0.65, label= "AUC = 0.86") +
  ggtitle( "Curva ROC - Regressão Logística")

Para o modelo ajustado, que foi apresentado foi encontrado um valor de \(AUC = 0.86\) o que pode ser considerado como sendo uma boa predição do modelo. Já a matriz de confusão tem a finalidade de identificar o quanto o modelo confundiu uma classe com outra, como por exemplo quantos casos ele acertou quem realmente é fraude ou disse que era fraude, dado que não era uma fraude. O ideal é minimizar ao máximo confundimento do modelo. Com base nisso é possível admitir que a medida que o modelo se torna mais acertivo, aumenta o valor de \(AUC\) a ser obtido.

Gradiente Boosting

Na tentativa de melhorar a acertividade do modelo, foi utilizado um método conhecido como Gradiente Boosting, onde serão utilizadas as mesmas bases do modelo anterior, com a diferença que o modelo agora será ajustado utilizando essa nova metodologia.

knitr::opts_chunk$set(echo = TRUE)

roc_curve(resultado_gbm,truth_gbm, estimate_gbm) %>%  #Gráfico da Curva ROC
ggplot(aes(x = 1 - specificity, y = sensitivity)) +
  geom_path() +
  geom_abline(lty = 3) +
  coord_equal() +
  annotate("text", x=0.38, y=0.65, label= "AUC = 0.86") +
  ggtitle( "Curva ROC - Gradiente Boosting")

Através do ajuste a partir do Gradiente Boosting é observado um valor de \(AUC = 0.86\), ou seja, é possível concluir que o valor da área sob a curva ROC é a mesma para ambos os casos, implicando consistencia no modelo.

Extreme Gradient Boosting (XGB)

knitr::opts_chunk$set(echo = TRUE)

roc_curve(resultado_xgb,truth_xgb, estimate_xgb) %>% #Gráfico da Curva ROC%>% 
 ggplot(aes(x = 1 - specificity, y = sensitivity)) +
  geom_path() +
  geom_abline(lty = 3) +
  coord_equal() +
  annotate("text", x=0.35, y=0.65, label= "AUC = 0.86") +
  ggtitle( "Curva ROC - XGB")

Ajustando o modelo através do Extreme Gradiente Boosting é observado um valor de \(AUC = 0.86\), ou seja, é possível concluir que o valor da área sob a curva ROC permanece igual, implicando consistencia no modelo.

Validação Cruzada

knitr::opts_chunk$set(echo = TRUE)

roc_curve(resultado_cv,truth_cv, estimate_cv) %>% #Gráfico da Curva ROC
ggplot(aes(x = 1 - specificity, y = sensitivity)) +
  geom_path() +
  geom_abline(lty = 3) +
  coord_equal() +
  annotate("text", x=0.38, y=0.65, label= "AUC = 0.87") +
  ggtitle( "Curva ROC - Validação Cruzada")

Ajustando o modelo através do método de Validação Cruzada pode ser observado um valor de \(AUC = 0.87\), ou seja, é possível notar um pequeno aumento no valor da área sob a curva roc o que pode implicar que esse método pode ser um pouco mais preciso em termos de previsão.

Comparação entre os Modelos

knitr::opts_chunk$set(echo = TRUE)

Mod_RL <- roc_curve(resultado,truth, estimate)
Mod_RL$Modelo <- "Reg Logística"


Mod_GB <- roc_curve(resultado_gbm,truth_gbm, estimate_gbm)
Mod_GB$Modelo <- "GBM"

Mod_XGB <- roc_curve(resultado_xgb,truth_xgb, estimate_xgb)
Mod_XGB$Modelo <- "XGB"

Mod_CV <- roc_curve(resultado_cv,truth_cv, estimate_cv)
Mod_CV$Modelo <- "CV"



base <- bind_rows(Mod_RL, Mod_GB) %>% bind_rows(Mod_XGB) %>% bind_rows(Mod_CV)
base %>% ggplot(aes(x = 1 - specificity, y = sensitivity, color = Modelo)) +
geom_path() +
geom_abline(lty = 3) +
coord_equal() +
ggtitle( "Curva ROC - Comparação dos Modelos")

A previsão do modelo é semelhante independente do método utilizado, isso é um bom sinal pois implica que o poder de predição do modelo é consistente, ou seja, qualquer técnica utilizada trará bons resultados. Entretanto como visto anteriormente a previsão através da “Validação cruzada” teve um pequeno aumento no valor da AUC, o que pode tornar essa técnica como sendo considerada a melhor para esse problema de detecção de fraude.

Referências Bibliográficas

• TalkingData AdTracking Fraud Detection Challenge. Acesso em 7 de maio de 2019. Disponível em https://www.kaggle.com/c/talkingdata-adtracking-fraud-detection

• Regressão Logística - Portal Action. Acesso em 15 de junho de 2019. Disponível em http://www.portalaction.com.br/analise-de-regressao/411-modelo-estatistico

• Aumento de Gradiente - Wikipédia. Acesso em 15 de junho de 2019. Disponível em https://en.wikipedia.org/wiki/Gradient_boosting

• Validação Cruzada - Wikipédia. Acesso em 15 de Junho de 2019. Disponível em https://pt.wikipedia.org/wiki/Valida%C3%A7%C3%A3o_cruzada

• Entenda o que é AUC e ROC nos modelos de Machine Learning - A Medium Corporation. Acesso em 16 de Junho de 2019. Disponível em https://medium.com/bio-data-blog/entenda-o-que-%C3%A9-auc-e-roc-nos-modelos-de-machine-learning-8191fb4df772