第七周-第八周-第九周
(1)示例2
am<-as.numeric(matrix(c(-1,-1),1))
bm<-as.numeric(matrix(c(2,1),1))
sp<-matrix(c(7.3,-1.1,-1.1,4.8),2,2)
(a=(am-bm)%*%solve(sp))
(y1=a%%am);(y2=a%%bm) #y1>y2
(y1=a%%am);(y2=a%%bm) #y1>y2
(y0=(y1+y2)/2)
(y0=as.vector(y0))
(x0=c(0,1))
(y=a%*%x0)
(y=as.vector(y))
y1>y2時(shí)欢际，若y>y0,"判為第1類"
ifelse(y>y0,"判為第1類",
ifelse(y<y0,"判為第2類","無法判定"))
(2)
rm(list = ls())
a<-read.table("clipboard",header=T)#將數(shù)據(jù)mvexec4.xls中E6.3的數(shù)據(jù)處理并復(fù)制在剪貼板
attach(a)
線性判別分析
plot(x1,x2,pch=G,col=G)
text(x1,x2,G,adj=-0.5)
library(MASS)
(ld=lda(G~x1+x2))
z=predict(ld)
anewG=zclass
t<-table(G,a$newG)
sum(diag(prop.table(t)))#符合率0.8064516
距離分析
qd=qda(G~x1+x2)
z=predict(qd)
anewG=zclass
t<-table(G,a$newG)
sum(diag(prop.table(t)))#符合率.8387097
detach(a)
繪制線性判別函數(shù)圖
(Y1=ldscaling[1]*ldmeans[1,1]+
ldscaling[2]*ldmeans[1,2])
第一類的兩個(gè)指標(biāo)的均值的“降維”(一維)
-11.87429
(Y2=ldscaling[1]*ldmeans[2,1]+
ldscaling[2]*ldmeans[2,2])
第二類的兩個(gè)指標(biāo)的均值的“降維”(一維)
-9.720089
Y1<Y2
(Y0=(Y1+Y2)/2)
abline(a=Y0/ldscaling[2], b=-ldscaling[1]/ld$scaling[2])
(3)
rm(list=ls())
b<-read.table("clipboard",header=T)#將數(shù)據(jù)mvexec4.xls中E6.4的數(shù)據(jù)忽略第一列并復(fù)制在剪貼板
attach(b)
線性判別分析
(ld=lda(G~x1+x2+x3+x4))
z=predict(ld)
bnewG=zclass
t<-table(G,b$newG)
sum(diag(prop.table(t)))#符合率 0.875
距離分析
(qd=qda(G~x1+x2+x3+x4))
z=predict(qd)
bnewG=zclass
t<-table(G,b$newG)
sum(diag(prop.table(t)))#符合率1
detach(b)
預(yù)測(cè)
p1<-predict(ld,data.frame(x1=78.3563,x2=0.8895,x3=1.8001,x4=14.1022))
p1$class
線性判別法判定其種類為ST公司，即在2009年該公司有可能會(huì)陷入財(cái)務(wù)困境
p2<-predict(qd,data.frame(x1=78.3563,x2=0.8895,x3=1.8001,x4=14.1022))
p2$class
距離判別法判定其種類為ST公司夹纫，即在2009年該公司有可能會(huì)陷入財(cái)務(wù)困境
第3題
方法一：使用MASS包的lda函數(shù)設(shè)置先驗(yàn)概率
rm(list=ls()) #清空內(nèi)存
a<-read.table("clipboard",header=T)#將數(shù)據(jù)mvexec4.xls中E6.3的數(shù)據(jù)處理并復(fù)制在剪貼板
library(MASS)
先驗(yàn)概率相等的模型
(B1=lda(G~x1+x2,prior=c(1,1)/2))
attach(a)
P1=predict(B1)#判類
P1post#后驗(yàn)概率 round(P1post,3)#后驗(yàn)概率,顯示小數(shù)點(diǎn)后3位
cbind(G,newG=P1class,后驗(yàn)概率=round(P1post,3))
矩陣的三列：真實(shí)類减俏，判別類,后驗(yàn)概率
(t1=table(G,newG=P1$class))#混淆矩陣
(pr1=sum(diag(t1))/sum(t1))#判對(duì)率
先驗(yàn)概率“各總體樣本數(shù)占樣本總數(shù)的比例”的判別模型
(B2=lda(G~x1+x2,prior=c(15,16)/31))
P2=predict(B2)#判類
cbind(G,newG=P2class,后驗(yàn)概率=round(P2post,3))
矩陣的三列：真實(shí)類，判別類,后驗(yàn)概率
(t2=table(G,newG=P2$class))#混淆矩陣
(pr2=sum(diag(prop.table(t2))))#判對(duì)率0.8064516
detach(a)
方法二：使用WMDB包的dbayes函數(shù)設(shè)置先驗(yàn)概率
install.packages("WMDB")
library(WMDB)
dbayes(a[1:2],as.factor(G),p=rep(1/2,2))
先驗(yàn)概率相等(也是參數(shù)p的缺省值)的判別模型
dbayes(a[1:2],as.factor(G),p=c(15,16)/31)
先驗(yàn)概率不等的判別模型
第4題
方法一
rm(list=ls()) #清空內(nèi)存
b<-read.table("clipboard",header=T)#將數(shù)據(jù)mvexec4.xls中E6.4的數(shù)據(jù)忽略第一列并復(fù)制在剪貼板
attach(b)
search()
(b1=lda(G~x1+x2+x3+x4,prior=c(7,8)/15))
方法二
dbayes(b[1:4],as.factor(G),p=rep(1/4,4))
鳶尾花習(xí)題
(d=iris)
attach(d)
線性判別
install.packages("MASS")
library(MASS)
ld1=lda(Species~.,data=d)
ld1lev attributes(ld1) pld=predict(ld1) #“預(yù)測(cè)”串塑，即判別 data.frame(G=Species,newG=pldclass) #真實(shí)分類對(duì)比判別分類
(ta1=table(G=Species,newG=pld$class)) #混淆矩陣
addmargins(ta1) #添加行和沼琉、列和，總和
sum(diag(prop.table(ta1)))
判對(duì)率 0.98
二次判別
(qd=qda(Species~.,data=d))
Zqd=predict(qd) #“預(yù)測(cè)”桩匪，即判別
(ta3=table(G=Species,newG=Zqd$class)) #混淆矩陣
sum(diag(ta3/sum(ta3)))
判對(duì)率 0.98
先驗(yàn)概率相等的Bayes判別
(B=lda(Species~.,data=d,prior=c(1,1,1)/3))
ZB=predict(B) #“預(yù)測(cè)”打瘪，即判別
(ta2=table(G=Species,newG=Zld$class)) #混淆矩陣
sum(diag(ta2/sum(ta2)))
判對(duì)率 0.98
install.packages("WMDB")
library(WMDB)
dbayes函數(shù)判別
d[,6]=rep(1:3,each=50)
dbayes(d[,1:4],as.factor(d[,6]))
判對(duì)率 0.9666667
馬氏距離判別
wmd(d[,1:4],as.factor(d[,6]))
