TalkingData AdTracking Fraud Detection Challenge¶
06 de março, 2020
1. Descrição geral do problema¶
O risco de fraude está em toda parte, mas para as empresas que anunciam online, a fraude de cliques pode acontecer em um volume avassalador, resultando em dados de cliques enganosos e dinheiro desperdiçado. Os canais de anúncios podem aumentar os custos simplesmente quando pessoas ou bots clicam nos anúncios em grande escala, o que na prática não gera o resultado esperado. Com mais de 1 bilhão de dispositivos móveis em uso todos os meses, a China é o maior mercado móvel do mundo e, portanto, sofre com grandes volumes de tráfego fraudulento.
A TalkingData, a maior plataforma de Big Data independente da China, cobre mais de 70% dos dispositivos móveis ativos em todo o país. Eles lidam com 3 bilhões de cliques por dia, dos quais 90% são potencialmente fraudulentos. Sua abordagem atual para impedir fraudes de cliques para desenvolvedores de aplicativos é medir a jornada do clique de um usuário em todo o 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 IPs e uma lista negra de dispositivos.
Embora bem-sucedidos, eles querem estar sempre um passo à frente dos fraudadores e desejam desenvolver ainda mais a solução a partir da criação de um algoritmo que possa prever se um usuário fará o download de um aplicativo depois de clicar em um anúncio de aplicativo para dispositivos móveis.
Objetivo: Em resumo, neste projeto, iremos construir um modelo de aprendizado de máquina para determinar se um clique é fraudulento ou não. Para a construção desse projeto, utilizaremos a linguagem R e o dataset disponível no Kaggle em:
2. Carregando dados¶
2.1 Importando bibliotecas necessárias¶
Vamos começar nosso projeto importanto todas as bilbiotecas necessárias para a realização das fases iniciais de exploração e transformação dos dados (data Munging).
# Definindo a oculatação de warnings.
options(warn = -1)
# Caso não possua uma das bibliotecas importadas abaixo, a instale com um dos comandos a seguir:
install.packages('data.table', repos='http://cran.rstudio.com/')
install.packages('bigreadr', repos='http://cran.rstudio.com/')
install.packages('dplyr', repos='http://cran.rstudio.com/')
install.packages('ggplot2', repos='http://cran.rstudio.com/')
install.packages('fasttime', repos='http://cran.rstudio.com/')
install.packages('lubridate', repos='http://cran.rstudio.com/')
# Importando bibliotecas.
library(data.table)
library(bigreadr)
library(dplyr)
library(ggplot2)
library(fasttime)
library(lubridate)
Vamos iniciar nosso projeto carregando os dados de teste e treino. Por serem muito grandes e impedirem seu manuseio em computadores com pouca memória RAM, adotamos a estratégia de dividir os conjuntos de dados originais em 5 partes. Para este processo de fragmentação, utilizamos a ferramenta Git a partir de uma emulação BASH usada para executá-lo a partir da linha de comando.
2.2 Carregando dados de treino¶
Para este dataset, contabilizamos seu número total de linhas com o auxílo da função nlines() do pacote bigreadr sem ter a necessidade de carregar os dados na memória RAM. Em seguida, dividimos o número de linhas por 5.
## Determina o número de linhas do dataset.
#
# Decrementamos o valor retornado em 1 unidade para desconsiderar a linha de cabeçalho (header).
numDeChunks <- 5
totalDeLinhas <- nlines('train.csv') - 1
numMaxLinhasPorChunks <- round(totalDeLinhas / numDeChunks)Como resultado, obtivemos que o número total de cada fragmento do dataset original deve conter 36.980.778 linhas.
Utilizando o comando descrito abaixo no Git bash, realizamos efetivamente a divisão dos dados:
- split train.csv -l 36980778
Vamos visualizar as primeiras linhas de um dos chunks (fragmentos) criados.
# Determinando o nome de cada um dos fragmentos do dataset original.
chunks <- c("train_p1.csv", "train_p2.csv", "train_p3.csv", "train_p4.csv", "train_p5.csv")
# Carregando o primeiro fragmento do conjunto de dados.
chunk <- fread(chunks[1])
# Capturando o nome das colunas do dataset.
cNames <- colnames(chunk)
# Imprimindo as primeiras linhas do dataset.
head(chunk)
# Removendo o dataset da memória.
rm(chunk)
Segundo a documentação referente ao projeto, cada linha dos dados de treinamento contém um registro de clique, com os seguintes recursos:
- ip: define o endereço IP do clique;
- app: é o ID do aplicativo ao qual o anúncio se refere;
- device: é o ID do tipo de dispositivo do celular do usuário (por exemplo, iphone 6 plus, iphone 7, huawei mate 7 etc.);
- os: é o ID da versão do sistema operacional do telefone móvel do usuário;
- channel: é ID do canal do editor de anúncios para celular;
- click_time: é o registro de data e hora do clique (UTC);
- attributed_time: se o usuário baixar o aplicativo após clicar em um anúncio, registra o instante de tempo em que o download do aplicativo foi realizado e;
- is_attributed (Target): é a variável alvo a ser prevista, e indica se o aplicativo foi ou não baixado.
Observação: as variáveis ip, app, device, os, e channel estão codificadas.
2.2.1 Realizando uma análise exploratória nos dados de treino¶
Agora vamos verificar o balanceamento dos dados de treino segundo as classes que devem ser previstas. Ou seja, queremos saber as proporções de registros em que houve ou não um download.
# Contabilizando o número de linhas de cada fragmento segundo a variável target.
countTargetClass <- sapply(chunks, function(c) {
# Carrega o chunk.
chunk <- fread(c, col.names = cNames)
# Elimina linhas duplicadas dentro do conjunto de dados.
chunk <- chunk[!duplicated(chunk), ]
# Retorna a quantidade de linhas que cada classe da variável target contém dentro do chunk.
table(chunk$is_attributed)
})
# Transpondo os resultados obtidos.
chunksSummary <- t(countTargetClass)
# Alterando o nome das colunas.
colnames(chunksSummary) <- c('No', 'Yes')
# Verificando as proporções de registros segundo cada uma das classes da variável target em cada chunk.
prop.table(chunksSummary)
Os resultados obtidos mostram que temos aproximadamente as mesmas proporções de dados para cada classe da variável target em cada um dos chunks. Mas, para facilitar nossa compreensão vamos agrupar estes valores e avaliar as proporções de todo o dataset de treino.
# Somando os resultados de cada coluna da tabela.
totalTargetClass <- sapply(as.data.frame(chunksSummary), sum)
# Exbindo as proporções de cada uma das classes da variável target dentro do dataset de treino.
print(prop.table(totalTargetClass))
Vamos plotar estes resultados em um gráfico.
# Plotando um gráfico de barras para representar as proporções de cada classe da variável is_attributed.
data.frame(Downloaded = c('No', 'Yes'), rows = totalTargetClass) %>%
ggplot(aes(x = Downloaded, y = rows, fill = Downloaded)) +
geom_bar(stat = 'identity') +
labs(title = 'Data distribution for variable is_attributed by yours levels') +
theme_bw()
Há um alto desbalanceamento entre as classes que devemos prever. Cerca de 99,75% dos dados classifica casos em que um indivíduo não realiza o download de um app que está sendo anunciado e em apenas 0,25% o app é baixado.
Essa desproporção é um problema grave para a construção de modelos preditivos pois os fará aprender a identificar mais quando um indivúdo não efetua um download do que quando o faz e deveremos encontrar uma solução para isto.
2.2.2 Balanceando dados de treino¶
Precisamos balancear os dados de treino de maneira que as proporções das classes da variável is_attributed sejam aproximamente iguais. Isto é, precisamos de um dataset que contenha a mesma quantidade de linhas com registros de indivíduos que tenham ou não feito download.
Para solucionar este problema e ainda facilitar o manuseio destes dados na memória RAM, vamos criar um novo conjunto de dados de treino que contenha todos os registros do dataset original em que um download foi efetuado (is_attributed == 1). Com base no número de linhas obtidas na etapa anterior, iremos amostrar os registros do dataset original em que um download não foi efetuado (is_attributed == 0).
# Extraindo de cada chunk as linhas que contenham o registro de um download efetuado (is_attributed == 1).
sapply(chunks, function(c) {
# Carrega um chunk.
chunk <- fread(c, col.names = cNames)
# Remove linhas duplicadas do dataset.
chunk <- chunk[!duplicated(chunk), ]
# Salva em um arquivo .csv as linhas em que is_attributed == 1.
fwrite(chunk[chunk$is_attributed == 1,], 'train.csv', append = TRUE)
# Define uma mensagem a ser retornada.
return('Saved!')
})
# Definindo o número de linhas em que houve download.
classSizeYes <- t(totalTargetClass)[2]
# Defindo o número de linhas em que não houve download que deve ser amostrado de cada chunk.
classSampleSizeNo <- round(classSizeYes / length(chunks))
# Definindo um seed para que o processo de amostragem sempre gere o mesmo resultado.
set.seed(100)
# Amostrando de cada chunk as linhas que contenham o registro de um download não efetuado (is_attributed == 0).
sapply(chunks, function(c) {
# Carrega um chunk.
chunk <- fread(c, col.names = cNames)
# Remove linhas duplicadas do dataset.
chunk <- chunk[!duplicated(chunk), ]
chunk <- chunk[chunk$is_attributed == 0, ]
# Salva em um arquivo .csv as linhas amostradas em que is_attributed == 0.
fwrite(chunk[sample(1:nrow(chunk), classSampleSizeNo),], 'train.csv', append = TRUE)
# Define uma mensagem a ser retornada.
return('Saved!')
})
Vamos carregar o dataset gerado e ver os resultados.
# Carregando dataset.
data = fread('train.csv')
# Verificando o tamanho em Mbs do dataset.
format(object.size(data), units = 'Mb')
# Plotando um gráfico para indicar a proporção de registros para cada classe da variável is_attributed.
data %>%
mutate(Downloaded = factor(is_attributed, labels = c('No', 'Yes'))) %>%
ggplot(aes(x = Downloaded, fill = Downloaded)) +
geom_bar() +
labs(title = 'Data distribution for variable is_attributed by yours levels') +
ylab('rows') +
theme_bw()
Com isso finalizamos a preparação dos dados de treino para a nossa análise e encontramos uma solução para os problemas de memória RAM e desbalanceamento.
2.3 Carregando dados de teste¶
De maneira similar ao que fizemos com o dataset de treino, contabilizamos o número total de linhas do dataset de teste com o auxílo da função nlines() do pacote bigreadr sem ter a necessidade de carregar os dados na memória RAM. Em seguida, dividimos o número de linhas por 5.
## Determina o número de linhas do dataset.
#
# Decrementamos o valor retornado em 1 unidade para desconsiderar a linha de cabeçalho (header).
numDeChunks <- 5
totalDeLinhas <- nlines('test.csv') - 1
numMaxLinhasPorChunks <- round(totalDeLinhas / numDeChunks)Como resultado, obtivemos que o número total de cada fragmento do dataset original deve conter 3.758.094 linhas.
Utilizando o comando descrito abaixo no Git bash, realizamos efetivamente a divisão dos dados:
- split test.csv -l 3758094
Vamos visualizar as primeiras linhas de um dos chunks (fragmentos) criados.
# Determinando o nome de cada um dos fragmentos do dataset original.
chunks <- c("test_p1.csv", "test_p2.csv", "test_p3.csv", "test_p4.csv", "test_p5.csv")
# Carregando o primeiro fragmento do conjunto de dados.
chunk <- fread(chunks[1])
# Imprimindo as primeiras linhas do dataset.
head(chunk)
# Removendo o dataset da memória.
rm(chunk)
Segundo a documentação referente ao projeto, a variável click_id é uma variável auxiliar que é utilizada apenas para identificar as predições a serem submetidas no Kaggle.
3. Análise exploratória dos dados¶
3.1 Visão geral dos dados¶
Nesta etapa vamos buscar entender a disposição e as características dos dados dentro do dataset de treino além de extrair insigths que possam auxiliar no processo de criação do modelo preditivo.
# Verificando os tipos das colunas carregadas do dataset.
glimpse(data)
# Verificando a existência de valores NA no dataset.
sapply(data, function(v) {anyNA(v)} )
Vamos contabilizar o número de valores únicos que as variáveis ip, app, device, os e channel possuem.
# Verificando o número de valores únicos presentes em cada uma das variáveis especificadas.
data[ , .(ip = length(unique(ip)),
app = length(unique(app)),
device = length(unique(device)),
os = length(unique(os)),
channel = length(unique(channel))
)]
Vemos que um IP pode estar relacionado a mais de um registro no dataset, ou seja, podemos ter o registro de um usuário associado a vários anúncios.
Agora iremos analisar as variáveis click_time e attributed_time.
# Verificando os tipos das variáveis.
sapply(data[ , .(click_time, attributed_time)], class)
Embora, estas colunas representem datas. O processo de carregamento dos dados não atribui o tipo de dado correto a estas variáveis. Deveremos realizar este procedimento manualmente.
# Verificando se a variável click_time possui strings vazias.
table(click_time = data$click_time == '')
# Verificando se a variável attributed_time possui strings vazias.
table(attributed_time = data$attributed_time == '')
Note que alguns dos valores da coluna attributed_time estão vazios. Isto ocorre porque esta variável indica o instante de tempo em que o download de um determinado app ocorreu. Caso o download não tenha sido efetuado, o valor da coluna é preenchido com uma string vazia e deveremos tratar isso.
Agora vamos nos certificar de que só existem dois grupos distintos dentro do conjunto de dados da variável que devemos prever.
# Verificando as classes únicas presentes no dataset.
data[ , .(is_attributed = unique(is_attributed))]
Perfeito! Só existem dois valores distintos dentro do conjunto de dados da variável alvo:
- 1: para os registros em que o download foi realizado e;
- 0: para os registros em que o download não foi realizado.
3.2 Data Munging¶
Vamos começar tratando as strings vazias presentes na variável attributed_time e aplicando algumas conversões de tipo de dados em algumas colunas do dataset.
# Alterando strings vazias presentes na variável attributed_time para NA.
data$attributed_time[data$attributed_time == ''] = NA
# Convertendo a variável click_time para o tipo date.
data$click_time <- fastPOSIXct(data$click_time)
# Convertendo a variável attributed_time para o tipo date.
data$attributed_time <- fastPOSIXct(data$attributed_time)
3.3 Avaliando as variáveis de data do dataset¶
Iremos iniciar esta etapa verificando a distribuição das datas em que ocorreram os cliques em anúncios registrados no dataset de treino.
# Verificando a distribuição das datas presentes na variável click_time.
summary(data$click_time)
Vamos verificar a amplitude da variável click_time, ou seja, o período de tempo entre o primeiro e o último registro presente neste conjunto de dados.
# Calculando o período de tempo em que os dados presentes no dataset foram capturados.
max(data$click_time) - min(data$click_time)
Ou seja, temos dados que variam durante um período de aproximadamente 3 dias.
Muito bem, vamos criar um gráfico de séries temporais para verificar a frequência de cliques em anúncios que levaram a downloads a cada 3 horas durante esse período.
# Criando um gráfico de série temporal para verificar o número de cliques em anúncios por hora que levaram a
# downloads de apps durante o período de tempo obtido no dataset.
data %>%
mutate(datesTrunc = floor_date(click_time, unit = 'hour')) %>%
group_by(datesTrunc) %>%
summarise(downloadsRealized = sum(is_attributed)) %>%
ggplot(aes(x = datesTrunc, y = downloadsRealized)) +
geom_line() +
scale_x_datetime(date_breaks = '3 hours', date_labels = '%d %b - %H') +
theme_bw() +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
xlab('Times of day') +
ylab('Downloads realized') +
labs(title = 'Downloads for hours')
O gráfico demostra que há aproximadamente o mesmo padrão de frequência de downloads durante os 3 dias tendo os maiores números de download entre as 23h e 14h e os menores entre as 17h e 23h.
Criaremos o mesmo tipo de gráfico para verificar a frequência de cliques em anúncios que não levaram a downloads a cada 3 horas durante esse período.
# Criando um gráfico de série temporal para verificar o número de cliques em anúncios por hora que não levaram
# a downloads de apps durante o período de tempo obtido no dataset.
data %>%
mutate(datesTrunc = floor_date(click_time, unit = 'hour')) %>%
group_by(datesTrunc) %>%
summarise(unrealizedDownloads = sum(!is_attributed)) %>%
ggplot(aes(x = datesTrunc, y = unrealizedDownloads)) +
geom_line() +
scale_x_datetime(date_breaks = '3 hours', date_labels = '%d %b - %H') +
theme_bw() +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
xlab('Times of day') +
ylab('Unrealized downloads') +
labs(title = 'Unrealized downloads for hours')
As frequência de downloads realizados e não realizados parecem seguir a mesma tendência em cada hora de acordo com as horas dos dias.
Vamos plotar as duas séries em um mesmo gráfico para verificar isto.
# Criando um gráfico de série temporal para verificar o número de cliques em anúncios por hora que levaram ou não a
# downloads de apps durante o período de tempo obtido no dataset.
data %>%
mutate(datesTrunc = floor_date(click_time, unit = 'hour')) %>%
group_by(datesTrunc) %>%
summarise(downloadsRealized = sum(is_attributed),
unrealizedDownloads = sum(!is_attributed)) %>%
ggplot() +
geom_line(aes(x = datesTrunc, y = downloadsRealized, color = 'Yes')) +
geom_line(aes(x = datesTrunc, y = unrealizedDownloads, color = 'No')) +
scale_x_datetime(date_breaks = '3 hours', date_labels = '%d %b - %H') +
theme_bw(base_size = 15) +
theme(axis.text.x = element_text(angle = 60, hjust = 1)) +
xlab('Times of day') +
ylab('Is Attributed') +
labs(title = 'Classes in the target variable', colour = 'Downloaded')
Esta similaridade entre estas duas classes mostra os horários em que os anúncios são mais ou menos acessados durante o dia.
4. Feature Engennier¶
Precisamos preparar nosso dataset de treino para a fase de modelagem preditiva. Como a variável attributed_time registra o instante de tempo em que o evento que desejamos prever ocorre, iremos removê-la do nosso conjunto de dados.
Como não é viável manipular diretamente as datas da variável click_time, iremos apenas extrair os dias e as horas de cada registro e armazená-las em novas variáveis (day e hour).
A variável ip apresenta uma grande quantidade de valores únicos em relação as demais variáveis e por isso, iremos apenas utilizá-la indiretamente para a criação de novas variáveis a partir de agrupamentos.
# Criando e removendo variáveis do dataset de treino.
data <- data %>%
select(-c(attributed_time)) %>%
mutate(day = day(click_time), hour = hour(click_time)) %>%
select(-c(click_time)) %>%
add_count(ip, day, hour) %>% rename("ipDayHour" = n) %>%
add_count(ip, hour, channel) %>% rename("ipHourChannel" = n) %>%
add_count(ip, hour, os) %>% rename("ipHourOs" = n) %>%
add_count(ip, hour, app) %>% rename("ipHourApp" = n) %>%
add_count(ip, hour, device) %>% rename("ipHourDevice" = n) %>%
select(-c(ip))
O dataset de teste precisa passar pelo mesmo processo de feature engennier que os dados de treino e é isso que faremos a seguir. Como os dados de teste estão segmentados em chunks deveremos aplicar este procedimento iterativamente em cada um.
# Determinando o nome de cada um dos fragmentos do dataset original.
chunks <- c("test_p1.csv", "test_p2.csv", "test_p3.csv", "test_p4.csv", "test_p5.csv")
# Carregando o primeiro fragmento do conjunto de dados.
chunk <- fread(chunks[1])
# Capturando o nome das colunas do dataset.
cNames <- colnames(chunk)
# Removendo o dataset da memória.
rm(chunk)
# Criando e removendo variáveis de cada chunk do dataset de teste.
sapply(chunks, function(c) {
# Carrega um chunk.
chunk <- fread(c, col.names = cNames)
# Cria e remove variáveis do chunk.
chunk <- chunk %>%
mutate(day = day(click_time), hour = hour(click_time)) %>%
select(-c(click_time)) %>%
add_count(ip, day, hour) %>% rename("ipDayHour" = n) %>%
add_count(ip, hour, channel) %>% rename("ipHourChannel" = n) %>%
add_count(ip, hour, os) %>% rename("ipHourOs" = n) %>%
add_count(ip, hour, app) %>% rename("ipHourApp" = n) %>%
add_count(ip, hour, device) %>% rename("ipHourDevice" = n) %>%
select(-c(ip))
# Salva os resultados dos procedimentos efetuados em um arquivo .csv.
fwrite(chunk, paste('conv_', c, sep = ''), append = TRUE)
return('Saved!')
})
5. Modelagem Preditiva¶
5.1 Importando bibliotecas necessárias¶
Importaremos todas as bibliotecas necessárias para esta fase de modelagem preditiva.
## Caso não possua uma das bibliotecas importadas abaixo, a instale com um dos comandos a seguir:
install.packages('caret', repos='http://cran.rstudio.com/')
install.packages('e1071', repos='http://cran.rstudio.com/')
install.packages('randomForest', repos='http://cran.rstudio.com/')
install.packages('pROC', repos='http://cran.rstudio.com/')
install.packages('C50', repos='http://cran.rstudio.com/')
install.packages('fastAdaboost', repos='http://cran.rstudio.com/')
install.packages('xgboost', repos='http://cran.rstudio.com/')
# Importando bibliotecas.
library(caret)
library(e1071)
library(randomForest)
library(pROC)
library(C50)
library(fastAdaboost)
library(xgboost)
Antes de começarmos, vamos dar uma olhada na forma do dataset que foi gerado após a fase de Feature Engennier. Também salvaremos este novo conjunto de dados para evitar que tenhamos que repetir todas as etapas efetuadas acima caso seja necessário.
Alguns dos algoritmos que iremos utilizar necessitam que a variável target seja do tipo factor, por isso iremos convertê-la a seguir.
# Exibe as primeiras linhas do dataset.
head(data)
# Salva em um arquivo .csv o dataset especificado.
fwrite(data, 'data.csv')
# Convertendo variável target para o tipo factor.
data$is_attributed <- as.factor(data$is_attributed)
5.2 Avaliando a importância das variáveis com o algoritmo Random Forest¶
Antes de iniciarmos a criação dos modelos propriamente dita, é interessante definirmos o quanto cada variável dentro do dataset ajuda a prever o valor da variável target.
Para fazermos isto, utilizaremos o algoritmo Random Forest para computar estes valores. Como não sabemos qual o ajuste de parâmetros do algoritmo é mais adequado para o nosso conjunto de dados, criaremos modelos que possuam de 1 a 15 árvores com 1 a 40 nós.
Salvaremos a acurárica de cada modelo em um Dataframe. Note que por ser um processo de treinamento muito demorado, salvamos os resultados obtidos em um arquivo .csv que pode ser carregado com os resultados gerados pelo bloco de código a seguir.
# Criando o dataframe para salvar os resultados dos modelos.
featuresRF <- data.frame()
# Definindo o número de nós e árvores a serem combinados para a criação de diferentes modelos.
nTrees <- 1:15
nNodes <- 1:40
# Define o número total de modelos a serem criados.
total <- length(nTrees) * length(nNodes)
# Define uma varíavel auxiliar para permitir o acompanhamento do progresso na avaliação dos modelos criados.
count <- 0
for(t in nTrees) {
for(n in nNodes) {
# Define um seed para permitir que os mesmos resultados dos experimentos sejam reproduzíveis.
set.seed(100)
# Cria o modelo Random Forest a ser avaliado.
model <- randomForest(is_attributed ~ .,
data = data,
ntree = t,
nodesize = n,
importance = T)
# Computa a confusionMatrix gerada a partir do modelo criado.
cm <- confusionMatrix(table(
data = model$y,
reference = model$predicted
))
# Armazena os parâmetros utilizados para criação do modelo e a acurácia obtida no dataframe.
featuresRF <- rbind(featuresRF, data.frame(
nodes = n,
nTree = t,
accuracy = unname(cm$overall['Accuracy'])
))
# Incrementa o número de modelos avaliados.
count <- count + 1
# Imprime a porcetagem de progresso do treinamento e a melhor acurácia já alcançada.
# print(paste(100 * count / total, '%, best accuracy: ', max(featuresRF$accuracy)))
}
}
# Salvando dataframe em um arquivo .csv.
fwrite(featuresRF, 'featuresRF.csv')
Caso deseje carregar os resultados gerados pelo bloco de código anterior:
# Carregando dataframe com os resultados obtidos para cada modelo randomForest criado.
featuresRF <- fread('featuresRF.csv')
Imprimiremos o registro do modelo que apresentou a melhor acurácia.
# Imprimindo registro do modelo que alcançou a maior acurácia.
bestRF <- featuresRF[featuresRF$accuracy == max(featuresRF$accuracy),]
bestRF
Recriaremos este modelo e imprimiremos suas estatísticas.
# Definindo fórmula a ser utilizada pelo modelo.
f <- is_attributed ~ .
# Criando modelo.
model <- randomForest(f,
data = data,
ntree = bestRF$nTree,
nodesize = bestRF$nodes,
importance = T)
# Imprimindo o modelo.
model
Agora podemos plotar o modelo em um gráfico e verificar o nível de importância das variáveis do dataset para prever a variável alvo.
# Plotando gráfico para visualizar o nível de importância de cada variável no processo de predição da variável alvo.
v <- as.data.frame(varImpPlot(model))
Também podemos mensurar numericamente o quanto cada variável auxilia no processo de predição da variável alvo.
# Captura em ordem decrescente de nível de importância o nome das variáveis.
names <- rownames(v[order(v$MeanDecreaseAccuracy, decreasing = T),])
# Imprime o resultado.
v[order(v$MeanDecreaseAccuracy, decreasing = T),]
5.3 Criando modelos preditivos¶
Os modelos não paramêtricos baseados em árvores de decisão tendem a apresentar um bom desempenho em um período de tempo de treinamento muito baixo quando o conjunto de dados é muito grande. Por isso, iremos selecionar 4 algoritmos que sigam esta filosofia, são eles: Random Forest, C 5.0, Adaboost e XGboost. Também utilizaremos o algoritmo Naive Bayes por apresentar uma boa performance no treinamento de modelos com grandes quantidades de dados.
A estratégia que iremos utilizar para o treinamento dos modelos será a de avaliar o desempenho de cada um utilizando os valores padrões que possuem com poucas modificações. Com base nos resultados que forem obtidos, iremos selecionar o melhor e otimizar seus parâmetros.
Como o conjunto de dados de teste não possui a variável target, utilizaremos o dataset de treino para fazer as predições e avaliar o desempenho do modelo, por isso, teremos que tomar mais cuidado com overfiting.
5.3.1 Modelo Naive Bayes¶
# Definindo fórmula a ser utilizada pelo modelo.
f <- is_attributed ~ .
# Criando o modelo baseado no algoritmo Naive Bayes.
model_nb <- naiveBayes(f , data = data)
# Realizando as previsões com o modelo baseado no algoritmo Naive Bayes.
pred <- predict(model_nb, data, type = 'class')
# Criando a Confusion Matrix a partir das previsões.
confusionMatrix(table(pred = pred, data = data$is_attributed))
# Calculando a AUC para o modelo.
nbAuc1 <- auc(roc(as.integer(data$is_attributed), as.integer(pred)))
# Exibe o resultado.
nbAuc1
5.3.1.1 Modelo Naive Bayes com o parâmetro Laplace modificado¶
Tentaremos modificar o valor do argumento laplace do algoritmo com o objetivo de aumentar a acurárica deste modelo com o conjunto de dados de treino.
# Definindo fórmula a ser utilizada pelo modelo.
f <- is_attributed ~ .
# Criando o modelo baseado no algoritmo Naive Bayes.
model_nb <- naiveBayes(f , data = data, laplace = 100)
# Realizando as previsões com o modelo baseado no algoritmo Naive Bayes.
pred <- predict(model_nb, data, type = 'class')
# Criando a Confusion Matrix a partir das previsões.
confusionMatrix(table(pred = pred, data = data$is_attributed))
# Calculando a AUC para o modelo.
nbAuc2 <- auc(roc(as.integer(data$is_attributed), as.integer(pred)))
# Exibe o resultado.
nbAuc2
5.3.2 Modelo Random Forest¶
Vamos utilizar o mesmo número de árvores e nós selecionados durante a etapa de avaliação da importância das variáveis para a construção deste modelo.
# Definindo fórmula a ser utilizada pelo modelo.
f <- is_attributed ~ .
# Criando o modelo baseado no algoritmo Random Forest.
model_rf <- randomForest(f,
ntree = bestRF$nTree,
nodesize = bestRF$nodes,
data = data)
# Realizando as previsões com o modelo baseado no algoritmo Random Forest.
pred <- predict(model_rf, data, type = 'response')
# Criando a Confusion Matrix a partir das previsões.
confusionMatrix(table(pred = pred, data = data$is_attributed))
# Calculando a AUC para o modelo.
rfAuc <- auc(roc(as.integer(data$is_attributed), as.integer(pred)))
# Exibe o resultado.
rfAuc
5.3.3 Modelo C 5.0¶
# Definindo a matriz de custos a ser utilizada pelo modelo.
cost <- matrix(c(0, 1, 1, 0), nrow = 2, dimnames = list(c("No", "Yes"), c("No", "Yes")))
# Visualizando a matriz.
cost
# Definindo fórmula a ser utilizada pelo modelo.
f <- is_attributed ~ .
# Criando o modelo baseado no algoritmo C 5.0.
model_c50 <- C5.0(f, data = data, trials = 100, cost = cost)
# Realizando as previsões com o modelo baseado no algoritmo C 5.0.
pred <- predict(model_c50, data)
# Criando a Confusion Matrix a partir das previsões.
confusionMatrix(table(pred = pred, data = data$is_attributed))
# Calculando a AUC para o modelo.
c50Auc <- auc(roc(as.integer(data$is_attributed), as.integer(pred)))
# Exibe o resultado.
c50Auc
5.3.4 Modelo Adaboost¶
# Definindo fórmula a ser utilizada pelo modelo.
f <- is_attributed ~ .
# Criando o modelo baseado no algoritmo Adaboost.
model_adaboost <- adaboost(formula = f, data = as.data.frame(data), nIter = 15)
# Realizando as previsões com o modelo baseado no algoritmo Adaboost.
pred <- predict(model_adaboost, data, type = 'class')
# Criando a Confusion Matrix a partir das previsões.
confusionMatrix(table(pred = pred$class, data = data$is_attributed))
# Calculando a AUC para o modelo.
adaboostAuc <- auc(roc(as.integer(data$is_attributed), as.integer(pred$class)))
# Exibe o resultado.
adaboostAuc
5.3.5 Modelo XGboost¶
# Criando o modelo baseado no algoritmo XGboost.
model_xgboost <- xgboost(
data = as.matrix(data %>% select(-is_attributed)), # Define as variáveis preditoras.
label = as.matrix(data$is_attributed), # Define a variável target.
max.depth = 40, # Defie o tamanho máximo da árvore.
eta = 1, # Define a taxa de aprendizado do modelo.
nthread = 4, # Define o número de threads que devem ser usadas.
# Quanto maior for esse número, mais rápido será o treinamento.
nrounds = 100, # Define o número de iterações.
objective = "binary:logistic", # Define que o modelo deve ser baseado em uma regressão logistica binária.
verbose = F # Exibe a queda da taxa de erro durante o treinamento.
)
# Realizando as previsões com o modelo baseado no algoritmo XGboost.
pred <- predict(model_xgboost, as.matrix(data %>% select(-is_attributed)))
# Definindo threshold.
th <- 0.5
# Classificando os resultados segundo o threshold especificado.
predClass <- ifelse(pred > th, 1, 0)
# Criando a Confusion Matrix a partir das previsões.
confusionMatrix(table(pred = predClass, data = data$is_attributed))
# Calculando a AUC para o modelo.
xgboostAuc <- auc(roc(as.integer(data$is_attributed), as.integer(predClass)))
# Exibe o resultado.
xgboostAuc
5.3.6 Otimizando o modelo com o melhor desempenho¶
Determinaremos qual modelo teve o melhor desempenho para o conjunto de dados de treino a partir dos valores AUC (Area under cover) gerados por cada um.
# Criando um vetor com os valores AUC obtidos por cada modelo.
aucModels <- c(
nbAuc1 = nbAuc1,
nbAuc2 = nbAuc2,
rfAuc = rfAuc,
c50Auc = c50Auc,
adaboostAuc = adaboostAuc,
xgboostAuc = xgboostAuc
)
# Determinando o maior valor AUC.
head(sort(aucModels, decreasing = T), 1)
Concluímos que o modelo criado com o algoritmo xgboost foi o que apresentou o melhor desempenho. Agora iremos modificar os parâmetros deste algoritmo com o objetivo de otimizar sua performance.
# Criando o modelo baseado no algoritmo XGboost.
model_xgboost <- xgboost(
data = as.matrix(data %>% select(-is_attributed)), # Define as variáveis preditoras.
label = as.matrix(data$is_attributed), # Define a variável target.
max.depth = 40, # Defie o tamanho máximo da árvore.
eta = 1, # Define a taxa de aprendizado do modelo.
nthread = 2, # Define o número de threads que devem ser usadas.
# Quanto maior for esse número, mais rápido será o treinamento.
nrounds = 500, # Define o número de iterações.
objective = "binary:logistic", # Define que o modelo deve ser baseado em uma regressão logistica binária.
verbose = F # Exibe a queda da taxa de erro durante o treinamento.
)
# Realizando as previsões como o modelo baseado no algoritmo XGboost.
pred <- predict(model_xgboost, as.matrix(data %>% select(-is_attributed)))
# Definindo threshold.
th <- 0.5
# Classificando os resultados segundo o threshold especificado.
predClass <- ifelse(pred > th, 1, 0)
# Criando a Confusion Matrix a partir das previsões.
confusionMatrix(table(pred = predClass, data = data$is_attributed))
# Calculando a AUC para o modelo.
xgboostAuc <- auc(roc(as.integer(data$is_attributed), as.integer(predClass)))
# Exibe o resultado.
xgboostAuc
Vemos que o processo de otimização produziu uma pequena melhora na métrica AUC gerada pelo modelo. Isso pode nos indicar que chegamos a maior precisão que o modelo pode nos fornecer com este conjunto de dados.
Agora, vamos efetuar as previsões dos dados de teste e submetê-las no site da competição no Kaggle.
# Determinando o nome de cada um dos fragmentos do dataset original.
chunks <- c("conv_test_p1.csv", "conv_test_p2.csv", "conv_test_p3.csv", "conv_test_p4.csv", "conv_test_p5.csv")
# Carregando o primeiro fragmento do conjunto de dados.
chunk <- fread(chunks[1])
# Capturando o nome das colunas do dataset.
cNames <- colnames(chunk)
# Removendo o dataset da memória.
rm(chunk)
# Realizando previsões para o dataset de treino com base no modelo xgboost criado.
sapply(chunks, function(c) {
# Carrega um chunk.
chunk <- fread(c, col.names = cNames)
# Realiza as previsões para os dados do chunk com o modelo especificado.
pred <- predict(model_xgboost, as.matrix(chunk[, !'click_id']), predcontrib = F)
# Salva as previsões em um arquivo .csv.
fwrite(
data.frame(
click_id = as.integer(chunk$click_id),
is_attributed = as.numeric(pred)
), 'results.csv', append = TRUE
)
# Remove variáveis da memória.
rm(chunk, pred)
# Retorna uma mensagem ao fim da iteração.
return('Saved!')
})
Por fim, obtemos as seguintes pontuações com a métrica AUC no Kaggle ao submeter as previsões geradas pelo nosso modelo para os dados de teste:
- Pontuação privada: 0.93511
- Pontuação pública: 0.93311
Entre em contato comigo!¶
Caso tenha alguma dúvida, sugestão ou apenas queira trocar uma ideia sobre este projeto, não hesite em entrar em contato comigo!
