1、Crime&Shock數(shù)據(jù)集分析展示探索性數(shù)據(jù)分析Communities and CrimeUnnormalized Data Set （Data source）2一、數(shù)據(jù)預(yù)處理#導(dǎo)入crime數(shù)據(jù)，修改變量名稱，并查看數(shù)據(jù)屬性crim=read.table(crim.txt,sep=,na.string=?)name=read.table(attr_vol.txt)name=name,2colnames(crim)-namesummary(crim) dim(crim)3觀測值：2215 變量數(shù)：147部分?jǐn)?shù)據(jù)嚴(yán)重缺失四、犯罪率分布情況4在3月份的行業(yè)銷售旺季，東北地區(qū)及北部地區(qū)銷售額占到公

2、司全月總額的70%，西部地區(qū)僅為10%，西部死去市場潛力還需深度挖掘?？煽闯鰒iolentPerPop nonViolPerPop都出現(xiàn)了不同程度的拖尾特征，考慮對數(shù)據(jù)進(jìn)行對數(shù)變換由圖可知四、對數(shù)化變換5做變換后兩變量數(shù)據(jù)較為對稱由圖可知四、犯罪率地區(qū)差異6三個(gè)地區(qū)犯罪率的中位數(shù)由西向東遞減，分布相對集中，但東部地區(qū)出現(xiàn)了較為明顯的離群值7缺失值處理nrow(crim!complete.cases(crim),) #缺失值項(xiàng)的總行數(shù)#基本每行都有缺失值na.sta=c()for(i in 1:2215)na.sta=c(na.sta,length(which(is.na(crimi,)max(

3、na.sta)#缺失值基本在20左右，沒有#缺失過于嚴(yán)重的樣本，無需刪除8缺失值處理：臨近值插補(bǔ)從數(shù)據(jù)集中選取若干條其他屬性和它相似的樣本(即和它在空間歐式距離最短的n 條樣本)，求其中位數(shù)進(jìn)行插補(bǔ)crim$gangUnit=as.factor(gangUnit)crim1=crim,c(6:126,128:147)library(cluster) #調(diào)用R 語言中的cluster 包#計(jì)算空間距離dist.mtx - as.matrix(daisy(crim1,stand=T) #計(jì)算這2215 個(gè)樣品的空間距離9缺失值處理：臨近值插補(bǔ)#先處理非因子型變量的缺失值,需要將以下步驟進(jìn)行兩次fo

4、r(r in which(!complete.cases(crim1)crim1r,which(is.na(crim1r,) 0.7）Linear Regressionfor(i in 1:5)crim.test=data.frame(crim1ddi,)crim.train=data.frame(crim1-ddi,)lm.vio=lm(violentPerPop.,data=crim.train,c(6:129,146)pre.train=predict(lm.vio)pre.test=predict(lm.vio, crim.test,c(6:129,146)NM.train=mean(

5、crim.train$violentPerPop-pre.train)2)/mean(mean(crim.train$violentPerPop)-crim.train$violentPerPop)2)NM.test=mean(crim.test$violentPerPop-pre.test)2)/mean(mean(crim.test$violentPerPop)-crim.test$violentPerPop)2)M.train=mean(crim.train$violentPerPop-pre.train)2)M.test=mean(crim.test$violentPerPop-pre

6、.test)2)NMSE.train=c(NMSE.train,NM.train)NMSE.test=c(NMSE.test,NM.test)MSE.train=c(MSE.train,M.train)MSE.test=c(MSE.test,M.test)16Linear Regression17Stepwise#逐步回歸：全部、前向、后向lm1both-step(lm.vio,direction= both)lm1forward-step(lm.vio,direction= forward)lm1back-step(lm.vio,direction= backward)final.lm-st

7、ep(lm.vio)summary(final.lm)18Stepwise19Stepwise20Stepwise：diagnose21Stepwise22Stepwise23Conclusion 由結(jié)果可以看出，逐步回歸調(diào)整后的的R-Square為0.6957，模型檢驗(yàn)的結(jié)果顯示，回歸的殘差項(xiàng)并不滿足正態(tài)性假定，同時(shí)模型的AIC值25573.06依然過高，這啟發(fā)我們建立更加精確的預(yù)測模型。24Ridge25Ridgecor(crim,6:129,use=complete.obs) #變量間的相關(guān)性，計(jì)算時(shí)不考慮缺失值symnum(cor(crim,6:129,use=complete.obs

8、) #簡單明顯示出變量間的相關(guān)#只截取部分結(jié)果顯示，可以看出#變量之間的共線性較為明顯26Ridgelibrary(MASS)ridgelm-lm.ridge(violentPerPop.,data=crim.train,c(6:129,146),lambda=seq(0,200,0.01), model =TRUE)names(ridgelm)ridgelm$lambdawhich.min(ridgelm$GCV) #找到GCV 最小時(shí)對應(yīng)的lambda#廣義的交叉驗(yàn)證準(zhǔn)則GCV，越小越好ridgelm$coef,which.min(ridgelm$GCV) #找到GCV 最小時(shí)對應(yīng)的系數(shù)2

9、7Ridge#lamda 同GCV 之間關(guān)系的圖形plot(ridgelm$lambda,ridgelm$GCV,type=l)abline(v=ridgelm$lambdawhich.min(ridgelm$GCV),col=green)28LassoLASSO方法 在線性模型中，人們必須選擇合適的變量；比如常用的逐步回歸法就是選擇顯著的變量而拋棄那些不顯著的。Tibshirani(1996)1提出了一個(gè)新的方法來處理變量選擇的問題。該方法在模型系數(shù)絕對值的和小于某常數(shù)的條件下，謀求殘差平方和最小。該方法既提供了如子集選擇方法那樣的可以解釋的模型，也具有嶺回歸那樣的穩(wěn)定性。它不刪除變量，但使

10、得一些回歸系數(shù)收縮、變小，甚至為0。因而，該方法被稱為lasso(least absolute shrinkage and selection operator，最小絕對值收縮和選擇算子2)。 29Lasso#將數(shù)據(jù)集中的因子變量gangUnit轉(zhuǎn)換為啞元變量#訓(xùn)練集gangUnit5=rep(0,1772);gangUnit5which(crim.train$gangUnit=5)=1gangUnit10=rep(0,1772);gangUnit10which(crim.train$gangUnit=10)=1crim.train1=crim.train,c(6:129);crim.trai

11、n1$gangUnit=NULLcrim.train2=data.frame(crim.train1,1:121,gangUnit5,gangUnit10,crim.train1,-(1:121)#測試集gangUnit5=rep(0,443);gangUnit5which(crim.test$gangUnit=5)=1gangUnit10=rep(0,443);gangUnit10which(crim.test$gangUnit=10)=1crim.test1=crim.test,c(6:129);crim.test1$gangUnit=NULLcrim.test2=data.frame(c

12、rim.test1,1:121,gangUnit5,gangUnit10,crim.test1,-(1:121)30Lasso(lars)library(lars)attach(crim.train)lassolm-lars(as.matrix(crim.train2),violentPerPop)Lassolm31Lasso(msgps)library(msgps)fit - msgps(as.matrix(crim.train2),crim.train$violentPerPop)summary(fit)32Lasso(lars)lassolm$Cp33Lasso(msgps)coef(f

13、it) #extract coefficients at t selected by model selection criteriacbind(coef(fit),ridgelm$coef,which.min(ridgelm$GCV)1:10,)注：如圖，根據(jù)前三個(gè)準(zhǔn)則得出的最終模型系數(shù)基本一致，最后一列為嶺回歸Cp原則的系數(shù)，可以看出lasso方法可以使更多的系數(shù)“收縮”到0。34Lasso(msgps)plot(fit,criterion=cp,main=lasso)35Lasso(lars)36Lasso(lars)predict11-predict(lassolm,data.matr

14、ix(crim.train2),mode=fraction,s=best,type=fit)predict1-predict(lassolm,data.matrix(crim.test2),mode=fraction,s=best,type=fit)cat(lasso 訓(xùn)練集上的NMSE 為:, mean(crim.train$violentPerPop-as.numeric(predict11$fit)2)/mean(mean(crim.train$violentPerPop)-crim.train$violentPerPop)2), n)lasso 訓(xùn)練集上的NMSE 為: 0.30506

15、13 (依據(jù)10 折交叉驗(yàn)證)cat(lasso 測試集上的NMSE 為:,mean(crim.test$violentPerPop-as.numeric(predict1$fit)2)/mean(mean(crim.test$violentPerPop)-crim.test$violentPerPop)2), n)lasso測試集上的NMSE 為: 0.3388574 (依據(jù)10 折交叉驗(yàn)證)37Lasso(lars)predict11-predict(lassolm,data.matrix(crim.train2),mode=step,s=best,type=fit)predict1-pr

16、edict(lassolm,data.matrix(crim.test2),mode=step,s=best,type=fit)cat(lasso 訓(xùn)練集上的NMSE 為:, mean(crim.train$violentPerPop-as.numeric(predict11$fit)2)/mean(mean(crim.train$violentPerPop)-crim.train$violentPerPop)2), n)#lasso 訓(xùn)練集上的NMSE 為:0.3248435 (依據(jù)Cp 準(zhǔn)則)cat(lasso 測試集上的NMSE 為:,mean(crim.test$violentPerP

17、op-as.numeric(predict1$fit)2)/mean(mean(crim.test$violentPerPop)-crim.test$violentPerPop)2), n)#lasso測試集上的NMSE 為: 0.3352093 (依據(jù)Cp 準(zhǔn)則)38Lasso# 下面我們來看看上面（根據(jù)10 折交叉驗(yàn)證得出的lasso回歸方程）它的殘差項(xiàng)的正態(tài)性檢驗(yàn)。shapiro.test(crim.train$violentPerPop-predict11$fit) #訓(xùn)練集上的殘差檢驗(yàn)#W = 0.8679, p-value 2.2e-16shapiro.test(crim.test

18、$violentPerPop-predict1$fit) #測試集上的殘差檢驗(yàn)W = 0.8839, p-value 2.2e-16 可以看出上述模型的殘差項(xiàng)仍然不滿足正態(tài)性的分布假定，雖然達(dá)到了較好的預(yù)測精度，但是我們的模型還需要進(jìn)一步改進(jìn)39Ridge&Lasso 實(shí)際上，嶺回歸和lasso方法都是用于處理模型變量共線性的方式。在傳統(tǒng)線性回歸當(dāng)中，變量共線性極有可能導(dǎo)致估計(jì)的回歸系數(shù)的不穩(wěn)定（這一特性在樣本總量較少而變量總數(shù)較多的情形下尤其顯著），這一缺點(diǎn)可以通過對回歸系數(shù)加以約束得到改善。 不妨設(shè)約束函數(shù)為如下形式，則嶺回歸和lasso回歸可以在參數(shù)族的形式下得到統(tǒng)一（嶺回歸：r=2;

19、lasso: r=1） 雖然只是參數(shù)取法上的不一致，但由于約束函數(shù)凹凸函數(shù)不同的特性（r1為凸函數(shù)）導(dǎo)致了最終系數(shù)特點(diǎn)的不一致。對于嶺回歸，隨著t的減小，模型系數(shù)絕對值一般“步調(diào)一致”的收縮；對于lasso回歸，則更傾向于將部分變量的系數(shù)收斂到0而保持另外一些變量系數(shù)的大小來達(dá)到約束條件（這實(shí)際上增加了最終系數(shù)的差異） 對于r取值的其他情形而導(dǎo)致的后果也可由函數(shù)凹凸性作相似推斷。具體參見 Fast Sparse Regression and Classification Jerome H. Friedman 200840Ridge&Lasso 這一參數(shù)族中r的選取也帶來很多問題，對于r1，最終

20、系數(shù)不易收縮到0，這不助于變量的篩選；而對于r1/2時(shí)也能得到同樣的效果。這一方法提高了原系數(shù)估計(jì)的穩(wěn)定性。42Generalized elastic net#elastic netfit2 - msgps(as.matrix(crim.train2),crim.train$violentPerPop,penalty=enet,alpha=0.5)summary(fit2) coef(fit2)plot(fit2,criterion=cp)43Generalized elastic net44Generalized elastic net#根據(jù)Cp原則NMSE.train=c()NMSE.te

21、st=c()for(i in 1:5)crim.test=crim1ddi,crim.train=crim1-ddi,#訓(xùn)練集gangUnit5=rep(0,1772);gangUnit5which(crim.train$gangUnit=5)=1gangUnit10=rep(0,1772);gangUnit10which(crim.train$gangUnit=10)=1crim.train1=crim.train,c(6:129);crim.train1$gangUnit=NULLcrim.train2=data.frame(crim.train1,1:121,gangUnit5,gang

22、Unit10,crim.train1,-(1:121)#測試集gangUnit5=rep(0,443);gangUnit5which(crim.test$gangUnit=5)=1gangUnit10=rep(0,443);gangUnit10which(crim.test$gangUnit=10)=1crim.test1=crim.test,c(6:129);crim.test1$gangUnit=NULLcrim.test2=data.frame(crim.test1,1:121,gangUnit5,gangUnit10,crim.test1,-(1:121)45Generalized e

23、lastic netfit - msgps(as.matrix(crim.train2),crim.train$violentPerPop,penalty=enet,alpha=0.5)#訓(xùn)練集predict11-predict(fit,as.matrix(crim.train2),1NMSE.train=c(NMSE.train,mean(crim.train$violentPerPop-as.numeric(predict11)2)/mean(mean(crim.train$violentPerPop)-crim.train$violentPerPop)2)#測試集predict1-pre

24、dict(fit,as.matrix(crim.test2),1NMSE.test=c(NMSE.test,mean(crim.test$violentPerPop-as.numeric(predict1)2)/mean(mean(crim.test$violentPerPop)-crim.test$violentPerPop)2)NMSE.train;mean(NMSE.train)NMSE.test;mean(NMSE.test)46Generalized elastic netpenalty=“genet”(penalty=“alasso”時(shí)計(jì)算出現(xiàn)奇異值系統(tǒng)報(bào)錯(cuò))47Model bui

25、ldingData Mining48K臨近回歸library(kknn)NMSE=c()MSE=c()for(i in 1:5)crim.test=crim1ddi,crim.train=crim1-ddi,knn1lm-kknn(murders.,crim.train,6:130,crim.test,6:130,k=1,distance =1,kernel = rectangular)NM=mean(crim.test$murders-knn1lm$fitted.values)2)/mean(mean(crim.test$murders)-crim.test$murders)2)M=mean

26、(crim.test$murders-knn1lm$fitted.values)2)NMSE=c(NMSE,NM)MSE=c(MSE,M)49 雖然該算法主要用于分類。不用于擬合模型，但其較為穩(wěn)定，可先利用該模型觀察擬合效果以及預(yù)測精度再試圖從不穩(wěn)定模型中得到提升。K臨近回歸50最終達(dá)到的預(yù)測精度如下，可見該方法的預(yù)測精度仍然較低：回歸樹library(rpart) #調(diào)用rpart 包c(diǎn)rim.test=data.frame(crim1dd1,)crim.train=data.frame(crim1-dd1,)rt.train=rpart(violentPerPop.,data=crim.t

27、rain,c(6:129,146)plot(rt.train,uniform=T,branch=1, margin=0.1, cex=0.9,main=violentPerPop) #畫出回歸樹text(rt.train,cex=0.75) #在樹中顯示分枝的信息。printcp(rt.train) #顯示回歸樹rt.train 每一步得出的sub-trees 的詳細(xì)信息51回歸樹52回歸樹treepre.train=predict(rt.train,crim.train,c(6:129,146)cat(tree 訓(xùn)練集上的NMSE 為:, mean(crim.train,c(6:129,14

28、6)$violentPerPop-as.numeric(treepre.train)2)/mean(mean(crim.train,c(6:129,146)$violentPerPop)-crim.train,c(6:129,146)$violentPerPop)2),n)#tree 訓(xùn)練集上的NMSE 為: 0.3664984 treepre.test=predict(rt.train,crim.test,c(6:129,146)cat(tree 訓(xùn)練集上的NMSE 為:, mean(crim.test,c(6:129,146)$violentPerPop-as.numeric(treepr

29、e.test)2)/mean(mean(crim.test,c(6:129,146)$violentPerPop)-crim.test,c(6:129,146)$violentPerPop)2),n)#tree 測試集上的NMSE 為: 0.482897253回歸樹：五折交叉驗(yàn)證for(i in 1:5)crim.test=data.frame(crim1ddi,)crim.train=data.frame(crim1-ddi,)rt.train=rpart(violentPerPop.,data=crim.train,c(6:129,146)treepre.train=predict(rt.

30、train,crim.train,c(6:129,146)treepre.test=predict(rt.train,crim.test,c(6:129,146)NM.train=mean(crim.train$violentPerPop-treepre.train)2)/mean(mean(crim.train$violentPerPop)-crim.train$violentPerPop)2)NM.test=mean(crim.test$violentPerPop-treepre.test)2)/mean(mean(crim.test$violentPerPop)-crim.test$vi

31、olentPerPop)2)M.train=mean(crim.train$violentPerPop-treepre.train)2)M.test=mean(crim.test$violentPerPop-treepre.test)2)NMSE.train=c(NMSE.train,NM.train)NMSE.test=c(NMSE.test,NM.test)MSE.train=c(MSE.train,M.train)MSE.test=c(MSE.test,M.test)54回歸樹55Boosting(mboost)for(i in 1:5)crim.test=data.frame(crim

32、1ddi,)crim.train=data.frame(crim1-ddi,)boost.train=blackboost(violentPerPop.,control=boost_control(mstop=50),data=crim.train,c(6:129,146)treepre.train=predict(boost.train,crim.train,c(6:129,146)treepre.test=predict(boost.train,crim.test,c(6:129,146)NM.train=mean(crim.train$violentPerPop-treepre.trai

33、n)2)/mean(mean(crim.train$violentPerPop)-crim.train$violentPerPop)2)NM.test=mean(crim.test$violentPerPop-treepre.test)2)/mean(mean(crim.test$violentPerPop)-crim.test$violentPerPop)2)M.train=mean(crim.train$violentPerPop-treepre.train)2)M.test=mean(crim.test$violentPerPop-treepre.test)2)NMSE.train=c(

34、NMSE.train,NM.train)NMSE.test=c(NMSE.test,NM.test)MSE.train=c(MSE.train,M.train)MSE.test=c(MSE.test,M.test)56Boosting57BaggingBagging 是Breiman 提出的與Boosting 相似的技術(shù)。Bagging 技術(shù)的主要思想是給定一弱學(xué)習(xí)算法和一訓(xùn)練集1 1 ( , ),., ( , ) n n x y x y 。讓該學(xué)習(xí)算法訓(xùn)練多輪，每輪的訓(xùn)練集由從初始的訓(xùn)練集中隨機(jī)取出的n 個(gè)訓(xùn)練例組成，初始訓(xùn)練例在某輪訓(xùn)練集中可以出現(xiàn)多次或根本不出現(xiàn)。訓(xùn)練之后可得到一個(gè)預(yù)測函

35、數(shù)序列：1,., t h h ，最終的預(yù)測函數(shù)H 對分類問題采用投票方式，對回歸問題采用簡單平均方法對新示例進(jìn)行判別。Bagging 與Boosting 的區(qū)別在于Bagging 的訓(xùn)練集的選擇是隨機(jī)的，各輪訓(xùn)練集之間相互獨(dú)立，而 Boosting 的訓(xùn)練集的選擇不是獨(dú)立的，各輪訓(xùn)練集的選擇與前面各輪的學(xué)習(xí)結(jié)果有關(guān)；Bagging 的各個(gè)預(yù)測函數(shù)沒有權(quán)重，而Boosting是有權(quán)重的；Bagging 的各個(gè)預(yù)測函數(shù)可以并行生成，而Boosting 的各個(gè)預(yù)測函數(shù)只能順序生成。對于象神經(jīng)網(wǎng)絡(luò)這樣極為耗時(shí)的學(xué)習(xí)方法，Bagging 可通過并行訓(xùn)練節(jié)省大量時(shí)間開銷。以下我將通過R 語言中的ipred

36、 包運(yùn)用Bagging 算法對該數(shù)據(jù)集進(jìn)行分析研究。58Bagging(ipred)for(i in 1:5)crim.test=data.frame(crim1ddi,)crim.train=data.frame(crim1-ddi,)bagging.vio=bagging(violentPerPop.,data=crim.train,c(6:129,146),coob=T,control=rpart.control(xval=10)pre.train=predict(bagging.vio,crim.train,c(6:129,146)pre.test=predict(bagging.vi

37、o,crim.test,c(6:129,146)NM.train=mean(crim.train$violentPerPop-pre.train)2)/mean(mean(crim.train$violentPerPop)-crim.train$violentPerPop)2)NM.test=mean(crim.test$violentPerPop-pre.test)2)/mean(mean(crim.test$violentPerPop)-crim.test$violentPerPop)2)M.train=mean(crim.train$violentPerPop-pre.train)2)M

38、.test=mean(crim.test$violentPerPop-pre.test)2)NMSE.train=c(NMSE.train,NM.train)NMSE.test=c(NMSE.test,NM.test)MSE.train=c(MSE.train,M.train)MSE.test=c(MSE.test,M.test)59Bagging60隨機(jī)森林（randomForest）randomforest.violentPerPop - randomForest(violentPerPop .,data=crim.train,c(6:129,146),ntree=500,importan

39、ce=TRUE,proximity=TRUE)randomforest.violentPerPop$importance #查看解釋變量對模型的貢獻(xiàn)性的大小randomforest.violentPerPop$importanceSD61隨機(jī)森林（randomForest）#貢獻(xiàn)度最大的前十個(gè)變量names(crim.train,c(6:129,146)sort(randomforest.violentPerPop$importance,1,decreasing=T,index.return=T)$ix1:10plot(randomforest.violentPerPop$importance

40、SD)identify(1:124,randomforest.violentPerPop$importanceSD,labels=names(randomforest.violentPerPop$importanceSD)62隨機(jī)森林（randomForest）63隨機(jī)森林（randomForest）64總結(jié)65方法NMSE訓(xùn)練集測試集傳統(tǒng)統(tǒng)計(jì)方法線性回歸0.29000.3729逐步回歸0.29640.3774lasso0.30510.3389Generalized elastic net0.29380.3677數(shù)據(jù)挖掘K臨近回歸無0.6257回歸樹0.35290.4627Boosting0.

41、27530.3496Bagging0.26950.3589隨機(jī)森林0.32580.3228Shock Data(Data source)66數(shù)據(jù)預(yù)處理67shock=read.table(shock.txt,header=T)head(shock)shock$SHOCK_TYP=as.factor(shock$SHOCK_TYP)shock$SURVIVE=as.factor(shock$SURVIVE)shock$SEX=as.factor(shock$SEX)shock$RECORD=as.factor(shock$RECORD)數(shù)據(jù)描述6869數(shù)據(jù)描述70數(shù)據(jù)描述71數(shù)據(jù)描述Record

42、不同時(shí)的shock type完全相同72數(shù)據(jù)描述由圖可知Record不同時(shí)各觀測值有差異但不明顯，由箱盒圖可以看到HT與RCI中存在離群值貝葉斯分類distinguish.bayes - function(TrnX, TrnG, p = rep(1, length(levels(TrnG),TstX = NULL, var.equal = FALSE)if ( is.factor(TrnG) = FALSE)mx - nrow(TrnX); mg - nrow(TrnG)TrnX - rbind(TrnX, TrnG)TrnG - factor(rep(1:2, c(mx, mg)if (is

43、.null(TstX) = TRUE) TstX - TrnXif (is.vector(TstX) = TRUE) TstX - t(as.matrix(TstX)else if (is.matrix(TstX) != TRUE)TstX - as.matrix(TstX)if (is.matrix(TrnX) != TRUE) TrnX - as.matrix(TrnX)nx - nrow(TstX)blong - matrix(rep(0, nx), nrow=1,dimnames=list(blong, 1:nx)g - length(levels(TrnG)mu - matrix(0

44、, nrow=g, ncol=ncol(TrnX)73貝葉斯分類for (i in 1:g)mui, - colMeans(TrnXTrnG=i,)D - matrix(0, nrow=g, ncol=nx)if (var.equal = TRUE | var.equal = T)for (i in 1:g)d2 - mahalanobis(TstX, mui, var(TrnX)Di, - d2 - 2*log(pi)elsefor (i in 1:g)S - var(TrnXTrnG=i,)d2 - mahalanobis(TstX, mui, S)Di, - d2 - 2*log(pi)

45、-log(det(S)for (j in 1:nx)dmin - Inffor (i in 1:g)if (Di,j dmin)dmin - Di,j; blongj - iblong74貝葉斯分類shock2=shockshock2$SURVIVE=as.numeric(shock2$SURVIVE)shock2$SEX=as.numeric(shock2$SEX)shock2$RECORD=as.numeric(shock2$RECORD)distinguish.bayes(shock2,-c(1,6),shock2$SHOCK_TYP)#將因子數(shù)據(jù)轉(zhuǎn)化為0 1變量shock2=shock

46、,-c(which(names(shock)=SHOCK_TYP),which(names(shock)=SURVIVE),which(names(shock)=SEX),which(names(shock)=RECORD)shock3=cbind(shock2,sex=as.numeric(sex,1),survive=as.numeric(survive,1),record=as.numeric(record,1)75決策樹library(rpart) #調(diào)用rpart 包rt.type - rpart(SHOCK_TYP .,data= shock-dd1,-1)rt.type76決策樹

47、77決策樹printcp(rt.type) #顯示回歸樹rt.type 每一步得出的sub-trees 的詳細(xì)信息78決策樹#五折交叉驗(yàn)證train=c();test=c();for(i in 1:5)rt.type - rpart(SHOCK_TYP .,data= shock-ddi,)c1=t(table(predict(rt.type,shock-ddi,type=class),shock-ddi,6)c2=t(table(predict(rt.type,shockddi,type=class),shockddi,6)train=c(train,sum(diag(c1)/sum(c1)

48、test=c(test,sum(diag(c2)/sum(c2)train;mean(train)test;mean(test)79最鄰近算法80#五折交叉驗(yàn)證,對k=1:15做循環(huán)final.test=c();final.mean=c()for(j in 1:15)test=c();for(i in 1:5)knn1lm-kknn(SHOCK_TYP.,shock-ddi,shockddi,k=j,distance =1,kernel = rectangular)c=table(shockddi,6, knn1lm$fitted.values)test=c(test,sum(diag(c)/

49、sum(c)final.test=cbind(final.test,test)final.mean=c(final.mean,mean(test)final.mean;max(final.mean)最鄰近算法81boostinglibrary(adabag)a=boosting(SHOCK_TYP.,data=shock-dd1,mfinal=15)aa.pred - predict.boosting(a,newdata=shock-dd1,) ;a.pred82boostingbarplot(a$importance)83boosting84train=c();test=c();import

50、ance=c();for(i in 1:5)a=boosting(SHOCK_TYP.,data=shock-ddi,mfinal=15)a.pred - predict.boosting(a,newdata=shock-ddi,) a.predt - predict.boosting(a,newdata=shockddi,)train=c(train,1-a.pred$error)test=c(test,1-a.predt$error)importance=cbind(importance,names(a$importance)sort(a$importance,decreasing=T,i

51、ndex.return=T)$ix1:5)train;mean(train)test;mean(test)importanceboosting85bagging86library(adabag)train=c();test=c();importance=c();for(i in 1:5)a=bagging(SHOCK_TYP.,data=shock-ddi,mfinal=15)a.pred - predict.bagging(a,newdata=shock-ddi,) a.predt - predict.bagging(a,newdata=shockddi,)train=c(train,1-a.pred$error)test=c(test,1-a.predt$error)importance=cbind(importance,names(a$importance)sort(a$importance,decreasing=T,index.return=T)$ix1:5)train;mean(train)test;mean(test)importancebagging87隨機(jī)森林88library(randomForest)w=randomForest(SHOCK_TYP., data=shock-dd1, importance=TRUE,proxi