预测海藻的数量

 

问题描述与目标

希望通过建立预测模型预测河流中有害海藻的数量。同时了解藻类的频率和水样的某些化学性质以及其他特征。

数据说明

本文采用R语言里面自带的海藻数据样本共200个，有以下几种因素影响海藻的生长，用summary对数据进行整合，如图所示。

图

每个记录有11个变量，其中3个变量是名义变量，它们分别描述水样收集的季节、收集河流的大小和河水速度。余下的8个变量是所观察水样的不同化学参数，即最大pH值、最小含氧量（O2）、平均氯化物含量(cl)、平均硝酸盐含量(NO3)、平均氨含量(NH4)、平均正磷酸含量(PO4)、平均磷酸盐含量(PO4)、平均叶绿素含量。与这些参数相关的是7种不同有害藻类在相应水样中的频率数目。并未提供所观察藻类的名称的有关信息。

数据处理

画出海藻mxPH的频数直方图、密度图。

图

我们可以从图中得到一些信息。左边的MxPH的直方图，同时显示了变量分布的核密度。右边是QQ图，绘制正态分布的散点图，虚线显示95%置信区间，可以看出上图符合正态分布。

为了了解不同河流区域PH值在不同水体中分布情况

图

但是我们从图一可以看出有许多没有用的数据，因此我们必须对数据进行清洗。剔除掉无效数据184组数据。因所以需要对数据进行填补。

填补缺失数据最简便和便捷的方法是使用一些代表中心趋势的值。代表中心趋势的值反映了变量分布的最常见值。有多个代表数据中心趋势的指标，例如平均值、中位数、众数等。最适合的选择由变量的分布决定。

对于48中的变量MxPH的缺失用平均值进行填补。

另一种获取缺失值的较少偏差估计值的方法是探寻变量之间的相关关系。利用cor命令可以得到相关矩阵的关系，然后我们通过一个已知变量的值计算出另一个未知变量的值。但是该方法（cor）产生的结果并不是很清晰，但可以通过symnum( )来改善结果的输出形式。

开始查找变量之间的相关性之前，我们要剔除样本62和样本199，因为它们有太多变量含有缺失值。然后利用相关性填补变量PO4和oPO4的缺失值。

预测模型

多元线性回归

在构造多元线性回归模型中，用knnImputation函数用欧氏距离来寻找距离个案最近的k个邻居，用中位数填补缺失值。得到的数据框clean.algae将不含有缺失值。接下来建立一个用于预测海藻频率的线性回归模型：

图

由于该图中方差比例为0.3731，所以需要精简回归模型。接着对初始模型(lm.a1)用向后消元方法得到一个新的线性模型：

图

可以看出该图中方差比例为0.3527，所以需要改变模型。

回归树分析

也可以利用回归树对模型进行建立，利用data中给的一部分数据建立回归树模型

图

对线性预测和回归树预测进行评价，采用的方法是平均绝对误差(MAE)。得到两种方法的评价值。

图

可以看出线性预测的结果是13.10681，回归树得到的结果是8.480619。

图

评价模型的稳定性，以及模型的比较和选择。

图

可以看出采用第一种回归树模型预测的结果误差最小。

对预测的数据进行评价分析

图

由图可以看出模型只有对a1,a3海藻预测比较准确。

组合的随机森林

从上面讨论可知，前两个模型都不能很好的对海藻进行预测，下面采用组合的随机森林模型。

图

从该图可以看出，采用随机森林模型总体上（有4个能很好地预测数据模型）能很好预测结果，但是海藻7预测并不理想。

至于在随机森林一直报错出现没有NA，分析是由于有一个最佳得分是线性模型，然而learn中没有线性模型导致一直出错。

图

由上图可知最终预测出来的各个海草爆发的频率。

#数据集的加载
library(DMwR)
data(“algae”)
head(algae)

#数据分析
summary(algae)
#可视化的方式查看algae的统计信息
#查看字段的分别情况
library(“car”)
par(mfrow=c(1,2))
windows()
hist(algaemxPH,prob=T,xlab = '', main='Histogram of maximum pH value', ylim = 0:1) lines(density(algaemxPH,prob=T,xlab=′′,main=′HistogramofmaximumpHvalue′,ylim=0:1)lines(density(algaemxPH,na.rm = T))
rug(jitter(algaemxPH)) windows() qqPlot(algaemxPH))windows()qqPlot(algaemxPH, main=‘Normal QQ plot of maximum pH’)
legend(“topleft”,inset=.05,
legend=c(“Theoretical quantiles”, “95%Confidence”),
lty=c(1,3),bty=“n”,col = c(“red”,“red”))
par(mfrow=c(1,1))

#绘制河流的pH值在不同水体中的分布情况
library(“Hmisc”)
windows()
bwplot(size~mxPH,data = algae,panel = panel.bpplot,
probs=seq(.01,.49,by=.01),datadensity=TRUE,
ylab=‘River Size’,xlab=‘Algal mxPH’)

#无效数据的处理
data(“algae”)
nrow(algae)
algae<-algae[-manyNAs(algae),]
nrow(algae)

#基于类数据分析的无效数据填充
data(“algae”)
algae[48,]
algae[48,“mxPH”]<-mean(algae$mxPH,na.rm=T)
algae[48,]

cor(algae[,4:18],use = “complete.obs”)
symnum(cor(algae[,4:18],use=“complete.obs”))

data(algae)
algae<-algae[-manyNAs(algae),]
nrow(algae)

algae[28,]
algae[28,“PO4”]<-42.897+1.293*algae[28,“oPO4”]
algae[28,]

#预测模型的构建,多元线性回归模型
data(“algae”)
algae<-algae[-manyNAs(algae),]
clean.algae<-knnImputation(algae,k=10)
lm.al<-lm(a1~.,data=clean.algae[,1:12])
summary(lm.al)

final.lm<-step(lm.al)
summary(final.lm)

#回归树模型预测
library(rpart)
data(“algae”)
algae<-algae[-manyNAs(algae),]
windows()
rt.al<-rpart(a1~.,data=algae[,1:12])
prettyTree(rt.al)

#模型的评价与选择
lm.predictions.al<-predict(final.lm,clean.algae)
rt.predictions.al<-predict(rt.al,algae)
mae.al.lm<-mean(abs(lm.predictions.al-algae[,“a1”]))
mae.al.rt<-mean(abs(rt.predictions.al-algae[,“a1”]))
mae.al.lm
mae.al.rt
#绘制线性回归模型预测值与实测值比较
old.par<-par(mfrow=c(1,2))
windows()
plot(lm.predictions.al,algae[,“a1”],main=“Linear Model”,
xlab=“Predictions”, ylab=“True Values”)
abline(0,1,lty=2)
windows()
plot(rt.predictions.al,algae[,“a1”],main=“Regression Tree”,
xlab=“Predictions”, ylab=“True Values”)
abline(0,1,lty=2)
par(old.par)

#评价模型的稳定性，以及模型的比较和选择
cv.rpart<-function(form,train,test,…){
m<-rpartXse(form,train,…)
p<-predict(m,test)
mse<-mean((p-resp(form,test))^2)
c(nmse=mse/mean((mean(resp(form,train))-resp(form,test))^2))
}
cv.lm<-function(form,train,test,…){
m<-lm(form,train,…)
p<-predict(m,test)
p<-ifelse(p<0,0,p)
mse<-mean((p-resp(form,test))^2)
c(nmse=mse/mean((mean(resp(form,train))-resp(form,test))^2))
}
res<-experimentalComparison(
c(dataset(a1~.,clean.algae[,1:12],‘a1’)),
c(variants(‘cv.lm’),variants(‘cv.rpart’,se=c(0,0.5,1))),
cvSettings(3,10,1234))
windows()
plot(res)

#分析两个模型对7种海藻的爆发情况预测
DSs<-sapply(names(clean.algae)[12:18],
function(x,names.attrs){
f<-as.formula(paste(x,"~."))
dataset(f,clean.algae[,c(names.attrs,x)],x)
},
names(clean.algae)[1:11])
res.all<-experimentalComparison(
DSs,c(variants(‘cv.lm’),variants(‘cv.rpart’,se=c(0,0.5,1))),
cvSettings(5,10,1234)
)
bestScores(res.all)
windows()
plot(res.all)
#海藻爆发率预测随机森林模型
library(“randomForest”)
data(clean.algae)
cv.rf <- function(form,train,test,…){
m <- randomForest(form,train,…)
p <- predict(m,test)
mse <- mean((p-resp(form,test))^2)
c(nmse=mse/mean((mean(resp(form,train))-resp(form,test))^2))
}
res.all <- experimentalComparison(
DSs,c(variants(“cv.lm”),variants(“cv.rpart”,se=c(0,0.5,1)),
variants(“cv.rf”,ntree=c(200,500,700))),
cvSettings(5,10,1234))
bestScores(res.all)
windows()
plot(res.all)
compAnalysis(res.all,against = “cv.rf.v3”,datasets = c(“a1”,“a2”,“a4”,“a6”))
#预测海藻的频率
bestModelsNames <- sapply(bestScores(res.all),function(x) x[“nmse”,“system”])
learners <- c(rf=“randomForest”,rpart =“rpartXse”,lm=“lm”)
funcs <- learners[sapply(strsplit(bestModelsNames,"\."),function(x) x[2])]
table(funcs)
parSetts <- lapply(bestModelsNames,function(x) getVariant(x,res.all)@pars)
bestModels <- list()
for(a in 1:7) {
form <- as.formula(paste(names(clean.algae)[11+a],"~."))
bestModels[[a]] <- do.call(funcs[a],
c(list(form,clean.algae[,c(1:11,11+a)]),parSetts[[a]]))
}
clean.test.algae<-knnImputation(test.algae,k=10,distData = algae[,1:11])
preds <- matrix(ncol=7,nrow=140)
for(i in 1:nrow(clean.test.algae))
preds[i,] <- sapply(1:7,function(x)
predict(bestModels[[x]],clean.test.algae[i,]))
avg.preds <- apply(algae[,12:18],2,mean)
apply( ((algae.sols-preds)^2), 2,mean) /
apply( (scale(algae.sols,avg.preds,F)^2),2,mean)