19 de agosto de 2018●4 min de leitura

Previsão de Sobreviventes do Titanic

Visualização de dados e machine learning com o desafio do Kaggle do Titanic

Machine Learning

Visualização

Kaggle, um organizador de competições para cientistas de dados, o desafio inicial dele é a previsão dos sobreviventes da viagem inaugural do RMS TItanic. Titanic: Machine Learning from Disaster

Ambiente

Configurei o ambiente como costumo fazer setando o diretório de trabalho, substituindo o "." pelo caminho dos arquivos de dados, e limpando as viáveis de ambiente

setwd('.')
rm(list = ls())

Carregando os dados por leitura de csv simples

test <- read.csv("test.csv")
train <- read.csv("train.csv")

E unindo as bases de dados para tratar ambas da mesma forma, adicionando a coluna Sobrevivente (Survived) para a test, para poder utilizar o comando rbind

test$Survived <- NA
combi <- rbind(train, test)
rm('train','test')

Tratamento de dados

Os atributos de Sobrevivente (Survived), Porto em que embarcou (Embarked) e Gênero (ex) possuem quantidade de variações reduzidas e já informativas, facilitando a manipulação posterior portanto as transformei em fatores

combi$Survived <- as.factor(combi$Survived)
combi$Embarked <- as.factor(combi$Embarked)
combi$Sex <- as.factor(combi$Sex)

Vamos classificar as famílias por nome

combi$Familia <- combi$SibSp + combi$Parch + 1
combi$TipoFamilia[combi$Familia == 1] <- 'Solteiro/a'
combi$TipoFamilia[combi$Familia < 5 & combi$Familia > 1] <- 'Pequena'
combi$TipoFamilia[combi$Familia > 4] <- 'Grande'
combi$TipoFamilia <- as.factor(combi$TipoFamilia)

combi$Name <- as.character(combi$Name)
combi$Title <- sapply(combi$Name, FUN=function(x) {trimws(strsplit(x, split = "[.,]")[[1]][2])})
# Organizar títulos
rareTitle <- c('Dona', 'Lady', 'the Countess', 'Capt', 'Col', 'Don', 'Dr', 'Major', 'Rev', 'Sir', 'Jonkheer')
combi$Title[combi$Title == 'Mlle'] <- 'Miss'
combi$Title[combi$Title == 'Ms'] <- 'Miss'
combi$Title[combi$Title == 'Mme'] <- 'Mrs'
combi$Title[combi$Title %in% rareTitle] <- 'Rare Title'
combi$Title <- as.factor(combi$Title)
rm(rareTitle)

combi$Surname <- sapply(combi$Name, FUN=function(x) {trimws(strsplit(x, split = "[.,]")[[1]][1])})

Ajustes de valores faltantes

combi$Fare[is.na(combi$Fare)] <- median(combi$Fare[combi$Pclass == 3 & combi$Embarked == "S"], na.rm=TRUE)

library("rpart")
modelo_idade <- rpart(Age ~ Pclass + Sex + SibSp + Parch + Fare + Embarked + Familia + TipoFamilia + Title, data=combi[!is.na(combi$Age),], method="anova")
combi$Age[is.na(combi$Age)] <- predict(modelo_idade, combi[is.na(combi$Age),])
rm(modelo_idade)

combi$Embarked[combi$Embarked == ""] <- NA
combi$Embarked[is.na(combi$Embarked)] <- "C"

Segmentação de passageiros

Passageiros com menos de 16 anos como Crianças

combi$Kid <- ifelse(combi$Age <= 16, 1, 0)
combi$Kid <- as.factor(combi$Kid)

Mulheres maiores de 18 anos acompanhadas e com título de "Miss" como Mães

combi$Mother <- ifelse(combi$Sex == 'female' & combi$Parch > 0 & combi$Age > 18 & combi$Title != 'Miss', 1, 0)
combi$Mother <- as.factor(combi$Mother)

combi$Line <- ifelse(combi$Ticket == "LINE", 1, 0)
combi$Line <- as.factor(combi$Line)

combi$Deck <- substr(combi$Cabin, 1, 1)
combi$Deck <- as.factor(combi$Deck)

combi$NCabin <- sapply(as.character(combi$Cabin), FUN=function(x) {ifelse(x=="",0,length(strsplit(x, split = " ")[[1]]))})
combi$NCabin <- as.factor(combi$NCabin)

ticketLimpo <- gsub("[./]", "", toupper(combi$Ticket))

combi$PC <- ifelse(substr(ticketLimpo, 1, 2) == "PC", 1, 0)
combi$PC <- as.factor(combi$PC)

combi$CA <- ifelse(substr(ticketLimpo, 1, 2) == "CA", 1, 0)
combi$CA <- as.factor(combi$CA)

combi$WC <- ifelse(substr(ticketLimpo, 1, 2) == "WC", 1, 0)
combi$WC <- as.factor(combi$WC)

rm(ticketLimpo)

# Encontrar a tripulação
combi$Crew <- ifelse(combi$Fare == 0 & combi$Deck == "", 1, 0)

names <- colnames(combi)
campos <- names[!names %in% c("Name", "TipoFamilia", "Ticket", "Cabin", "Surname")]
combi <- combi[campos]

formula <- Survived ~ Pclass + Sex + Age + SibSp + Parch + Fare + Embarked +
                      Familia + Title + Kid + Mother + Deck + NCabin + Line +
                      PC + CA + WC + Crew

train <- combi[!is.na(combi$Survived),]
test <- combi[is.na(combi$Survived),]
rm(combi)

Floresta Aleatória

Aplicando Floresta Aletória (Random Florest)

library("randomForest")

modelo_rf <- randomForest(formula, data=train)

test$Survived <- predict(modelo_rf, test)
test$Survived <- as.numeric(test$Survived) - 1

write.csv(test[c("PassengerId", "Survived")], file="solution.csv", row.names=FALSE)

Visualizar critérios de sobrevivencia

library("tidyverse")

importance <- importance(modelo_rf)

varImportance <- data.frame(Variables = row.names(importance),
        Importance = round(importance[,'MeanDecreaseGini'],2))

rankImportance <- varImportance %>%
        mutate(Rank = paste0('#',dense_rank(desc(importance))))

ggplot(rankImportance, aes(x = reorder(Variables, Importance),
                           y = Importance, fill = Importance)) +
  geom_bar(stat='identity') +
  labs(x = 'Variables') +
  coord_flip() +
  theme_minimal()

plot of chunk titanic_importancia

Visualização

# Biblioteca geração de relatórios
library("ggplot2")
# Descrição de Sobrevivência
train$Sub = ifelse(train$Survived == 1, "Sim" , "Não")
# Palheta de Cores
cbPalette <- c("#FF6A00", "#069B87")

Homens sem títulos nobres ou patentes militares, foram os mais prejudicados

ggplot(train, aes(as.factor(Title), fill=Sub, colour=Sub)) +
  labs(title = "",
       x="Título", y="Quantidade",
       fill="Sobreviventes", colour="Sobreviventes") +
  geom_bar(position='dodge', alpha = 0.2) +
  theme_minimal() +
  scale_fill_manual(values=cbPalette) +
  scale_colour_manual(values=cbPalette)

plot of chunk titanic_titulos

No gráfico mostra a segunda característica em importância, crianças de até possuem mais possibilidades de adultos de 16 a 35 anos

ggplot(train, aes(Age, fill = Sub, colour = Sub)) +
  labs(x = "Idade", y = "Quantidade", fill = "Sobreviventes", colour = "Sobreviventes") +
  geom_density(position = "identity", alpha = 0.2) +
  xlim(0, max(train$Age)) +
  theme_minimal() +
  scale_fill_manual(values=cbPalette) +
  scale_colour_manual(values=cbPalette)

plot of chunk titanic_idade

Infelizmente as pessoas que pagaram menos pela passagem, por estarem mais longes dos botes ou por outros fatores, é o terceiro critério

ggplot(train, aes(Fare, fill = Sub, colour = Sub)) +
  labs(x = "Passagem", y = "Quantidade", fill = "Sobreviventes", colour = "Sobreviventes") +
  geom_density(alpha = 0.3) +
  xlim(0, 150) +
  theme_minimal() +
  scale_fill_manual(values=cbPalette) +
  scale_colour_manual(values=cbPalette)

plot of chunk titanic_preco

Embora seja o sétimo o tamanho da família é um dados interessante, proporcionalmente os solteiros tiveram a menor oportunidade de sobrevivência

ggplot(train, aes(as.numeric(Familia), fill=Sub, colour=Sub)) +
  labs(title = "",
       x="Tamanho da Família", y="Quantidade",
       fill="Sobreviventes", colour="Sobreviventes") +
  geom_bar(position='dodge', alpha = 0.3) +
  scale_x_continuous(breaks=c(1:11)) +
  theme_minimal() +
  scale_fill_manual(values=cbPalette) +
  scale_colour_manual(values=cbPalette)

plot of chunk titanic_familia

Compartilhe:

Algumas recomendações

11 de setembro de 2024 ● 6 min de leitura

Gráfico de setores (pizza) em D3.js

Visualização de dados com gráfico de setores / pizza / torta com D3.js

19 de agosto de 2018 ● 5 min de leitura

Classificação de Séries IMDb

Visualização de dados da base dados do IMDb com a linguagem R