项目01_Titanic R代码

最新推荐文章于 2025-04-18 02:26:50 发布

weixin_41560991

最新推荐文章于 2025-04-18 02:26:50 发布

阅读量1k

点赞数

CC 4.0 BY-SA版权

分类专栏： kaggle 入门赛

本文链接：https://blog.youkuaiyun.com/weixin_41560991/article/details/87386070

###############################Step 1 start ##########################

#加载数据源文件
#将空字符，包含空格的字符，NA字符统一处理成缺失值NA
#初始，不将string转换成Factor,影响相关性分析
train <- read.csv("train.csv",na.strings = c(""," ","NA"),stringsAsFactors = FALSE)
test <- read.csv("test.csv",na.strings = c(""," ","NA"),stringsAsFactors = FALSE)

#对比train数据集，仅相差一列Survived，对应结果列
str(train) #891 obs. of 12 variables
str(test) #418 obs. of 11 variables

#创造test中Survived空列，利用rbind整合成一个大数据集
#一次性加工（缺失值，属性加工，创建新特征等等）训练集数据，测试集
test$Survived <- NA #新增列为逻辑值列
comb <- rbind(train,test) #rbind函数不要求列排序，只需要都存在即可
str(comb) #1309 obs. of 12 variables,合并后Survived跟随训练集的Factor类型
comb$Survived #前891行属于train数据集，后418行属于test数据集

###############################Step 1 stop##########################

###################Step 2 start ###########################
#探索缺失值

#探索数值型变量
#主动忽略Survived列，构造出来的NA值
library("lattice")
library("mice")
md.pattern(comb[,-2]) #输出各列缺失值统计频数表格,仅对NA缺失值统计有效

library("VIM")
aggr(comb[,-2],prop=FALSE,numbers=TRUE) #数值以个数显示
#结果解读，共计缺失1280个值
#Fare列，缺1个值
#Embarked列，缺2个值
#Age列，缺(240+23=263)263个值
#Cabin列，缺(773+240+1=1014)1014个值
aggr(comb[,-2],prop=TRUE,numbers=TRUE) #数值以比例显示
#结果解读，共计缺失1280个值
#Fare列，缺失比例：0.076%
#Embarked列，缺失比例：0.153%
#Age列，缺失比例：(1.757%+18.335%=20.092%)20.092%
#Cabin列，缺失比例：(0.076%+18.335%+59.053%=77.464%)77.464%

##########################step 2 stop ##########################

##########################Step 3 start ########################

#3.1 描述性分析
#对于数值列，五数分析，包含缺失值个数统计
#对于字符列，仅显示观测值个数，列类型为character
summary(comb)
#数值列包含：7列，PassengerId，Survived，Pclass，Age，SibSp，Parch，Fare
#字符列包含：5列，Name，Sex，Ticket，Cabin，Embarked

#3.2 图形探索分析
library(ggplot2)
#3.2.1 Age列对Survived列的相关性
ggplot(train,aes(x=Age,y=PassengerId,color=as.factor(Survived)))+
geom_point()+
facet_grid(Sex~.)+
labs(title="Corr between Age & Survived",x="Age",y="ID",fill="1")+
scale_color_manual(values=c("blue","red"))+
theme(legend.title = element_blank(),
plot.title = element_text(hjust = 0.5)#当R版本下标题无法居中
)
#图形解读
#0-15岁的间隔中，男，女的存活比率大致相同
#50岁以上，男性死亡比例非常高，女性存活率比例比较高
#对于男性群体而言，50岁以上的死亡率小于20-50年龄段的死亡率

#3.2.2 Pclass列，Embarked列对于Survived列的相关性
ggplot(train[!is.na(train$Embarked),],aes(x=Embarked,y=PassengerId))+
geom_tile(aes(fill = as.factor(Survived)))+
facet_grid(.~Pclass)+
labs(title="Pclass Embarked vs Survived",
x="Embarked",y="ID")+
theme( legend.title = element_blank(),
plot.title = element_text(hjust=0.5)
)
#图形解读
#从Pclass看，Pclass=3, S港口登录，死亡率最高

ggplot(train[!is.na(train$Embarked),],aes(x=Embarked,y=PassengerId))+
geom_tile(aes(fill = as.factor(Survived)))+
facet_grid(.~Sex)+
labs(title="Sex Embarked vs Survived",
x="Embarked",y="ID")+
theme( legend.title = element_blank(),
plot.title = element_text(hjust=0.5)
)
#图形解读
#从Sex看，无论男性，还是女性都是S港口登录，死亡率最高

#3.2.3 查看Sex，Age，SibSp，Parch与Survived列之间的相关性
library("grid")
library("vcd")
mosaic(~ Sex + (Age > 15) + (SibSp + Parch > 0) + Survived,
data = train[complete.cases(train),],
shade=TRUE, legend=TRUE)

#图形解读
#马赛克图 mosaic plot
#嵌套矩形面积正比于单元格频率，其中该频率即多维列联表中的频率
#颜色或阴影可表示拟合模型的残差值
#两个以上类别型变量
#皮尔逊残差大于等于2，说明考虑的变量之间存在相互依赖关系。

#sex,Age>15,SibSp+Parch>0,Survived，对应四个维度，相当于多维列表，
#在sex,Age>15,SibSp+Parch>0,三个维度下，分布统计Survived的频数，用不同的残差
#进行图表表现
#考虑Sex,Age>15,SibSp+Parch>0与Survived列之间的相关性

#3.3 探索相关关系
#各自变量(对应其余11列中7个数值型变量)与因变量(Survived)之间的相关关系

#3.3.1 包含缺失值的探索
#corrgram支持类别型，数值型相关性探索,character,Factor列不参与探索
library(corrgram)
corrgram(train,order=TRUE,lower.panel=panel.shade,
upper.panel=panel.pie,text.panel = panel.txt,
main="Corrgram of comb intercorrelations"

)
#结果解读
#以Survived为直角的，列，行，对应Survived与各列的相关系数
#顺时针，表示正相关，图形扇面越大，相关系数越大
#逆时针，表示负相关，图形扇面越大，相关系数越大
#相关性绝对值排序，扇面大小排序：
#Pclass > Fare > Parch > Age > Passengrid > SibSp
S_cor <- cor(train[,2],train[,c(1,3,6,7,8,10)],use = "complete.obs")
class(S_cor) #返回matrix
#利用扇形图，来确定相关性大小
library(plotrix)
slices <- abs(S_cor)
lbls <- colnames(slices)
fan.plot(slices,labels=lbls,main="fan plot") #不加标题，扇形上界超出画布
#确实：Pclass > Fare > Parch > Age > Passengrid > SibSp

#3.3.2 相关系数+P值
#以Survived为直角，上方，向上的直角，图形颜色深浅判断相关性高低
#下方，向下的直角，p的绝对值越大，相关性越高
S_cor_matrix <- cor(train[,c(1,2,3,6,7,8,10)],use = "complete.obs")
S_cor_matrix_mtest <- cor.mtest(train[,c(1,2,3,6,7,8,10)], conf.level = 0.95,na.action="na.omit")
library(corrplot)
corrplot(S_cor_matrix, method="ellipse",
p.mat = S_cor_matrix_mtest$p, sig.level = 0.2,
order = "AOE",
type = "upper",
tl.pos = "d"
)

corrplot(S_cor_matrix, add = TRUE,
p.mat = comb_mtest$p, sig.level = 0.2,
type = "lower", method = "number",
order = "AOE",
diag = FALSE,
tl.pos = "n",
cl.pos = "n")
#图形解读
#打X表示，P值不显著，近似等于0，可以忽略
#显示相关性排名的末两位，Passengrid ， SibSp，P检验未通过
########################step 3 stop###########################################

########################Step 4 start##########################################
#4.1 特征改造

#4.1.1 Name(包含名，性别/身份.姓),集合Sex,Age，完成分组改造
#针对名字列，完成字符切割，每一个Name分割成3列，第一列为名，第二列为性别/身份，第三列为姓

comb$Title <- sapply(comb$Name,FUN=function(x){strsplit(x,split='[,.]')[[1]][2]})
library("stringr")
comb$Title <- str_trim(comb$Title) #剔除多余的空格
unique(comb$Title) #返回18个值

#基于性别/身份特征，生成对应频数统计表格
T_df <- as.data.frame(table(comb$Title))
colnames(T_df) <- c("Title","Counts")
T_df <- T_df[order(-T_df$Counts),]
rownames(T_df) <- c(1:18)

#生成辅助表格mid_df
#性别/身份，对应Title字段，人员分组依据
#频数，对应Counts字段，人员分组依据
#Age缺失频数，对应Age_missing字段，
#Age_min,当前组中，年龄最小值
#Age_max,当前组中，年龄最大值

mid_df <- as.data.frame(
cbind(
T_df,
"Age_missing" = sapply(T_df$Title,FUN=function(x) {nrow(comb[comb$Title==x & is.na(comb$Age),])}),
"Age_min" = sapply(T_df$Title,FUN=function(x) {min(comb$Age[comb$Title==x],na.rm=TRUE)}),
"Age_max" = sapply(T_df$Title,FUN=function(x) {max(comb$Age[comb$Title==x],na.rm=TRUE)})
)
)
str(mid_df)
mid_df$Title <- as.vector(mid_df$Title) #因子类型处理
mid_df$Title <- str_trim(mid_df$Title) #空格处理

# Mr: For men above 14.5 years
# Miss: For girls below and equal to 14.5 years
# Mr