Kaggle -- Shelter Animal Outcomes

来源:互联网 发布:php强迫其它帐号下线 编辑:程序博客网 时间:2024/06/05 06:33

最近在Kaggle上做了一个数据挖掘的比赛,是一个分类的问题,收获良多。故此将比赛的过程记录了下来。

竞赛地址

Kaggle–Shelter Animal Outcomes


题目大意

  在美国,每年大约有760万伴侣动物被动物收容所收容。大多数动物是被它们的主人主动放弃,而另一些则是由于种种的意外情况而进入收容所。最终,有些动物足够幸运找到了新的归宿,但另一些不那么幸运的则最终被安乐死。美国每年大约有270万的猫狗被执行安乐死。
  这次的比赛使用的是来自Austin的动物收容所的数据,其中包括动物的品种,颜色,性别和年龄,要求参赛者预测每只动物的最终结局。这些结局包括:被领养、死亡、安乐死、归还所有者和转移。其中训练集和测试集是随机划分的。
  最后输出测试集种每个动物的每一种结局的可能性即可。


给定数据集描述

  给定的数据集中一共包括10个字段,其字段的含义如下:

  • 数据集说明
    • AnimalID : 动物的ID编号
    • Name : 动物的名称,若动物没有名字次字段为空
    • DateTime : 进入收容所的日期 (例:2014/2/12 18:22:00)
    • OutcomeType : 动物的最终结局 ,有5种可能取值:Adoption(被领养)、Died(死亡)、Euthanasia(安乐死)、Return_to_owner(返回原主人)、Transfer(转移)
    • OutcomeSubtype : 是对动物结局的补充说明,好像没有什么用
    • AnimalType : 动物的类型,只有两种取值即Dog(狗)、Cat(猫)
    • SexuponOutcome : 动物的性别和生育能力,取值Neutered Male(雄性动物不能生育)、Spayed Female(雌性动物不能生育)、Intact Male(雄性动物能够生育)、Intact Female(雌性动物能生育)、Unknown(未知)
    • AgeuponOutcome : 动物的年龄(例如:1 year,3 weeks)
    • Breed : 动物的品种(例如: Shetland Sheepdog Mix、Domestic Shorthair Mix)
    • Color : 动物的毛色(例如:Brown/White、Cream Tabby)

初次尝试

数据准备

  首先当然是将所给的数据集读入进来:

    train_data <- read.csv("train.csv",stringsAsFactors = F)    test_data <- read.csv("test.csv",stringsAsFactors = F)     str(train_data)    train<-train_data[-1]    test<-test_data[-1]    library(dplyr)    full <- bind_rows(train, test)

  可以看到所读入的数据内容:
  full数据集

特征提取

1.将动物有没有姓名作为一个特征:

full$Name[full$Name==""]<-"No"full$Name[full$Name!="No"]<-"Yes"![full$Name](http://img.blog.csdn.net/20170103223736505?watermark/2/text/aHR0cDovL2Jsb2cuY3Nkbi5uZXQvYmFpZHVfMzM4OTM4ODA=/font/5a6L5L2T/fontsize/400/fill/I0JBQkFCMA==/dissolve/70/gravity/SouthEast)

2.处理AgeuponOutcome属性

full$TimeValue <- sapply(full$AgeuponOutcome,                           function(x) strsplit(x, split = ' ')[[1]][1])full$UnitofTime <- sapply(full$AgeuponOutcome,                            function(x) strsplit(x, split = ' ')[[1]][2])full$UnitofTime <- gsub('s', '', full$UnitofTime)full$TimeValue  <- as.numeric(full$TimeValue)multiplier <- ifelse(full$UnitofTime == 'day', 1,                     ifelse(full$UnitofTime == 'week', 7,                            ifelse(full$UnitofTime == 'month', 30,                                   ifelse(full$UnitofTime == 'year', 365, NA))))# 转换成天full$AgeinDays <- full$TimeValue * multiplier

full$AgeinDays
这样就可以将动物的年龄统一为天

3.将SexuponOutcome 拆分成两个特征,即性别和是否能生育,Unknown的情况认为是缺失

full$SexuponOutcome[full$SexuponOutcome=="Unknown"]<- "Unknown Unknown"full$bear<-sapply(full$SexuponOutcome,                   function(x) strsplit(x, split = ' ')[[1]][1])full$sex<-sapply(full$SexuponOutcome,                    function(x) strsplit(x, split = ' ')[[1]][2])full$bear[full$bear=="Intact"]<-"Can"full$bear[full$bear=="Spayed"]<-"Cannot"full$bear[full$bear=="Neutered"]<-"Cannot"full$bear[full$bear=="Unknown"]<-NAfull$sex[full$sex=="Unknown"]<-NA

sex和bear

4.处理DateTime属性

首先通过lubridate的相关函数获取动物进入收容所的年份、月份、星期以及小时

library(lubridate)full$Hour    <- hour(full$DateTime)full$Weekday <- wday(full$DateTime)full$Month   <- month(full$DateTime)full$Year    <- year(full$DateTime)

为方便处理将Hour属性压缩:

## 将之划分为早上,下午,傍晚,深夜四类型full$TimeofDay <- ifelse(full$Hour > 5 & full$Hour < 11, 'morning',                         ifelse(full$Hour > 10 & full$Hour < 16, 'midday',                                ifelse(full$Hour > 15 & full$Hour < 20, 'lateday', 'night'))

以同样的方式处理Weekday属性

# 将时间划分为工作日和周末full$isWorkday<- ifelse(full$Weekday<=5,'WorkDay',                        ifelse(full$Weekday>5,"Rest",NA))

时间特征

5.处理Breed 属性

#设置属性表示动物是否是混合品种,属性为“Yes”或“No”full$IsMix <- ifelse(grepl('Mix', full$Breed),"Yes","No")

为方便处理,将动物的品种去掉Mix后设为/之前的品种

# 设置动物的品种为第一个单词full$SimpleBreed <- sapply(full$Breed,                            function(x) gsub(' Mix', '',                                             strsplit(x, split = '/')[[1]][1]))

品种特征

6.处理Color属性

# 设置一个属性标志其颜色是否是纯色的full$isPureColor <- ifelse(grepl('/| ',full$Color),"Pure","Mix")

为方便处理,将杂色动物的杂色的第一种颜色作为动物的毛皮颜色

# 对于杂色的动物,取'/'的前一种颜色作为其颜色属性full$SimpleColor <- sapply(full$Color,                            function(x) strsplit(x, split = '/| ')[[1]][1])

动物颜色特征

7.将AnimalType 直接作为特征

AnimalType 特征

8.删去full中不需要的属性

### 删去不需要的特征full<-full[c(-2,-6,-7,-8,-9,-10,-11,-15,-16)]

所有特征


自此,我们就得到了所需的数据框,其特征如下:

  1. Name 动物是否有名字
  2. OutcomeType 分类结果
  3. OutcomeSubtype 分类结果的描述
  4. AnimalType 动物类型(猫、狗)
  5. AgeinDays 动物年龄
  6. bear 该动物是否能生育
  7. sex 动物的性别
  8. Month 动物进入收容所的月份
  9. Year 动物进入收容所的年份
  10. TimeofDay 进入收容所的时间段
  11. isWorkday 进入收容所的时间是否是工作日
  12. IsMix 是否是混合品种
  13. SimpleBreed 动物的品种
  14. isPureColor 动物是否是纯色的
  15. SimpleColor 动物的颜色

特征因子化

## 特征因子化full$Name<-factor(full$Name,levels = c("Yes","No"))full$AnimalType<-factor(full$AnimalType,levels = c("Dog","Cat"))full$bear<-factor(full$bear,levels = c("Can","Cannot"))full$sex<-factor(full$sex,levels = c("Male","Female"))full$Year<-factor(full$Year)full$Month<-factor(full$Month)full$TimeofDay<-factor(full$TimeofDay)full$isWorkday<-factor(full$isWorkday)full$IsMix<-factor(full$IsMix)full$SimpleBreed<-factor(full$SimpleBreed)full$isPureColor<-factor(full$isPureColor)full$SimpleColor<-factor(full$SimpleColor)## 转化分类结果向量full$OutcomeType<-factor(full$OutcomeType)

缺失值填补

通过mice包中的aggr方法可查看数据框中的数据缺失情况

library(VIM)aggr(full[,c(1,4:15)])

数据缺失情况

1.填补AgeinDays的缺失值

  对于动物的年龄,我们认为其可能会与品种,是否有名字,是否能生育等因素有一定的相关性,因此采用rpart来预测动物年龄的方式对其进行填补可能是一个比较合理的方案:

library(rpart)age_model<-rpart(AgeinDays ~ AnimalType + sex + bear + SimpleBreed + Name,                             data = full[!is.na(full$AgeinDays), ],                             method = 'anova')full$AgeinDays[is.na(full$AgeinDays)] <- predict(age_model, full[is.na(full$AgeinDays), ])

  为方便处理,仍然将年龄特征进行压缩之后因子化:

## 转化动物年龄full$Age<-ifelse(full$AgeinDays<190,'Little',                 ifelse(full$AgeinDays>189 & full$AgeinDays<365,'Mid',                        'Old'))full$Age<-factor(full$Age)full<-full[-5]

2.填补sex和bear的缺失值

  对于性别和生育能力字段缺失值的填补,直接使用其众数进行填补:

full$sex[is.na(full$sex)]<-"Male"full$bear[is.na(full$bear)]<-"Cannot"

自此,数据中的所有缺失值都已经被填补了起来

aggr(full[,c(1,4:15)])

缺失值填补完成


训练模型

终于到了调包时间,是时候化身调包侠了~
首先重新划分训练集和测试集:

# 开始进行模型训练full<-full[-3]train <- full[1:26729, ]test  <- full[26730:nrow(full), ]

1.C5.0决策树

第一次模型采用C5.0决策树进行训练:

library(C50)model<-C5.0(train[-2],train$OutcomeType,trials = 10)pre<-predict(model,test,type = "prob")ID<-c(1:11456)data<-data.frame(ID,pre)write.csv(data,"data2.csv",row.names = F)

在这次的模型中,采用了10棵提升树进行训练
提交结果:
C5.0决策树结果
这可真是太尴尬了,看来我们需要更强一点的模型


2.XGBoost

  听说这是目前Kaggle上最为炫酷的”极端梯度上升”模型,下面开始调一波包:
  

# xgboostlibrary(xgboost)library(readr)library(stringr)library(caret)library(car)y_train <- as.numeric(train$OutcomeType) - 1labels_train <- data.frame(train$OutcomeType, y_train)xgb_train <- xgb.DMatrix(model.matrix(~ Name+bear+AnimalType                                      +sex+Month+Year+TimeofDay+isWorkday+IsMix                                      +SimpleBreed+isPureColor+SimpleColor                                      +Age, data=train),label=y_train, missing=NA)xgb_test <- xgb.DMatrix(model.matrix(~Name+bear+AnimalType                                     +sex+Month+Year+TimeofDay+isWorkday+IsMix                                     +SimpleBreed+isPureColor+SimpleColor                                     +Age, data=test), missing=NA)xgb_model<-xgboost(xgb_train, y_train, nrounds=45, objective='multi:softprob',        num_class=5, eval_metric='mlogloss',        early.stopping.round=TRUE)predictions <- predict(xgb_model, xgb_test)xgb_preds <- data.frame(t(matrix(predictions, nrow=5, ncol=length(predictions)/5)))colnames(xgb_preds) <- c('Adoption', 'Died', 'Euthanasia', 'Return_to_owner', 'Transfer')data2<-data.frame(ID,xgb_preds)write.csv(data2,"xgb.csv",row.names = F)

提交成绩如下:
XGB提交结果

果然比这个决策树炫酷了不少。


3.随机森林

由于动物品种这一特征水平太多(231个),随机森林无法使用这么多水平的特征进行决策,因此我们去掉这一特征,再使用随机森林进行训练。
动物品种的水平
训练过程入下:

model <- randomForest(OutcomeType ~ Name+bear+AnimalType                      +sex+Month+Year+TimeofDay+isWorkday+IsMix                      +isPureColor+SimpleColor                      +Age, nrounds=45,data=train,ntree=650)

这次我们采用了650棵决策树组成随机森林。
之后,使用该模型进行预测:

rf_preds <- data.frame(predict(model, test, type='vote'))rf_preds <- data.frame(ID,predict(model, test, type='vote'))

提交结果如下:
随机森林提交结果


性能优化

1.特征调优

考虑到动物的品种这一项特征有231个特征,我们应当对这个特征的水平进行压缩,经过观察,类似于“家养的长毛狗”和“家养的卷毛狗”差别应当不大,可以考虑只取动物品种的前一个单词作为其特征即可。

full$SimpleBreed<-sapply(full$SimpleBreed,        function(x) strsplit(x, split = ' ')[[1]][1])

这样操作之后其品种的水平下降到180个
压缩后的水平
使用调整后的特征重新使用xgb训练模型,提交后结果略微提升了一些:
xgb2

2.模型平均

考虑将xgb模型的训练结果和随机森林的结果进行平均,这样也许可以得到更好的结果。

pre2<-predict(model, test, type='vote')ave_pred <- 0.5*(xgb_preds+pre2)data3<-data.frame(ID,ave_pred)write.csv(data3,"xgb_randomForest.csv",row.names = F)

xgb和随机森林平均
好像性能并没有提升,这是可以尝试适当调大xgb模型的权重:

ave_pred <- 0.7*xgb_preds+0.3*pre2data4<-data.frame(ID,ave_pred)write.csv(data4,"xgb_randomForest2.csv",row.names = F)

xgb0.7,rf0.3
这次,分数有了明显的上升

总结

这次分数无法继续提升的主要问题可能是

  1. 动物品种、动物毛皮颜色属性的因子水平仍然过高,而且在提取这一特征时只取前一个单词的处理忽略掉了很多信息,应该可以采用其他更好的方式处理它。
  2. 动物的性别字段采用众数填补缺失值的方法并不合理,因为这一特征缺失的数据过多,性能很不好。
  3. 所有的特征全部用数字表示效果可能会更好一些。
  


继续提升

  我们换一个思路来重新做一遍这个事情。先重新读入数据:
  

train <- read.csv("train.csv",stringsAsFactors = F)test <- read.csv("test.csv",stringsAsFactors = F) #去掉train的AnimalID列train$AnimalID <- NULLstr(train)#去掉OutcomeSubtype列train$OutcomeSubtype <- NULL#将test的ID字段保存到test_ID中test_ID <- test$ID#去掉test的ID列test$ID <- NULLlibrary(dplyr)full <- bind_rows(train, test)

1.处理DateTime属性

library(lubridate)full$Hour    <- hour(full$DateTime)full$Wkday <- wday(full$DateTime)full$Month   <- month(full$DateTime)full$Year    <- year(full$DateTime)

观察一下各时间子属性的分布
对于wkday 属性:
wkday
从分布上看各种取值都较为平均,因此在之前将之分为工作日和周末似乎并不太合理,这次我们直接将wkday作为一个特征。
对于Hour特征:
Hour特征
从核密度图上看,Hour主要集中在白天这个时段,我们将较为稀疏的21-23及0-6点都认为是0点然后缩小其他时间与这些较为稀疏的点的取值间的距离:

# 处理Hour属性full$Hour <- ifelse(full$Hour > 20 | full$Hour < 7,0,full$Hour-6) hist(full$Hour)

这样处理后,效果应当会好一些:
处理Hour之后

这次将整个时间戳也作为一个特征进行存储:

# 加入DateTime属性full$DateTime <- as.POSIXct(full$DateTime)full$DateTime <- as.numeric(full$DateTime)

2.处理AgeuponOutCome属性

## 处理AgeuponOutcomefull$TimeValue <- sapply(full$AgeuponOutcome,                           function(x) strsplit(x, split = ' ')[[1]][1])full$UnitofTime <- sapply(full$AgeuponOutcome,                            function(x) strsplit(x, split = ' ')[[1]][2])full$UnitofTime <- gsub('s', '', full$UnitofTime)full$TimeValue  <- as.numeric(full$TimeValue)multiplier <- ifelse(full$UnitofTime == 'day', 1,                     ifelse(full$UnitofTime == 'week', 7,                            ifelse(full$UnitofTime == 'month', 30,                                   ifelse(full$UnitofTime == 'year', 365, NA))))full$AgeinDays <- full$TimeValue * multiplier

这样就将动物的年龄均转化为了天


3.处理SexuponOutcome属性

# 将SexuponOutcome 拆分成两个属性,即性别和是否能生育full$SexuponOutcome[full$SexuponOutcome=="Unknown" | full$SexuponOutcome==" "]<- "Unknown Unknown"full$bear<-sapply(full$SexuponOutcome,                    function(x) strsplit(x, split = ' ')[[1]][1])full$sex<-sapply(full$SexuponOutcome,                   function(x) strsplit(x, split = ' ')[[1]][2])

bear表示动物是否能生育,能生育为Can不能则为Cannot

full$bear[full$bear=="Intact"]<-"Can"full$bear[full$bear=="Spayed"]<-"Cannot"full$bear[full$bear=="Neutered"]<-"Cannot"
# 将动物是否能够生育这一属性,也将之转化为哑变量的形式进行存储full$CanBear<-ifelse(full$bear=="Can",1,0)full$CanNotBear<-ifelse(full$bear=="Cannot",1,0)

之后,除去bear属性

将性别未知单独作为一个不同的水平,设计一个哑变量的形式来表示它:

# 这次将动物性别转化为哑变量,即将未知的性别单独作为一个属性full$isMale<-ifelse(full$sex=="Male",1,0)full$isFemale<-ifelse(full$sex=="Female",1,0)# 删去SexuponOutcome字段full$SexuponOutcome<-NULLfull$sex<-NULL

4.仍然按照之前的方法处理Name属性

# 处理Name特征# 将姓名这一特征用一个二元变量有/没有表示full$Name<-ifelse(full$Name=="",0,1)

5.处理Breed属性

比较关键的是这里的处理。
首先仍然设置一个表示动物是否是混合品种的特征:

# 处理Breed属性#设置属性表示动物是否是混合品种,属性为1或0full$IsMix <- ifelse(grepl('Mix', full$Breed),1,                     ifelse(grepl('/',full$Breed),1,0))

先获取所有可能的动物品种:

#得到所有不重复的全部品种all_breeds <- unique(full$Breed)str(all_breeds)

共有1678个不同的动物品种
动物品种的个数

这个里面其实有很多重复的水平,比如Lhasa Apso/Miniature Poodle和Lhasa Apso、Miniature Poodle应当算作两个特征,因此去掉斜线后再进行统计:

breed_words1 <- unique(unlist(strsplit(all_breeds, c("/"))))#去掉Mixbreed_words <- gsub('Mix','',breed_words1)

这样操作之后,品种的不同类型共有423种:
breed_words

接下来,将所有不同种类的特征作为哑变量生成特征:

#将每一个品种变为一个哑变量for (breed in breed_words){  full[breed] <- as.numeric(grepl(breed, full$Breed))}

接下来删去Breed属性即可

full$Breed = NULL

6.处理Color属性

我们使用与Breed类似的方法处理动物毛色的属性:

# 设置一个属性标志其颜色是否是纯色的full$isPureColor <- ifelse(grepl('/| ',full$Color),1,0)all_colors <- unique(full$Color)#strsplit得到的结果是list类型,通过unlist()将其转换为向量类型unlist(strsplit(c("Gray/Gold","Blue Smoke/White"), c("/")))#取出所有不重复的品种color_words <- unique(unlist(strsplit(all_colors, c("/"))))

这样处理之后,动物毛色的可能取值就变成了58种:
color_words

仍然按照类似的方法将之转化为哑变量:

#将每一个颜色变为一个哑变量for (color in color_words){  full[color] <- as.numeric(grepl(color, full$Color))}

之后,去掉Color属性:

#去掉Color属性full$Color <- NULL

7.处理AnimalType属性

## 处理AnimalType属性full$AnimalType<-ifelse(full$AnimalType=="Dog",1,0)

8.删去不需要的属性

full$TimeValue<-NULLfull$UnitofTime<-NULLfull$AgeuponOutcome<-NULL

缺失值填补

先观察一下缺失值的分布情况:

library(VIM)aggr(full[c(1:2,4:20)])sum(is.na(full$AgeinDays))

数据缺失情况
可以看到其中只有动物的年龄这一项有24个缺失值。
使用rpart预测的方式进行缺失值填充:

## 使用决策树rpart填补AgeinDays动物年龄library(rpart)age_model<-rpart(AgeinDays ~ AnimalType + Name,                  data = full[!is.na(full$AgeinDays),],                  method = 'class')full$AgeinDays[is.na(full$AgeinDays)] <- predict(age_model, full[is.na(full$AgeinDays), ])aggr(full[c(1:2,4:20)])

可以看到这样操作之后就没有缺失值存在了
缺失值被填补

训练模型进行预测

直接使用xgboost进行预测:

## 进行预测full$OutcomeType<-factor(full$OutcomeType)train <- full[1:26729, ]test  <- full[26730:nrow(full), ]label<-train$OutcomeTypey_train <- as.numeric(train$OutcomeType) - 1train$OutcomeType<-NULLtest$OutcomeType<-NULLlibrary(xgboost)full_train_matrix <- matrix(as.numeric(data.matrix(train)),ncol=length(names(train)))test_matrix <- matrix(as.numeric(data.matrix(test)),ncol=length(names(train)))xgb_model_test = xgboost(data=full_train_matrix,                          label=y_train,                          nrounds=1000,                          verbose=1,                          eta=0.2,                          max_depth=6,                          subsample=0.75,                          colsample_bytree=0.85,                         objective="multi:softprob",                          eval_metric="mlogloss",                         num_class=5)test_preds <- predict(xgb_model_test, test_matrix)test_preds_frame <- data.frame(matrix(test_preds, ncol = 5, byrow=TRUE))colnames(test_preds_frame) <- levels(label)ID<-c(1:11456)submission <- cbind(data.frame(ID=ID), test_preds_frame)write.csv(submission , "try2.csv", row.names=FALSE)

这次提交的结果:

try1

感觉并没有预想的高,可能是xgboost迭代1000次过拟合了,我们调小迭代次数再试一次:

xgb_model_test = xgboost(data=full_train_matrix,                          label=y_train,                          nrounds=125,                          verbose=1,                          eta=0.2,                          max_depth=6,                          subsample=0.75,                          colsample_bytree=0.85,                         objective="multi:softprob",                          eval_metric="mlogloss",                         num_class=5)test_preds <- predict(xgb_model_test, test_matrix)

try2
这一次就怼到了270名,终于进入了前25%,这就比较合理了,看来xgboost的迭代次数的选择就比较重要了。


总结

分数不能继续提升的原因可能是:
1. 题中year字段只有三种取值,即2013、2014、2015,2016,使用哑变量的方式转换year这个字段可能会是一个更好的选择
2. 在处理动物毛皮颜色特征的时候,我们直接将不含有“Mix”以及‘/’的动物认为是纯色的狗,这样处理其实是有偏差的,比如Torbie(玳瑁色)其实并不是一种纯色的毛皮。
3.直接将动物的Name标记为有或者没有似乎不太合理,可以使用名字的长度来作为特征也许更合理一些。
4.动物的年龄的记录似乎有一种聚集的趋势,将其范围缩小可能会使效果提升。


继续提升

转化Year属性

# 将Year转化为哑变量full$Year2013<-ifelse(full$Year==2013,1,0)full$Year2014<-ifelse(full$Year==2014,1,0)full$Year2015<-ifelse(full$Year==2015,1,0)full$Year2016<-ifelse(full$Year==2016,1,0)# 去掉Year属性full$Year<-NULL

转化isPureColor属性

# 设置一个属性标志其颜色是否是纯色的,纯色为1,不纯为0len <- sapply(full$Color,              function(x)  strsplit(x, split = '/| ')[[1]] %>% length)full$isPureColor <- ifelse(len==1, 1, 0)full$isPureColor[full$Color %in% c('Calico','Torbie','Tortie','Tricolor')] <- 0

这样判断一个动物的毛色是否是纯的就更加合理了一些


转化Name属性

这次Name特征标记其动物的名字长度:

full$Name<-sapply(as.character(full$Name),nchar)

转化动物年龄

full$AgeinDays<-ifelse(full$AgeinDays<31,0,                       ifelse(full$AgeinDays<185,1,                              ifelse(full$AgeinDays<370,2,3)))

进行预测

仍然使用xgboost进行预测,经过数次提交,发现对于Year的处理是比较好的,收到了较好的效果,但调整毛发颜色的纯度和名字的长度以及压缩动物年龄作为特征结果反而下降了,最后最好的提交结果如下:
第三次尝试


总结

  这次提交的结果不能继续上升的可能原因是:
  猫和狗作为不同的动物其品种和寿命等属性应当差别较大,对猫狗分别训练不同的模型进行预测可能会收到更好的效果。
  


继续提升

将训练集和测试集分成猫和狗单独训练模型和预测

library(dplyr)dog_train<-filter(train,AnimalType=="Dog")dog_test<-filter(test,AnimalType=="Dog")cat_train<-filter(train,AnimalType=="Cat")cat_test<-filter(test,AnimalType=="Cat")dog_targets<-dog_train$OutcomeTypecat_targets<-cat_train$OutcomeTypedog_train$AnimalID<-NULLdog_train$OutcomeType<-NULLdog_train$OutcomeSubtype<-NULLcat_train$AnimalID<-NULLcat_train$OutcomeType<-NULLcat_train$OutcomeSubtype<-NULLdog_test_ID<-dog_test$IDcat_test_ID<-cat_test$IDdog_test$ID<-NULLcat_test$ID<-NULLfull_dog <- bind_rows(dog_train, dog_test)full_cat <- bind_rows(cat_train, cat_test)full_dog$AnimalType<-NULLfull_cat$AnimalType<-NULL

提交结果:
猫狗分离进行计算
这次提升到了220名左右
这个模型可能存在过拟合的情况,我们适当的调小xgboost算法的迭代次数,经过数次尝试之后,获得的最好结果为209名:
迭代次数100

总结

这次结果不能继续提升的可能原因是:
经过了一系列的构造,虽然使得动物品种和毛色的信息得以完整的体现,但是也使得我们的特征的维数接近500,如果能够找到有效的降维手段,也许能够提升模型的性能。

继续提升

我们在生成品种和颜色的特征时,去掉了过于稀疏的这种特征,经过反复尝试,提升了一名。。。。。

 if(sum(full_dog[breed])<length(full_dog[,1])*0.0005){    full_dog[breed]<-NULL  }

最好得分

调参

经过简单调参,分数上升很大:
124

1 0
原创粉丝点击