kaggle小黄车:得分0.41038

在参与泰坦尼克竞赛(https://zhuanlan.zhihu.com/p/27632002)中得来的经验,以及数据思维。也同样可以用于小黄车的竞赛中。

首先先导入包

library(readr)  
library(plyr)
library(stringr)    

其次导入数据

#setwd是设定路径的意思
setwd("C:/Users/wlh/Desktop/下载的数据")
train<-read.csv("train.csv")
test<-read.csv("test.csv")

观测数据,发现测试数据比训练数据少了三个变量分别是注册,临时,计数。
怎么办呢?那就在测试数据里加上这哥仨吧

#在测试数据里加上缺失的三个值
test$registered<-0
test$casual<-0
test$count<-0
data<-rbind(train,test)

用str()看看这里面都包含什么数据

str(data)

结果如下

'data.frame':   17379 obs. of  12 variables:
 $ datetime  : Factor w/ 17379 levels "2011-01-01 00:00:00",..: 1 2 3 4 5 6 7 8 9 10 ...
 $ season    : int  1 1 1 1 1 1 1 1 1 1 ...
 $ holiday   : int  0 0 0 0 0 0 0 0 0 0 ...
 $ workingday: int  0 0 0 0 0 0 0 0 0 0 ...
 $ weather   : int  1 1 1 1 1 2 1 1 1 1 ...
 $ temp      : num  9.84 9.02 9.02 9.84 9.84 ...
 $ atemp     : num  14.4 13.6 13.6 14.4 14.4 ...
 $ humidity  : int  81 80 80 75 75 75 80 86 75 76 ...
 $ windspeed : num  0 0 0 0 0 ...
 $ casual    : num  3 8 5 3 0 0 2 1 1 8 ...
 $ registered: num  13 32 27 10 1 1 0 2 7 6 ...
 $ count     : num  16 40 32 13 1 1 2 3 8 14 ...

可以看出共有观测17379条,12条变量
日期时间(datetime):日期和时间以“mm / dd / yyyy hh:mm”格式
季节(season):1为春,2为夏,3为秋,4为冬
假期(holiday):1为有,0为无
工作日(workingday):这一天既不是周末也不是假日,1/0
天气(weather):四类天气
1->清除,几朵云,部分多云,部分多云
2->迷雾+多云,雾+破碎的云雾,雾+少云,雾
3->轻雪和雨+雷暴+分散的云彩,小雨+分散的云彩
4->大雨+冰托盘+雷雨+雾,雪+雾
温度(temp):每小时摄氏温度
??(atemp):像是一种加过权重之后的温度
湿度(humidity):湿度
风速(windspeed):风速
casual :休闲用户
registered:注册用户
count:共计数

ps:数据集显示两年(2011年和2012年)的数据。训练数据集是每个月的前19天。测试数据集是从20日到次月。

找出缺失值

#找缺失值
table(is.na(data))

结果如下

FALSE 
208548 

其实木有缺失值

了解数值变量的分布,然后生成数值变量的频率表。绘制每个数值变量的直方图,并分析

#绘制每个变量的直方图并分析
#四行两列
par(mfrow=c(4,2))
#宽度和长度
par(mar = rep(2, 4))
hist(data$season)
hist(data$weather)
hist(data$humidity)
hist(data$holiday)
hist(data$workingday)
hist(data$temp)
hist(data$atemp)
hist(data$windspeed)
kaggle小黄车:得分0.41038_第1张图片
image.png

通过观察上图可以看出一些影响
1.四季的影响不大
2.天气的影响比较大,从好到不好,自行车的使用量越来越低
3.当假期为0,工作日为1时自行车的使用量就比较大
4.温度太高或者太低了都会影响使用量
5.风速从5到20这个时候自行车使用量比较大,可以推测在这个风速里骑车是比价愉悦的

将离散变量转换为因子变量(季节,天气,假期,工作​​日)

data$season=as.factor(data$season)
data$weather=as.factor(data$weather)
data$holiday=as.factor(data$holiday)
data$workingday=as.factor(data$workingday)

假设生成
现在你对数据已经有了一个大致的了解,下面让我们来根据一些基本的经验来对自行车的使用量进行假设

24小时趋势:上下班高峰期使用量就很高。晚上10点到凌晨4点需求低
一周趋势:平日用车比节假日高
有雨(雪):与晴天相比,下雨(雪)天的自行车需求将会下降。同样,较高的湿度会降低需求,反之亦然。
温度:温度适宜的情况下使用量必加大
注册用户与时间:由于注册用户数量随着时间的推移得增多,总需求应该趋向于升高

假设检验
下面来逐一分析上面的假设检验
每日趋势:

data$hour=substr(data$datetime,12,13)
data$hour=as.factor(data$hour)

画图,判断假设是否正确

#把训练的前20天和测试的后10天左右提出来
train=data[as.integer(substr(data$datetime,9,10))<20,]
test=data[as.integer(substr(data$datetime,9,10))>19,]
#画图
boxplot(train$count~train$hour,xlab="hour", ylab="count of users")

如图:


kaggle小黄车:得分0.41038_第2张图片
image.png

可以看出和我们的假设差不多
上下班时间是用车高峰,而低峰期是在晚上10点到次日凌晨6点。其他时间为平均用车量

然后我们再来看一下注册用户和临时用户的差别:

#临时用户
boxplot(train$casual~train$hour,xlab="hour", ylab="count of users")

如图:

kaggle小黄车:得分0.41038_第3张图片
image.png

可以看出临时用户倾向于在白天的时候随便用用,基本上都是平均值

#注册用户
boxplot(train$registered~train$hour,xlab="hour", ylab="count of users")

如图:

kaggle小黄车:得分0.41038_第4张图片
image.png

而注册用户更倾向于上下班高峰期用

但是你会发现,这俩图有好些个异常值,应该不是由错误导致的。他们可能是同一群人骑自行车但是未注册的结果,为了处理这些离群值,我们将使用对数变换。

boxplot(log(train$count)~train$hour,xlab="hour",ylab="log(count)")

如图:

kaggle小黄车:得分0.41038_第5张图片
image.png

一周趋势:

#把date$datetime的年月日拆出来
date<-substr(data$datetime,1,10)
#拆出来之后转换成星期
days<-weekdays(as.Date(date))
data$day<-days

注册用户画图:

kaggle小黄车:得分0.41038_第6张图片
image.png

临时用户:

#画临时用户的图
boxplot(train$casual~train$day,xlab="day", ylab="users")
kaggle小黄车:得分0.41038_第7张图片
image.png

可以看出星期六星期天的用户是增加的

雨(雪)的影响:在观测中虽然没有专门的雨量数据,但是在天气(weather)这里面有响应的因素,3里有小雨(雪),4里有大雨(雪)

#画图,天气和注册用户的关系
boxplot(train$registered~train$weather,xlab="weather", ylab="registered users")

如图:


kaggle小黄车:得分0.41038_第8张图片
image.png
#画图,天气和休闲用户的关系
boxplot(train$casual~train$weather,xlab="weather", ylab="casual users")

如图:

kaggle小黄车:得分0.41038_第9张图片
image.png

从图中可以看出非常符合我们的预期

温度,风速和湿度:这些不是离散型的,是连续的。所以我们用相关来验证假设

#温度,风速和湿度的相关关系
sub<-data.frame(train$registered,train$casual,train$count,train$temp,train$humidity,train$atemp,train$windspeed)
subT<-cor(sub)

如下表:

kaggle小黄车:得分0.41038_第10张图片
image.png

从表中可以看出,温度和注册,休闲,总计这三个变量差不多都是正相关关系,而湿度和风速跟这三兄弟的关系就不是很大了。温度和atemp是高度相关。

时间:看看时间对于用户数的影响

#随着时间的推移,用户数的变化
data$year=substr(data$datetime,1,4)
data$year=as.factor(data$year)
train=data[as.integer(substr(data$datetime,9,10))<20,]
test=data[as.integer(substr(data$datetime,9,10))>19,]
boxplot(train$count~train$year,xlab="year", ylab="count")

如图:

kaggle小黄车:得分0.41038_第11张图片
image.png

结论是用户数增加。

决策树
让我们用决策树来增加模型的预测能力

第一步添加决策树相应的包

#决策树要用到的包
library(rpart)#在我的泰坦尼克竞赛里有对这个包的介绍
library(rattle) #这些库将用于为决策树模型提供良好的可视化绘图
library(rpart.plot)#绘制“rpart”模型:“plot.rpart”的增强版本
library(RColorBrewer)#配色方案

然后话关于小时的决策树的图

#训练数据转换类型
train$hour=as.integer(train$hour)
#测试数据转换类型
test$hour=as.integer(test$hour)
#用小时生成决策树
d=rpart(registered~hour,data=train)
#画图
fancyRpartPlot(d)

如图:

kaggle小黄车:得分0.41038_第12张图片
image.png

查看节点,手动添加仓位(注册用户)

data=rbind(train,test)
data$dp_reg=0
data$dp_reg[data$hour<8]=1
data$dp_reg[data$hour>=22]=2
data$dp_reg[data$hour>9 & data$hour<18]=3
data$dp_reg[data$hour==8]=4
data$dp_reg[data$hour==9]=5
data$dp_reg[data$hour==20 | data$hour==21]=6
data$dp_reg[data$hour==19 | data$hour==18]=7

添加仓位(休闲用户)

#休闲用户
b=rpart(casual~hour,data=train)
fancyRpartPlot(b)

如图:

kaggle小黄车:得分0.41038_第13张图片
image.png

添加仓位

#手动添加
data$dp_cas=0
data$dp_cas[data$hour==9]=1
data$dp_cas[data$hour<=8]=2
data$dp_cas[data$hour>=10&data$hour<=19]=3
data$dp_cas[data$hour>=20]=4

温度同上:

#温度(注册)
t=rpart(registered~temp,data=train)
fancyRpartPlot(t)

如图:

kaggle小黄车:得分0.41038_第14张图片
image.png
#添加注册
data$temp_reg=0
data$temp_reg[data$temp<13]=1
data$temp_reg[data$temp>=13&data$temp<23]=2
data$temp_reg[data$temp>=23&data$temp<30]=3
data$temp_reg[data$temp>=30]=4

温度(休闲)

#温度(休闲)
t1=rpart(casual~temp,data=train)
fancyRpartPlot(t1)

如图:

kaggle小黄车:得分0.41038_第15张图片
image.png
#添加休闲
data$temp_cas=0
data$temp_cas[data$temp<15]=1
data$temp_cas[data$temp>=15&data$temp<23]=2
data$temp_cas[data$temp>=23&data$temp<30]=3
data$temp_cas[data$temp>=30]=4

添加年份:在这里先把月份提取出来,然后按照每个季度一个仓位,建8个仓位

#提取月份
data$month=substr(data$datetime,6,7)
data$month=as.factor(data$month)
train=data[as.integer(substr(data$datetime,9,10))<20,]
test=data[as.integer(substr(data$datetime,9,10))>19,]
#转换类型
data$month=as.integer(data$month)
#手动添加
data$year_part[data$year=='2011']=1
data$year_part[data$year=='2011' & data$month>3]=2
data$year_part[data$year=='2011' & data$month>6]=3
data$year_part[data$year=='2011' & data$month>9]=4
data$year_part[data$year=='2012']=5
data$year_part[data$year=='2012' & data$month>3]=6
data$year_part[data$year=='2012' & data$month>6]=7
data$year_part[data$year=='2012' & data$month>9]=8
table(data$year_part)

日期:创建一个变量,有“平日”、“周末”和“假日”

data$day_type=""
data$day_type[data$holiday==0 & data$workingday==0]="weekend"
data$day_type[data$holiday==1]="holiday"
data$day_type[data$holiday==0 & data$workingday==1]="working day"

周末:为周末创建一个独立的变量

data$weekend=0
data$weekend[data$day=="Sunday" | data$day=="Saturday" ]=1

开始建模
首先把character的数据类型都转换成factor,否则随机森林不支持

#转换数据类型,否则随机森林不支持
data$day=as.factor(data$day)
data$day_type=as.factor(data$day_type)

我们之前分析过由于注册,休闲,计数。这哥仨有很多自然离群值,所以这里就把他们都转换成对数。

#取对数
data$logreg<-log(data$registered+1)
data$logcas<-log(data$casual+1)

加一是为了处理注册和休闲这俩观测的0值

#将data里的所有观测和类型统统赋值给train,test
train=data[as.integer(substr(data$datetime,9,10))<20,]
test=data[as.integer(substr(data$datetime,9,10))>19,]

预测

#预测注册用户的对数
set.seed(415)
fit1 <- randomForest(logreg ~ hour +workingday+day+holiday+ day_type +temp_reg+humidity+atemp+windspeed+season+weather+dp_reg+weekend+year+year_part, data=train,importance=TRUE, ntree=250)
pred1=predict(fit1,test)
test$logreg=pred1

可能我的电脑比较渣,这里运算了1个小时

#预测休闲用户的对数
set.seed(415)
fit2 <- randomForest(logcas ~hour + day_type+day+humidity+atemp+temp_cas+windspeed+season+weather+holiday+workingday+dp_cas+weekend+year+year_part, data=train,importance=TRUE, ntree=250)
pred2=predict(fit2,test)
test$logcas=pred2

啊,又小一个小时过去了。。。

写入文件上传

#重新转换预测变量,然后将count的输出写入文件
test$registered=exp(test$logreg)-1
test$casual=exp(test$logcas)-1
test$count=test$casual+test$registered
s<-data.frame(datetime=test$datetime,count=test$count)
write.csv(s,file="pre3.csv",row.names=FALSE)

由于没有排名系统所以只有得分......
得了0.41038分


kaggle小黄车:得分0.41038_第16张图片
image.png

你可能感兴趣的:(kaggle小黄车:得分0.41038)