再次分析泰坦尼克號事件數據

上一關只對泰坦尼克數據進行了簡單分析，這次要跟著kaggle上的老師的方法來分析數據。用到了隨機森林的方法。

一、分析數據分為三部分

1、分析項目特徵

2、補齊缺失值

3、分析預測結果

二、對數據的理解，列名代表什麼意義

向量名稱————描述

PassengerId————乘客編號

Survived————倖存，1為倖存，0為否

Pclass————船艙等級，分為1、2、3

Name————乘客姓名

Sex————乘客性別，male為男性，female為女性。

Age————乘客年齡

SibSp————同輩親屬成員在船上有多少人

Parch————父母長輩有多少人在船上

Ticket————船票號碼

Fare————船票價格

Cabin————船艙號

Embarked————出發的港口

三、代碼部分

載入數據包，讀取數據，簡單了解數據library(ggplot2)library(ggthemes)library(stringr)library(dplyr)library(nycflights13)library(readr)library(rJava)library(xlsxjars)library(xlsx)library(openxlsx)library(mice)library(randomForest)library(scales)newdata <- read.csv("F:\bigdata\data\full.csv")str(newdata) #數據簡介head(newdata) #查看前面幾行的數據內容newdata$Title <- gsub((.*, )|(\..*), , newdata$Name) #用正則表達式匹配乘客的稱謂，定義為一個新的向量table(newdata$Sex,newdata$Title) #根據性別生成一個數據框顯示各個頭銜出現的次數hanjian_title <- c(Dona, Lady, the Countess,Capt, Col, Don, Dr, Major, Rev, Sir, Jonkheer) #把罕見稀少的稱謂合併newdata$Title[newdata$Title == "mlle"] <- "Miss"newdata$Title[newdata$Title == "Ms"] <- "Miss"newdata$Title[newdata$Title == "Mme"] <- "Mrs"newdata$Title[newdata$Title %in% hanjian_title] <- "Hanjian_title" #把罕見稀少的稱謂合併,把女士的稱謂同意table(newdata$Sex,newdata$Title) #統計一下合併後的稱謂的性別人數is.character(newdata$Name) #姓名列不是字元類型newdata$Name <- as.character(newdata$Name) #轉換位字元串類型newdata$Surname <- sapply(newdata$Name,function(x) strsplit(x,split = "[,.]")[[1]][1]) #抓取乘客的姓氏cat(paste("we have <b>",nlevels(factor(newdata$Surname)),"</b> unique surnames. I would be interested to infer ethnicity based on surname --- another time."))#cat(paste(letters, 100* 1:26), fill = TRUE, labels = paste0("{", 1:10, "}:"))#把有家庭成員的乘客組成家庭，包含他自己newdata$jia <- newdata$SibSp + newdata$Parch + 1#創建一個家庭變數newdata$jiaating <- paste(newdata$Surname,newdata$jia,sep = "_")ggplot(newdata[1:891,],aes(x = jia,Fill = factor(Survived))) + geom_bar(stat = "count",position = "dodge") + scale_x_continuous(breaks = c(1:11)) + labs(x = "family size") + theme_few()

#根據家庭成員多少分三類newdata$jiaD[newdata$jia == 1] <- "danshengou"newdata$jiaD[newdata$jia < 5 & newdata$jia > 1] <- "xiaojia"newdata$jiaD[newdata$jia > 5] <- "dajia"#繪圖mosaicplot(table(newdata$jiaD,newdata$Survived),main = "家庭大小和倖存的關係",shade = TRUE)

#查看甲板newdata$Cabin[1:28]#轉換數據類型newdata$Cabin <- as.character(newdata$Cabin)#查看甲板向量的第二個值的名字strsplit(newdata$Cabin[2],NULL)[[1]]#創建一個以甲板名稱第一個字母為變數的列newdata$jban <- factor(sapply(newdata$Cabin,function(x) strsplit(x,NULL)[[1]][1])) #暫時停止######補充缺失值sapply(newdata,function(x) sum(is.na(x))) sapply(newdata,function(x) sum(x == ""))which(newdata$Embarked %in% "") #出發港口的缺失值newdata[c(62,830),"Fare"] #62和830號乘客的票價是80$piaojia2 <- newdata %>% filter(PassengerId != 62 & PassengerId != 830) #排除62和830號乘客ggplot(piaojia2,aes(x = Embarked,y = Fare,Fill = factor(Pclass))) + #ggplot繪圖 geom_boxplot() + geom_hline(aes(yintercept = 80), colour = "red",linetype = "dashed",lwd = 2) + scale_y_continuous(labels = dollar_format()) + theme_classic()

newdata$Embarked[c(62,830)] <- "C" #62和830號乘客添加出發港「C」newdata[1044,]ggplot(newdata[newdata$Pclass == "3" & newdata$Embarked == "S",],aes(x = Fare)) + geom_density(Fill = "#996600",alpha = 0.4) + geom_vline(aes(xintercept = median(Fare,na.rm = T)),colour = "red",linetype = "dashed",lwd = 1) + scale_x_continuous(labels = dollar_format()) + theme_few()

newdata$Fare[1044] <- median(newdata[newdata$Pclass == "3" & newdata$Embarked == "S",]$Fare,na.rm = TRUE)#統計年齡列有多少空值sum(is.na(newdata$Age))#定義一個列名向量factor_vars <- c(PassengerId,Pclass,Sex,Embarked,Title,Surname,jiaating,"jiaD")newdata[factor_vars] <- lapply(newdata[factor_vars],function(x) as.factor(x))#設置隨機種子set.seed(129)#建立模型mice_mod <- mice(newdata[,!names(newdata) %in% c("PassengerId","Name","Ticket",Cabin,jiaating,Surname,Survived)],method = rf)#把模型引入源數據後填充年齡，得到新的數據mice_output <- complete(mice_mod)#用原來的年齡數據繪圖par(mfrow = c(1,2))hist(newdata$Age, freq = F, main = Age: Original Data, col = darkgreen, ylim = c(0,0.04))

#補充年齡值後的數據繪圖，進行對比par(mfrow = c(1,2))hist(mice_output$Age,freq = F,main = Age original data,col = darkblue,ylim = c(0,0.04))

#把補充完整的年齡數據寫入原來的數據newdata$Age <- mice_output$Age#檢查一下是否還有空的年齡值sum(is.na(newdata$Age))#再看一下年齡和倖存的關係ggplot(newdata[1:891,],aes(Age,Fill = factor(Survived))) + geom_histogram() + facet_grid(.~Sex) + theme_few()

#把乘客分為大人和小孩newdata$child[newdata$Age < 18] <- childnewdata$child[newdata$Age >= 18] <- adult#統計人數table(newdata$child,newdata$Survived)#母親獲救的幾率是否更高？newdata$mother <- not mothernewdata$mother[newdata$Sex == female & newdata$Parch > 0 & newdata$Age > 18 & newdata$Title != Miss] <- mother#統計人數table(newdata$mother,newdata$Survived)#生成了兩個新的因子變數newdata$child <- factor(newdata$child)newdata$mother <- factor(newdata$mother)#檢查是否還有丟失的數值或者變數md.pattern(newdata)###隨機森林分析#把數據分為兩部分train <- newdata[1:891,]test <- newdata[892:1309,]##建立模型#設置隨機種子set.seed(754)#用一部分變數建立模型rf_model <- randomForest(factor(Survived) ~Pclass + Sex + SibSp + Parch + Fare + Embarked + Title + jia + child + mother,data = train)#顯示模型誤差plot(rf_model,ylim = c(0,0.36))legend(topright,colnames(rf_model$err.rate),col = 1:3,fill = 1:3)

##各個變數的重要性importance <- importance(rf_model)varImportance <- data.frame(variables = row.names(importance),importance = round(importance[,"MeanDecreaseGini"],2))#創建一個基於重要性的變數rankImportance <- varImportance %>% mutate(rank = paste0(#,dense_rank(desc(importance))))#用ggplot根據變數影響的重要性繪圖ggplot(rankImportance,aes(x = reorder(variables,importance), y = importance,Fill = importance)) + geom_bar(stat = "identity") + geom_text(aes(x = variables,y = 0.5,label = rank), hjust = 0, vjust = 0.55,size = 4,colour = red) + labs(x = variables) + coord_flip() + theme_few()

#使用測試集合進行預測prediction <- predict(rf_model,test)solution <- data.frame(PassengerID = test$PassengerId,Survived = prediction)#導出保存數據write.csv(solution,file = "F:\bigdata\output\rf_model_solution.csv",row.names = FALSE)