【有些小马虎的地方，比如：案例3中，测试集的train_Num前面应该有个负号的，否则就也成训练集了】====2016.1.28日重新补充购物篮关联分析apriori算法====2016.1.20补充adaboost算法案例=======2015.11.18日补充logistic建模案例(感兴趣的可以深入研究下logistic这个案例，实际问题，挺有意思的) 11.19日增加k-means聚类结果绘图========

前几天写过的一些东西，关于 R数据挖掘基础操作及算法应用的一些 简单案例(实际问题要比这些案例复杂很多，数据清洗、模型选择、调参等等，每一环节都很重要且复杂)，分享出来，希望对各位知友有帮助！

暂时贴出已写完的这几个，其它的一些经典算法案例会不断更新……

1、logistic回归建模

程序代码

###Logistic回归建模

####案例:能否入选全明星？

##读取并查看数据集

library(xlsx)

nba=read.xlsx("nba2013.xlsx",sheetIndex=1,header=T)

names(nba) #列名

n=dim(nba);n #481*32

str(nba) #查看数据集内部结构

nba$allstar

nba1

#names(nba1)

##下面:为分类变量pos(球员司职)创建指示变量并构造新的数据集

m1=rep(1,n[1]) #创建481个1

m0=rep(0,n[1])

table(nba1$pos) #分类有:C(中锋)、PF(大前锋)、PG(控卫)、

#SF(小前)、SG(分卫)、F(实际不存在)

nba1$posC=ifelse(nba1$pos=="C",m1,m0) #条件成立为v1,否则为v0

nba1$posPF=ifelse(nba1$pos=="PF",m1,m0)

nba1$posPG=ifelse(nba1$pos=="PG",m1,m0)

nba1$posSF=ifelse(nba1$pos=="SF",m1,m0)

nba1$posSG=ifelse(nba1$pos=="SG",m1,m0)

#names(nba1)

nba2

#str(nba2)

##下面:用全部数据进行logistic拟合

glm_model=glm(allstar~.,family=binomial,nba2)

summary(glm_model)

##结果不是很好。下面:根据AIC指标,逐步回归进行变量筛选

step(glm_model) #结果公式:allstar~age+fg+x3p+ast+blk+pts

names(nba2)

nba3

##构造训练集&测试集

set.seed(123) #随机数种子

n1=sample(dim(nba3)[1],floor(dim(nba3)[1]*0.69));n1

trainNBA

testNBA

##使用训练集建模

ModelFit

summary(ModelFit)

trainPre

trainPre1

trainPre1[trainPre>0.5]=1 #trainPre大于0.5,则生成1

table(trainNBA$allstar,trainPre1)

paste(round(mean(trainNBA$allstar==trainPre1)*100,2),"%",sep="")

#训练集预测正确率

##测试集用来做预测

testPre

testPre1

testPre1[testPre>0.5]=1

table(testNBA$allstar,testPre1)

paste(round(mean(testNBA$allstar==testPre1)*100,2),"%",sep="")

#测试集预测正确率

运行结果(部分)

> summary(glm_model)

Call:

glm(formula = allstar ~ ., family = binomial, data = nba2)

Deviance Residuals:

Min 1Q Median 3Q Max

-1.6821 -0.1099 -0.0373 -0.0163 3.6923

Coefficients: (1 not defined because of singularities)

Estimate Std. Error z value Pr(>|z|)

(Intercept) -2.162e+01 1.683e+03 -0.013 0.98975

age 1.733e-01 9.174e-02 1.889 0.05885 .

fg -1.960e-02 1.180e-02 -1.661 0.09673 .

x3p -9.500e-03 7.581e-03 -1.253 0.21020

x2p NA NA NA NA

ast 3.411e-03 3.675e-03 0.928 0.35333

stl 2.387e-03 1.275e-02 0.187 0.85151

blk 1.767e-02 9.600e-03 1.840 0.06575 .

pts 1.237e-02 4.675e-03 2.646 0.00814 **

posC 7.810e+00 1.683e+03 0.005 0.99630

posPF 7.672e+00 1.683e+03 0.005 0.99636

posPG 7.685e+00 1.683e+03 0.005 0.99636

posSF 6.607e+00 1.683e+03 0.004 0.99687

posSG 8.183e+00 1.683e+03 0.005 0.99612

---

Signif. codes: 0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1

(Dispersion parameter for binomial family taken to be 1)

Null deviance: 196.527 on 480 degrees of freedom

Residual deviance: 79.076 on 468 degrees of freedom

AIC: 105.08

Number of Fisher Scoring iterations: 15

> ##结果不是很好。下面:根据AIC指标,逐步回归进行变量筛选

> step(glm_model) #结果公式:allstar~age+fg+x3p+ast+blk+pts

Start: AIC=105.08

allstar ~ age + fg + x3p + x2p + ast + stl + blk + pts + posC +

posPF + posPG + posSF + posSG

Step: AIC=105.08

allstar ~ age + fg + x3p + ast + stl + blk + pts + posC + posPF +

posPG + posSF + posSG

Df Deviance AIC

- posSF 1 79.076 103.08

- posPF 1 79.076 103.08

- posPG 1 79.076 103.08

- posC 1 79.076 103.08

- posSG 1 79.077 103.08

- stl 1 79.110 103.11

- ast 1 79.939 103.94

- x3p 1 80.741 104.74

79.076 105.08

- fg 1 82.141 106.14

- blk 1 82.213 106.21

- age 1 82.984 106.98

- pts 1 87.816 111.82

Step: AIC=103.08

allstar ~ age + fg + x3p + ast + stl + blk + pts + posC + posPF +

posPG + posSG

Df Deviance AIC

- stl 1 79.111 101.11

- posPG 1 79.579 101.58

- posPF 1 79.644 101.64

- posC 1 79.674 101.67

- ast 1 79.940 101.94

- posSG 1 80.675 102.67

- x3p 1 80.741 102.74

79.076 103.08

- fg 1 82.141 104.14

- blk 1 82.213 104.21

- age 1 82.984 104.98

- pts 1 87.816 109.82

Step: AIC=101.11

allstar ~ age + fg + x3p + ast + blk + pts + posC + posPF + posPG +

posSG

Df Deviance AIC

- posPG 1 79.581 99.581

- posPF 1 79.645 99.645

- posC 1 79.675 99.675

- ast 1 80.505 100.505

- posSG 1 80.698 100.698

- x3p 1 80.814 100.814

79.111 101.111

- fg 1 82.194 102.194

- blk 1 82.274 102.274

- age 1 83.088 103.088

- pts 1 87.935 107.935

Step: AIC=99.58

allstar ~ age + fg + x3p + ast + blk + pts + posC + posPF + posSG

Df Deviance AIC

- posPF 1 79.865 97.865

- posC 1 79.923 97.923

- posSG 1 80.699 98.699

- x3p 1 81.275 99.275

79.581 99.581

- blk 1 82.453 100.453

- fg 1 82.579 100.579

- age 1 83.239 101.239

- ast 1 83.534 101.534

- pts 1 88.103 106.103

Step: AIC=97.87

allstar ~ age + fg + x3p + ast + blk + pts + posC + posSG

Df Deviance AIC

- posC 1 79.960 95.960

- posSG 1 80.728 96.728

79.865 97.865

- x3p 1 82.133 98.133

- fg 1 82.707 98.707

- blk 1 83.275 99.275

- ast 1 83.600 99.600

- age 1 84.405 100.405

- pts 1 88.493 104.493

Step: AIC=95.96

allstar ~ age + fg + x3p + ast + blk + pts + posSG

Df Deviance AIC

- posSG 1 80.800 94.800

79.960 95.960

- x3p 1 82.633 96.633

- fg 1 83.013 97.013

- ast 1 83.682 97.682

- age 1 84.773 98.773

- blk 1 85.815 99.815

- pts 1 89.001 103.001

Step: AIC=94.8

allstar ~ age + fg + x3p + ast + blk + pts

Df Deviance AIC

80.800 94.800

- x3p 1 82.942 94.942

- ast 1 83.758 95.758

- fg 1 84.305 96.305

- blk 1 85.943 97.943

- age 1 86.048 98.048

- pts 1 90.692 102.692

Call: glm(formula = allstar ~ age + fg + x3p + ast + blk + pts, family = binomial,

data = nba2)

Coefficients:

(Intercept) age fg x3p ast blk

-14.052311 0.182476 -0.019873 -0.009723 0.003714 0.017605

pts

0.012472

Degrees of Freedom: 480 Total (i.e. Null); 474 Residual

Null Deviance: 196.5

Residual Deviance: 80.8 AIC: 94.8

> names(nba2)

[1] "age" "fg" "x3p" "x2p" "ast" "stl" "blk" "pts"

[9] "allstar" "posC" "posPF" "posPG" "posSF" "posSG"

> nba3

> paste(round(mean(trainNBA$allstar==trainPre1)*100,2),"%",sep="")

[1] "97.28%"

> #训练集预测正确率

> paste(round(mean(testNBA$allstar==testPre1)*100,2),"%",sep="")

[1] "95.33%"

###结果说明:训练集及测试集预测正确率如上，分别为97.22%和94.21%，测试集相对训练集预测

###正确率略低，感兴趣的童鞋可调试下训练集抽样比例(剧透：我的在抽取0.69时结果最优)，

###来找出最优结果。

写在后面：简单写这么多，算是抛砖引玉。从本案例可以看出，特征的选择对于模型很重要，感兴趣的童鞋可以尝试下其它特征变量的选择对于模型的影响；也可以试试其它算法，从得到更好的模型及结果；顺便，可以多采集些不同年份的数据，从业务层面去深入分析下。

另，对于想尝试其它方法的童鞋，可进一步交流(我的微信：lhf_Peter，加微信索要数据吧，就不公开啦)，相信这是一个比较实际而且很好玩的事情！

2、K-means聚类

程序代码

#K-means聚类

#案例:iris鸢尾花聚类

library(cluster) #加载包

library(useful) #加载该包,用于下面作图

data(iris)

iris

dim(iris) #显示数据维度

head(iris) #最后一列是鸢尾花的分类

table(iris$Species) #显示iris数据集Species列中各个值出现的频次

iris_new

irisK3

t=table(iris$Species,irisK3$cluster);t #查看聚类结果

plot(irisK3,iris,class="Species") #将聚类结果与鸢尾花初始类别绘制在一个图进行比对运行结果

> irisK3

K-means clustering with 3 clusters of sizes 50, 38, 62

Cluster means:

Sepal.Length Sepal.Width Petal.Length Petal.Width

1 5.006000 3.428000 1.462000 0.246000

2 6.850000 3.073684 5.742105 2.071053

3 5.901613 2.748387 4.393548 1.433871

Clustering vector:

[1] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1

[33] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 3 3 2 3 3 3 3 3 3 3 3 3 3 3

[65] 3 3 3 3 3 3 3 3 3 3 3 3 3 2 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3 3

[97] 3 3 3 3 2 3 2 2 2 2 3 2 2 2 2 2 2 3 3 2 2 2 2 3 2 3 2 3 2 2 3 3

[129] 2 2 2 2 2 3 2 2 2 2 3 2 2 2 3 2 2 2 3 2 2 3

Within cluster sum of squares by cluster:

[1] 15.15100 23.87947 39.82097

(between_SS / total_SS = 88.4 %)

Available components:

[1] "cluster" "centers" "totss" "withinss"

[5] "tot.withinss" "betweenss" "size" "iter"

[9] "ifault"

> t=table(iris$Species,irisK3$cluster);t

1 2 3

setosa 50 0 0

versicolor 0 2 48

virginica 0 36 14

##观察上面结果可知，聚类结果还不错作图结果：

3、决策树模型

程序代码

#决策树模型

#案例:iris鸢尾花分类

library(rpart) #加载包

data(iris)

iris

dim(iris)

n1=floor(0.8*dim(iris)[1]);n1

train_Num=sample(1:dim(iris)[1],n1)

train=iris[train_Num,] #训练集

test=iris[train_Num,] #测试集

#使用训练集建模

dtmodel=rpart(Species~.,method="class",train)

dtmodel

train_Pre=predict(dtmodel,train,type="class")

t=table(train$Species,train_Pre);t

train_accuracy=round((t[1,1]+t[2,2]+t[3,3])/sum(t),digits=2);train_accuracy

#训练接预测正确率

#测试集

test_Pre=predict(dtmodel,test,type="class")

tt=table(test$Species,test_Pre);tt

test_accuracy=round((tt[1,1]+tt[2,2]+tt[3,3])/sum(tt),digits=2);test_accuracy

#测试集预测正确率运行结果

> t=table(train$Species,train_Pre);t

train_Pre

setosa versicolor virginica

setosa 41 0 0

versicolor 0 38 1

virginica 0 4 36

> train_accuracy=round((t[1,1]+t[2,2]+t[3,3])/sum(t),digits=2);train_accuracy

[1] 0.96

> #训练接预测正确率

>

> #测试集

> test_Pre=predict(dtmodel,test,type="class")

> tt=table(test$Species,test_Pre);tt

test_Pre

setosa versicolor virginica

setosa 41 0 0

versicolor 0 38 1

virginica 0 4 36

> test_accuracy=round((tt[1,1]+tt[2,2]+tt[3,3])/sum(tt),digits=2);test_accuracy

[1] 0.96

> #测试集预测正确率

4、文本挖掘基础(按说这个该放在最后，后续补充案例之后再修改顺序)

程序代码

#文本分词&正则

#案例:《笑傲江湖》文本基础分析

setwd("E:/Rwd_All")

library(jiebaR) #加载分词包,墙裂推荐jiebaR包

engine

##下面读取txt文本

xajh

sep="\t",header=F,colClasses="character") #读取《笑傲江湖》txt文件

head(xajh) #查看表头

xajh$V1[c(1:5,5000:5005,20000:20005)] #随便查看部分内容

##下面进行文本分词

words

words1

words1

w1=words1[nchar(words1)==1];w1 #查看一个字的词(w1)有没有分析价值

sort(table(w1),decreasing=T)[1:50] #输出前50个出现频率最高w1

#注:不做深入分析,忽略掉这些单字的语气词、代词、动词、形容词等

words21 & nchar(words1)<7] #只要字符创长度介于2-6的词

wordFreq25=sort(table(words2),decreasing=T)[1:25];wordFreq25 #输出前25个高频词

library(wordcloud) #加载包,做词云图用

wordcloud(names(wordFreq25),wordFreq25,min.freq=2,random.order=F,random.color=T,colors = c(1:25))

#词云图绘制较简单,参数使用文档介绍的很详细,我就不罗嗦了！做个机智的“调包侠”lol……

##下面抓取令狐冲和盈盈的对话

冲盈

grepl("盈盈|婆婆|姑姑|圣姑|任盈盈|任小姐",xajh$V1) &

grepl("“|”",xajh$V1)]

n=sample(1:length(冲盈),20);n

sents=冲盈[n];sents #随机抽看冲盈对话的20句

##第二个就是最喜欢的风清扬前辈了,这次抽出跟风清扬相关的所有内容

风清扬

风清扬[1:20] #查看前20相关的内容

##保存自己喜欢的小说内容至txt文件

write.table(冲盈,"冲盈.txt")

write.table(风清扬,"风清扬.txt")运行结果

#仅贴出部分运行结果

> wordFreq25=sort(table(words2),decreasing=T)[1:25];wordFreq25 #输出前25个高频词

words2

令狐冲 甚么 说道 自己 岳不群 一个 师父 盈盈 剑法 弟子 林平之 岳灵珊 咱们 一声 不是 恒山 他们

4728 2053 1580 1166 1117 1041 993 974 964 934 871 866 861 824 762 752 739

长剑 田伯光 不知 出来 之中 教主 师妹 心中

729 662 646 643 580 574 570 569

> sents=冲盈[n];sents #随机抽看冲盈对话的20句

[1] "将胸膛挺了挺。盈盈道：“你死在临头，还笑甚么？”令狐冲" "令狐冲惊喜交集，情不自禁的冲口而出：“盈盈来了！”急"

[3] "令狐冲一坐定后，便问：“圣姑到底怎样啦？这可急死我" "盈盈道：“不用心急，要救两个人，总还办得到。”令狐冲知"

[5] "令狐冲道：“多谢大师好意，待晚辈护送婆婆到达平安的" "令狐冲和盈盈同时叫道：“不好！”从高粱丛中跃了出来。"

[7] "就叫我学他的样。”那婆婆道：“正是。”令狐冲笑道：“天下" "盈盈道：“冲哥，这华山之上，有一处地方和你大有干系，"

[9] "听，不许隐瞒抵赖。”盈盈道：“不上来！好没正经。”令狐冲" "令狐冲向盈盈道：“盈盈，你是不能随我去的了？”盈盈"

[11] "盈盈眼光中闪出喜悦的光芒，道：“冲哥，你这是真心话" "盈盈道：“定闲师太是为了女儿而死的。”令狐冲向她瞧"

[13] "令狐冲笑道：“从此之后，我不叫你婆婆了，那我叫你甚" "那婆婆道：“我仔细想想，要令狐冲这小子抛了你，另娶"

[15] "盈盈与令狐冲并肩缓缓回见性峰来，说道：“东方不败此" "活呢。”盈盈道：“你这话可不是骗我？”令狐冲道：“就怕我"

[17] "令狐冲惊道：“我师父断了腿骨？”盈盈微笑道：“没震死" "盈盈急道：“你不能走。”令狐冲道：“为甚么？”盈盈道："

[19] "令狐冲和盈盈都暗暗点头，心道：“左冷禅和劳德诺所以" "那婆婆叫道：“喂，喂，你怎么啦？”令狐冲脸上、手上"

>

> ##第二个就是最喜欢的风清扬前辈了,这次抽出跟风清扬相关的所有内容

> 风清扬

> 风清扬[1:20] #查看前20相关的内容

[1] "“风清扬”三个大字，是以利器所刻，笔划苍劲，深有半寸，" "寻思：“这位风清扬是谁？多半是本派的一位前辈，曾被罚在"

[3] "石壁之上。令狐冲见到壁上“风清扬”三个大字，伸出手指，" "风清扬风老前辈！”"

[5] "令狐冲登时想起石壁上所刻的那“风清扬”三个大字，忍" "风……”他想“风清扬”的名字中有个“清”字，那是比师"

[7] "父“不”字辈高了一辈的人物，接着道：“风太师叔归隐多年，" "夕之间尽数暴毙，只有风清扬一人其时不在山上，逃过了这"

[9] "过的，虽有你风太师叔不断指点，终归无用。你还是乖乖的" "巧法？田伯光提到风清扬，便真有一个风清扬出来。”"

[11] "白送在你手里？”转面向那老者道：“风老前辈，田伯光是后" "前辈风太师叔，实是万千之喜。”"

[13] "那老者风清扬道：“你起来。”令狐冲又恭恭敬敬的磕了" "去取。风清扬摇头道：“不用！”眯着眼向太阳望了望，轻声"

[15] "风清扬向缩在地下的田伯光瞧了一眼，话道：“他给你戳" "风清扬摇摇头，说道：“你是岳不群的弟子，我本不想传"

[17] "风清扬指着石壁说道：“壁上这些华山派剑法的图形，你" "只听风清扬续道：“岳不群那小子，当真是狗屁不通。你"

[19] "风清扬一怔，已明其理，淡淡的道：“他要是不肯呢？你" "不杀自己，自己又怎能一占上风，却便即杀他？风清扬道："

词云图：

男主出镜率当仁不让了……

输出文件截图示例：

之所以保存部分小说内容，完全是因为：像我这样资深级的伪笑傲迷，电视剧看了N遍，想看原小说却一直没行动的人，冲盈之间的打情骂俏及风清扬这种神级人物的所言所行是值得保存下来细细品味的。

5、关联规则apriori算法

为防止页面太长，写在专栏里面了，请见：6、机器集成学习的AdaBoost算法

待补充：

7、随机森林算法

8、SVM

9、神经网络

先贴出这几个，顺序也有些乱(上面案例4也说了，该案例纯属为了好玩，本人是骨灰级笑傲迷)，不过这是目前我写完的内容！后面的一些算法应用，待我写完之后会继续更新(可能会慢一点￣へ￣)！！！

转载请联系我微信！