class包：提供Knn()函数
kknn包：提供kknn()函数及miete数据集（房租信息）
kknn函数：实现有权重的K最近邻
knn函数：实现K最近邻算法
klaR包：提供NavieBayes()函数
lda函数：线性判别
MASS包：提供lda()和qda()函数
NavieBayes()函数：实现朴素贝叶斯算法
#####################判别分析#############################
> #读取数据
> library(kknn)
> data("miete")
> head(miete)
nm wfl bj bad0 zh ww0 badkach fenster kueche mvdauer bjkat
1 693.29 50 1971.5 0 1 0 0 0 0 2 4
2 736.60 70 1971.5 0 1 0 0 0 0 26 4
3 732.23 50 1971.5 0 1 0 0 0 0 1 4
4 1295.14 55 1893.0 0 1 0 0 0 0 0 1
5 394.97 46 1957.0 0 0 1 0 0 0 27 3
6 1285.64 94 1971.5 0 1 0 1 0 0 2 4
wflkat nmqm rooms nmkat adr wohn
1 1 13.865800 1 3 2 2
2 2 10.522857 3 3 2 2
3 1 14.644600 1 3 2 2
4 2 23.548000 3 5 2 2
5 1 8.586304 3 1 2 2
6 3 13.677021 4 5 2 2
> summary(miete)
nm wfl bj bad0 zh
Min. : 127.1 Min. : 20.00 Min. :1800 0:1051 0:202
1st Qu.: 543.6 1st Qu.: 50.25 1st Qu.:1934 1: 31 1:880
Median : 746.0 Median : 67.00 Median :1957
Mean : 830.3 Mean : 69.13 Mean :1947
3rd Qu.:1030.0 3rd Qu.: 84.00 3rd Qu.:1972
Max. :3130.0 Max. :250.00 Max. :1992
ww0 badkach fenster kueche mvdauer bjkat wflkat
0:1022 0:446 0:1024 0:980 Min. : 0.00 1:218 1:271
1: 60 1:636 1: 58 1:102 1st Qu.: 2.00 2:154 2:513
Median : 6.00 3:341 3:298
Mean :10.63 4:226
3rd Qu.:17.00 5: 79
Max. :82.00 6: 64
nmqm rooms nmkat adr wohn
Min. : 1.573 Min. :1.000 1:219 1: 25 1: 90
1st Qu.: 8.864 1st Qu.:2.000 2:230 2:1035 2:673
Median :12.041 Median :3.000 3:210 3: 22 3:319
Mean :12.647 Mean :2.635 4:208
3rd Qu.:16.135 3rd Qu.:3.000 5:215
Max. :35.245 Max. :9.000
> #对数据进行分层抽样
> library(sampling)
> n <- round(2/3*nrow(miete)/5)
> n
[1] 144
> sub_train <- strata(miete,stratanames = 'nmkat',size = rep(n,5),method = 'srswor')
> #显示nmkat取值、在数据集中的序号、别抽到的概率、所在层
> head(sub_train)
nmkat ID_unit Prob Stratum
1 3 1 0.6857143 1
3 3 3 0.6857143 1
8 3 8 0.6857143 1
20 3 20 0.6857143 1
27 3 27 0.6857143 1
28 3 28 0.6857143 1
> tail(sub_train)
nmkat ID_unit Prob Stratum
1058 2 1058 0.626087 5
1061 2 1061 0.626087 5
1062 2 1062 0.626087 5
1064 2 1064 0.626087 5
1067 2 1067 0.626087 5
1080 2 1080 0.626087 5
> #将下面代码就行修改
> #> data_train <- getdata(miete[,c(-1,-3,-12)],sub_train$ID_unit)
> #> data_test <- getdata(miete[,c(-1,-3,-12)],-sub_train$ID_unit)
> #构建训练集和测试集
> # 总的id
> d1<-as.factor(row.names(miete))
> # 训练集的id
> d2<-as.factor(sub_train$ID_unit)
> # 测试集的id
> d3<-as.factor(setdiff(d1,d2))
> # 训练集操作
> t1<-miete[d2,]
> data_train<-t1[,c(-1,-3,-12)]
> # 测试集操作
> t2<-miete[d3,]
> data_test<-t2[,c(-1,-3,-12)]
> dim(data_train);dim(data_test)
[1] 720 14
[1] 362 14
> head(data_test)
wfl bad0 zh ww0 badkach fenster kueche mvdauer bjkat nmqm rooms
70 42 0 1 0 0 0 0 6 4 18.270238 2
49 84 0 1 0 1 0 0 12 4 13.004643 4
53 95 0 1 0 0 0 0 40 2 7.581579 4
79 77 0 1 0 1 0 0 3 4 5.006623 3
88 77 0 1 0 0 0 0 1 5 9.405714 3
100 56 0 1 1 0 0 0 35 3 6.822143 2
nmkat adr wohn
70 3 2 3
49 4 2 2
53 3 2 3
79 1 2 2
88 3 2 2
100 1 2 2
> ############################1.线性判别##########################
> library(MASS)
> fit_lda1 <- lda(nmkat ~.,data_train)
> names(fit_lda1)
[1] "prior" "counts" "means" "scaling" "lev" "svd"
[7] "N" "call" "terms" "xlevels"
> #各类别的先验概率
> fit_lda1$prior
1 2 3 4 5
0.2166667 0.2069444 0.1944444 0.1916667 0.1902778
> #各类别的样本量
> fit_lda1$counts
1 2 3 4 5
156 149 140 138 137
> #各变量的均值
> fit_lda1$means
wfl bad01 zh1 ww01 badkach1 fenster1
1 55.64744 0.076923077 0.5769231 0.16025641 0.4038462 0.04487179
2 60.64430 0.020134228 0.8322148 0.05369128 0.5503356 0.05369128
3 66.70000 0.021428571 0.8214286 0.05000000 0.4857143 0.05714286
4 73.74638 0.007246377 0.8913043 0.05072464 0.6956522 0.03623188
5 91.87591 0.007299270 0.9489051 0.00729927 0.7664234 0.03649635
kueche1 mvdauer bjkat.L bjkat.Q bjkat.C bjkat^4
1 0.03846154 15.666667 -0.23598103 -0.11330544 0.053512738 0.15748520
2 0.06711409 11.234899 -0.09545786 -0.18380097 -0.029514096 0.19912893
3 0.05714286 12.350000 -0.11610792 -0.16054602 0.028749445 0.16738427
4 0.11594203 9.507246 -0.05369868 -0.13520021 -0.030786443 0.12187985
5 0.25547445 5.065693 -0.02879018 -0.01831756 0.003808388 0.07862765
bjkat^5 nmqm rooms adr.L adr.Q wohn.L
1 -0.113066295 8.384154 2.141026 -0.009065472 -0.7850929 0.10425292
2 -0.038472894 10.892131 2.422819 -0.014237049 -0.7918373 0.10915071
3 -0.032396955 12.326318 2.592857 -0.025253814 -0.7727557 0.09091373
4 0.001369436 14.434710 2.797101 0.015371887 -0.7898717 0.19983453
5 -0.039083918 17.154980 3.321168 0.015484090 -0.7717979 0.29419771
wohn.Q
1 -0.4003974
2 -0.3972886
3 -0.4315768
4 -0.3816234
5 -0.2532927
> fit_lda1
Call:
lda(nmkat ~ ., data = data_train)
Prior probabilities of groups:
1 2 3 4 5
0.2166667 0.2069444 0.1944444 0.1916667 0.1902778
Group means:
wfl bad01 zh1 ww01 badkach1 fenster1
1 55.64744 0.076923077 0.5769231 0.16025641 0.4038462 0.04487179
2 60.64430 0.020134228 0.8322148 0.05369128 0.5503356 0.05369128
3 66.70000 0.021428571 0.8214286 0.05000000 0.4857143 0.05714286
4 73.74638 0.007246377 0.8913043 0.05072464 0.6956522 0.03623188
5 91.87591 0.007299270 0.9489051 0.00729927 0.7664234 0.03649635
kueche1 mvdauer bjkat.L bjkat.Q bjkat.C bjkat^4
1 0.03846154 15.666667 -0.23598103 -0.11330544 0.053512738 0.15748520
2 0.06711409 11.234899 -0.09545786 -0.18380097 -0.029514096 0.19912893
3 0.05714286 12.350000 -0.11610792 -0.16054602 0.028749445 0.16738427
4 0.11594203 9.507246 -0.05369868 -0.13520021 -0.030786443 0.12187985
5 0.25547445 5.065693 -0.02879018 -0.01831756 0.003808388 0.07862765
bjkat^5 nmqm rooms adr.L adr.Q wohn.L
1 -0.113066295 8.384154 2.141026 -0.009065472 -0.7850929 0.10425292
2 -0.038472894 10.892131 2.422819 -0.014237049 -0.7918373 0.10915071
3 -0.032396955 12.326318 2.592857 -0.025253814 -0.7727557 0.09091373
4 0.001369436 14.434710 2.797101 0.015371887 -0.7898717 0.19983453
5 -0.039083918 17.154980 3.321168 0.015484090 -0.7717979 0.29419771
wohn.Q
1 -0.4003974
2 -0.3972886
3 -0.4315768
4 -0.3816234
5 -0.2532927
Coefficients of linear discriminants:
LD1 LD2 LD3 LD4
wfl 0.060132965 0.026719778 0.01623211 -0.0001588888
bad01 0.183794417 1.618516774 0.19641105 -0.4194358217
zh1 0.144370594 -1.418506813 -0.33062418 -0.4431515370
ww01 -0.312648201 0.378690539 -0.82384090 1.6315813647
badkach1 0.225632434 0.279944241 -1.17357888 0.5486835576
fenster1 0.063422366 -0.430194179 0.53253424 -0.7735389574
kueche1 0.206967799 0.962199352 -0.60661745 -1.3404546843
mvdauer -0.003722578 -0.005581735 0.02749353 0.0443173127
bjkat.L 0.093612418 -0.238045891 -0.34433616 -0.4090478086
bjkat.Q -0.126820269 0.351221286 0.01807868 -0.8727242056
bjkat.C -0.130034438 0.783834929 1.42782762 -0.1273525761
bjkat^4 -0.324588339 -0.230475173 0.17279663 -0.7049687536
bjkat^5 -0.242146129 -0.303624065 0.49681661 0.3164478032
nmqm 0.386251893 -0.011760297 0.08939692 0.1186454076
rooms 0.195274078 -0.601439513 -0.14982530 -0.1564289343
adr.L -1.629909354 0.670104728 -3.79537471 2.5545277034
adr.Q -0.645420248 0.169387746 0.57020529 0.4311319766
wohn.L 0.328225174 0.403076098 -0.43450727 0.2871776246
wohn.Q -0.117194352 0.076668423 -0.28131663 -0.5787510142
Proportion of trace:
LD1 LD2 LD3 LD4
0.9750 0.0145 0.0065 0.0040
> #另一种实现方法
> fit_lda2 <- lda(data_train[,-12],data_train[,12])
> fit_lda2
Call:
lda(data_train[, -12], data_train[, 12])
Prior probabilities of groups:
1 2 3 4 5
0.2166667 0.2069444 0.1944444 0.1916667 0.1902778
Group means:
wfl bad0 zh ww0 badkach fenster kueche
1 55.64744 1.076923 1.576923 1.160256 1.403846 1.044872 1.038462
2 60.64430 1.020134 1.832215 1.053691 1.550336 1.053691 1.067114
3 66.70000 1.021429 1.821429 1.050000 1.485714 1.057143 1.057143
4 73.74638 1.007246 1.891304 1.050725 1.695652 1.036232 1.115942
5 91.87591 1.007299 1.948905 1.007299 1.766423 1.036496 1.255474
mvdauer bjkat nmqm rooms adr wohn
1 15.666667 2.512821 8.384154 2.141026 1.987179 2.147436
2 11.234899 3.100671 10.892131 2.422819 1.979866 2.154362
3 12.350000 3.014286 12.326318 2.592857 1.964286 2.128571
4 9.507246 3.275362 14.434710 2.797101 2.021739 2.282609
5 5.065693 3.379562 17.154980 3.321168 2.021898 2.416058
Coefficients of linear discriminants:
LD1 LD2 LD3 LD4
wfl 0.058274265 0.026581902 -0.02064524 -0.0001174871
bad0 0.137868576 1.650656213 -0.59096909 0.6018053170
zh 0.136047136 -1.526527081 0.48965931 0.3074164084
ww0 -0.305368459 0.495068681 1.15483610 -1.4958478494
badkach 0.219923203 0.414029221 1.33933838 -0.3203832167
fenster 0.050643136 -0.709690537 -0.48756790 0.7037612341
kueche 0.111668906 1.097164642 0.06409716 1.7493134726
mvdauer -0.004541142 -0.006717243 -0.02226311 -0.0533731169
bjkat 0.017078305 -0.116117354 0.09796824 0.0122905946
nmqm 0.379507938 -0.013211688 -0.06893267 -0.1360574504
rooms 0.209607325 -0.610650914 0.21136687 0.1380030913
adr -0.940986465 0.721633927 2.96937918 -1.8682410267
wohn 0.201982053 0.443293384 0.40608410 0.2930551074
Proportion of trace:
LD1 LD2 LD3 LD4
0.9787 0.0131 0.0050 0.0032
> #可视化
> plot(fit_lda1)
> #可以看出1,5比较分散，234混在一起
> plot(fit_lda1,dimen=1)
Error in plot.new() : figure margins too large
> #可以看出1,5比较分散，234混在一起
> plot(fit_lda1,dimen=2)
Warning message:
In doTryCatch(return(expr), name, parentenv, handler) :
display list redraw incomplete
> #进行预测
> pre_lda1 <- predict(fit_lda1,data_test)
> table(pre_lda1$class)
1 2 3 4 5
82 80 59 81 60
> #计算混淆矩阵，正确率为68+45+39+55+53）/362=71.82%
> table(data_test$nmkat,pre_lda1$class)
1 2 3 4 5
1 68 14 1 1 0
2 12 45 8 3 0
3 2 21 39 9 1
4 0 0 11 55 6
5 0 0 0 13 53
> #计算错误率：0.281768
> errol_lda1 <- sum(as.numeric(as.numeric(pre_lda1$class)!=as.numeric(data_test$nmkat)))/nrow(data_test)
> errol_lda1
[1] 0.281768
> #######################2.朴素贝叶斯########################
> #1.公式formula格式
> library(klaR)
> fit_Bayes1 <- NaiveBayes(nmkat ~.,data_train)
> names(fit_Bayes1)
[1] "apriori" "tables" "levels" "call" "x" "usekernel"
[7] "varnames"
> fit_Bayes1$apriori
grouping
1 2 3 4 5
0.2166667 0.2069444 0.1944444 0.1916667 0.1902778
> #通过分析bad0,0表示有浴室，房租差距不大
> #wohn和adr，1表示环境不好，3表示环境好，3随租金呈上升趋势
> fit_Bayes1$tables
$wfl
[,1] [,2]
1 55.64744 24.33842
2 60.64430 20.58472
3 66.70000 20.29449
4 73.74638 23.18226
5 91.87591 31.57751
$bad0
var
grouping 0 1
1 0.923076923 0.076923077
2 0.979865772 0.020134228
3 0.978571429 0.021428571
4 0.992753623 0.007246377
5 0.992700730 0.007299270
......
$rooms
[,1] [,2]
1 2.141026 0.9601661
2 2.422819 1.0791714
3 2.592857 0.8724103
4 2.797101 0.9677985
5 3.321168 1.1176019
$adr
var
grouping 1 2 3
1 0.019230769 0.974358974 0.006410256
2 0.020134228 0.979865772 0.000000000
3 0.035714286 0.964285714 0.000000000
4 0.000000000 0.978260870 0.021739130
5 0.007299270 0.963503650 0.029197080
$wohn
var
grouping 1 2 3
1 0.09615385 0.66025641 0.24358974
2 0.09395973 0.65771812 0.24832215
3 0.09285714 0.68571429 0.22142857
4 0.03623188 0.64492754 0.31884058
5 0.02189781 0.54014599 0.43795620
> fit_Bayes1$levels
[1] "1" "2" "3" "4" "5"
> fit_Bayes1$call
NaiveBayes.default(x = X, grouping = Y)
> fit_Bayes1$varnames
[1] "wfl" "bad0" "zh" "ww0" "badkach" "fenster" "kueche"
[8] "mvdauer" "bjkat" "nmqm" "rooms" "adr" "wohn"
> #2.各类别密度下可视化
> plot(fit_Bayes1,vars = 'wf1',n=50,col=c(1,'darkgrey',1,'darkgrey',1))
> plot(fit_Bayes1,vars = 'mvdauer',n=50,col=c(1,'darkgrey',1,'darkgrey',1))
Hit <Return> to see next plot:
> plot(fit_Bayes1,vars = 'nmqm',n=50,col=c(1,'darkgrey',1,'darkgrey',1))
Hit <Return> to see next plot:
> #3.默认格式
> fit_Bayes2 <-NaiveBayes(data_train[,-12],data_train[,12])
> #4.对测试集预测
> pre_Bayes1 <- predict(fit_Bayes1,data_test)
There were 50 or more warnings (use warnings() to see the first 50)
> pre_Bayes1
$class
70 49 53 79 88 100 104 107 112 121 144 151 166 185 205 211 214 221 226
4 4 1 2 2 1 1 2 5 1 3 5 4 3 4 1 5 5 1
.....
10 11 12 13 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29
5 5 5 2 4 4 3 5 5 3 5 2 1 1 2 4 2 3 1
30
1
Levels: 1 2 3 4 5
$posterior
1 2 3 4 5
70 2.416666e-02 2.273255e-01 2.551058e-01 3.240992e-01 1.693029e-01
....
204 5.656179e-02 4.580094e-01 2.514542e-01 1.954695e-01 3.850509e-02
206 7.575586e-05 2.298567e-03 5.326445e-03 1.455069e-01 8.467923e-01
207 8.560613e-03 1.816113e-01 1.722996e-01 5.692817e-01 6.824674e-02
208 8.306373e-03 1.316462e-01 1.547190e-01 3.276939e-01 3.776345e-01
[ reached getOption("max.print") -- omitted 162 rows ]
> #计算混淆矩阵
> table(data_test$nmkat,pre_Bayes1$class)
1 2 3 4 5
1 54 26 0 0 4
2 11 37 9 5 6
3 11 20 23 12 6
4 5 1 11 35 20
5 0 0 3 10 53
> #计算错误率 [1] 0.441989
> errol_Bayes1 <- sum(as.numeric(as.numeric(pre_Bayes1$class)!=as.numeric(data_test$nmkat)))/nrow(data_test)
> errol_Bayes1
[1] 0.441989
> ###########################3.K最近邻####################
> library(class)
> fit_pre_knn <- knn(data_train[,-12],data_test[,-12],cl=data_train[,12])
> fit_pre_knn
[1] 3 4 3 1 3 1 1 2 2 1 3 5 4 4 4 2 5 3 1 3 2 3 1 1 4 2 1 1 3 1 2 3 2 3 3
[36] 1 5 1 4 1 4 4 4 5 4 5 3 2 2 3 1 1 1 3 2 1 4 3 2 3 5 3 2 5 1 3 1 1 1 1
[71] 5 4 2 3 2 5 4 3 4 2 2 1 3 2 3 2 5 2 3 4 4 2 3 2 2 1 1 4 5 3 1 4 3 5 2
[106] 5 1 1 4 2 3 2 1 1 3 4 5 4 5 3 5 1 4 3 2 3 1 1 5 1 4 5 1 2 3 4 4 5 5 1
[141] 2 5 5 5 1 4 2 3 3 5 2 5 3 4 4 1 1 5 5 4 5 3 1 2 5 4 3 2 3 2 1 1 2 2 2
[176] 4 4 2 3 1 2 2 1 1 5 3 4 5 1 2 4 1 5 4 5 2 2 4 4 5 4 4 1 1 2 2 1 2 2 4
[211] 2 1 4 4 1 4 5 2 4 4 3 4 5 4 2 1 4 4 4 5 2 1 4 4 1 1 3 1 5 3 3 3 5 3 2
[246] 4 3 3 2 4 4 1 5 3 3 3 1 1 1 1 2 4 2 1 2 2 5 5 1 1 3 4 4 5 3 3 2 5 5 1
[281] 3 1 1 1 1 4 5 4 1 3 3 3 5 5 4 4 5 5 4 4 1 5 2 5 5 3 2 3 5 5 5 4 4 5 5
[316] 3 4 1 1 3 2 1 3 5 2 2 2 2 1 4 4 1 1 1 3 3 3 5 1 5 3 4 2 5 5 2 4 3 2 5
[351] 5 3 4 3 1 1 1 5 3 3 2 1
Levels: 1 2 3 4 5
> table(data_test$nmkat,fit_pre_knn)
fit_pre_knn
1 2 3 4 5
1 84 0 0 0 0
2 0 68 0 0 0
3 0 0 72 0 0
4 0 0 0 72 0
5 0 0 0 0 66
> errol_knn <- sum(as.numeric(as.numeric(fit_pre_knn)!=as.numeric(data_test$nmkat)))/nrow(data_test)
> errol_knn
[1] 0
> error_knn = rep(0,20)
> for (i in 1:20) {
+ fit_pre_knn = knn(data_train[,-12],data_test[,-12],cl=data_train[,12],k=i)
+ errol_knn[i] =sum(as.numeric(as.numeric(fit_pre_knn)!=as.numeric(data_test$nmkat)))/nrow(data_test)
+ }
> errol_knn
[1] 0.0000000 0.1629834 0.1353591 0.1850829 0.1546961 0.1823204 0.1767956
[8] 0.1906077 0.2209945 0.2320442 0.2458564 0.2679558 0.2596685 0.2651934
[15] 0.2734807 0.2734807 0.3038674 0.2928177 0.3232044 0.3259669
> plot(errol_knn,type = 'l',xlab = 'K')
> ######有权重的K####
> library('kknn')
> fit_pre_kknn <- kknn(nmkat~.,data_train,data_test[,-12],k=5)
> #fit为判定结果
> summary(fit_pre_kknn)
Call:
kknn(formula = nmkat ~ ., train = data_train, test = data_test[, -12], k = 5)
Response: "ordinal"
fit prob.1 prob.2 prob.3 prob.4 prob.5
1 3 0.00000000 0.25672296 0.76636967 1.00000000 1
2 4 0.00000000 0.00000000 0.02451458 1.00000000 1
3 3 0.00000000 0.08072417 0.74327704 0.74327704 1
4 1 0.56585629 0.97548542 1.00000000 1.00000000 1
.....
163 2 0.48513212 1.00000000 1.00000000 1.00000000 1
164 2 0.00000000 0.97548542 0.97548542 1.00000000 1
165 4 0.00000000 0.00000000 0.40962913 0.51486788 1
166 4 0.00000000 0.08072417 0.33744713 0.82257926 1
[ reached 'max' / getOption("max.print") -- omitted 196 rows ]
> fit <- fitted(fit_pre_kknn)
> fit
[1] 3 4 3 1 3 1 1 2 2 1 3 4 4 3 4 2 5 3 3 3 3 3 1 1 4 2 1 1 3 2 2 3 2 3 3
[36] 1 5 1 4 3 4 4 4 5 4 5 3 2 2 3 1 2 1 3 1 1 4 3 2 3 5 3 2 5 2 3 1 1 1 1
[71] 5 3 2 3 2 5 4 3 4 2 2 2 3 2 3 2 5 2 3 4 4 2 3 2 2 1 1 4 5 3 1 3 2 5 2
[106] 5 1 1 4 2 3 2 3 1 2 4 5 4 5 3 5 2 4 3 2 3 1 1 5 1 4 5 2 2 2 4 4 5 5 1
[141] 2 5 5 5 1 4 2 4 3 5 1 5 3 3 4 1 2 5 5 4 5 3 2 2 4 4 3 2 3 2 1 1 2 2 2
[176] 4 4 2 3 1 2 3 1 1 5 4 4 5 1 4 4 1 5 4 5 2 2 4 4 5 4 4 1 1 2 2 1 2 2 4
[211] 2 1 3 4 1 4 5 2 3 4 3 4 5 4 2 1 4 4 4 4 2 1 4 4 1 1 3 1 5 3 3 3 5 3 2
[246] 4 3 3 1 4 4 1 4 3 3 3 1 1 1 1 3 4 2 1 1 2 5 5 1 1 2 4 4 5 3 3 2 5 5 1
[281] 3 1 1 1 1 4 5 4 1 2 3 1 5 5 4 4 5 5 4 4 1 4 2 5 5 3 2 3 5 3 5 4 4 5 5
[316] 3 3 1 1 3 2 1 4 5 2 2 2 2 1 4 2 1 2 1 3 3 3 5 1 5 3 4 2 5 5 2 4 3 2 5
[351] 5 3 4 3 1 1 1 5 3 3 2 1
Levels: 1 < 2 < 3 < 4 < 5
> table(data_test$nmkat,fit)
fit
1 2 3 4 5
1 72 9 3 0 0
2 4 60 3 1 0
3 1 5 63 3 0
4 0 1 7 64 0
5 0 0 1 5 60
> errol_kknn <- sum(as.numeric(as.numeric(fit)!=as.numeric(data_test$nmkat)))/nrow(data_test)
> errol_kknn
[1] 0.1187845
> ###############推荐系统综合实例#####################
数据集地址：https://grouplens.org/datasets/movielens/100k/ 选择ml-100K.zip
> data <- read.csv("G:\\R语言\\大三下半年\\数据挖掘：R语言实战\\数据挖掘：R语言实战（案例数据集）\\ml-100k\\movie.csv",header=F)
> data <- data[,-4]
> names(data) <- c('userid','itemid','rating')
> head(data);dim(data)
userid itemid rating
1 196 242 3
2 186 302 3
3 22 377 1
4 244 51 2
5 166 346 1
6 298 474 4
[1] 100000 3
> ##编写函数
> MovieLnes_KNN=function(Userid,Itemid,n,K)#编写一个总函数可以反复使用
+ {
+ sub=which(data$userid==Userid)#获取待测用户在数据集中各条信息所在的行标签，存于sub
+ if(length(sub)>=n)
+ sun_n=sample(sub,n)
+ if(length(sub)<n)
+ sun_n=sample(sub,length(sub))#随机抽取n个已评分的电影ID
+ known_itemid=data$itemid[sun_n]#获取已评分电影的ID
+ unknown_itemid=Itemid#获取带预测电影的ID
+ known_itemid
+ unknown_itemid
+ unknown_sub=which(data$itemid==unknown_itemid)
+ user=data$userid[unknown_sub[-1]]#获取已评价电影的用户ID
+ user
+ data_all=matrix(0,1+length(user),2+length(known_itemid))#设置data.all的行数、列数，所有值暂取0
+ data_all=data.frame(data_all)
+ names(data_all)=c("userid",paste("unknown_itemid_",Itemid),paste("itemid_",known_itemid,sep=""))
+ item=c(unknown_itemid,known_itemid)
+ data_all$userid=c(Userid,user)#对变量赋值
+ data_all
+ for(i in 1:nrow(data_all))#对data_all按行进行外层循环
+ {
+ data_temp=data[which(data$userid==data_all$userid[i]),]
+ for(j in 1:length(item))#对data—all按列进行内层循环
+ {if(sum(as.numeric(data_temp$itemid==item[j]))!=0)#判断该位置是否有取值
+ {data_all[i,j+1]=data_temp$rating[which(data_temp$itemid==item[j])]
+ }
+ }
+ }
+ data_all
+ data_test_x=data_all[1,c(-1,-2)]#获取测试集的已知部分
+ data_test_y=data_all[1,2]#获取测试集的待预测值
+ data_train_x=data_all[-1,c(-1,-2)]#获取训练集的已知部分
+ data_train_y=data_all[-1,2]#获取训练集的待预测值
+ dim(data_test_x);length(data_test_y)
+ dim(data_train_x);length(data_train_y)
+ fit=knn(data_train_x,data_test_x,cl=data_train_y,k=K)#进行knn判别
+ list("data_all:"=data_all,"True Rating:"=data_test_y,"Predcit Rating:"=fit,"User ID:"=Userid,"Item ID:"=Itemid)
+ }
#用户1对20部电影的评分
> user1=NULL
> for(Item in 1:20)
+ user1=c(user1,MovieLnes_KNN(Userid=1,Itemid=Item,n=50,K=10)$'True Rating:')
Warning message:
In knn(data_train_x, data_test_x, cl = data_train_y, k = K) :
k = 10 exceeds number 9 of patterns
> user1
[1] 5 3 4 3 3 5 4 1 5 3 2 5 5 5 5 5 3 4 5 4
#显示评分为5的电影
> which(user1==5)
[1] 1 6 9 12 13 14 15 16 19
