R語言主成分分析
自己整理編寫的R語言常用資料分析模型的模板，原檔案為Rmd格式，直接複製貼上過來，作為個人學習筆記儲存和分享。部分參考薛毅的《統計建模與R軟體》和《R語言實戰》
解決自變數之間的多重共線性和減少變數個數
根據主成分分析的原理，它一方面可以將k個不獨立的指標變數通過線性變換變成k個相互獨立的新變數，這是解決多重共線性問題的一個重要方法；另一方面。主成分分析可以用較少的變數取代較多的不獨立的原變數，減少分析中變數的個數。概括地說，主成分分析有以下幾方面的應用。
I.相關R函式以及例項
主成分分析相關的R函式：
prinpomp() 作主成分分析最重要的函式
summary()
loadings() 顯示主成分分析或因子分析中的loadings(載荷)，在這裡是主成分對應的各列
predict() 預測主成分的值
screeplot() 畫出主成分的碎石圖
biplot() 畫出資料關於主成分的散點圖和原座標在主成分下的方向
例1. 肝病患者功能指標的主成分分析：
某醫學院測得20例肝病患者的4項肝功能指標：SGPT（轉氨酶）、肝大指數、ZnT（硫酸鋅濁度）和AFP（胎甲球蛋白），分別用X1-X4表示，研究資料見以下程式，試進行主成分分析
#從sas匯出資料存為csv格式，輸入資料
princomp1 <- read.csv("princomp1.csv" summary()列出結果的重要資訊,Standard deviation行表示的是主成分的標準差，也就是特徵值λ1，λ2，λ3，λ4的開方
Proportion of Variance行表示的是方差的貢獻率
Cumulative Proportion行表示的是方差的累計貢獻率
前兩個特徵值均大於1，第3個接近於1，第4個遠小於1。特徵值越大，它所對應的主成分變數包含的資訊就越多，第1-4個主成分的貢獻率分別為42.95%、27.33%、24.53%、5.17%，前3個主成分就包含了原來4個指標的94.82的資訊，即能夠解釋94.82%的方差。因此，確定主成分的個數為3比較合理
loadings=TRUE，則結果列出了loadings（載荷）的內容，它實際上是主成分對於原始變數X1，X2，X3，X4的係數。也是特徵值對應的特徵向量，它們是線性無關的單位向量。第1列表示第1主成分z1的得分系數，依次類推。據此可以寫出由標準化變數所表達的各主成分的關係式，即：
Z1 = 0.700X1 +0.690X2 +0.163X4
Z2、Z3、Z4同上
由碎石圖可以看出 第二個主成分之後 圖線變化趨於平穩 因此可以選擇前兩個主成分做分析
在各主成分的表示式中，各標準化指標Xi前面的係數與該主成分所對應的特徵值之平方根的乘積是該主成分與該指標之間的相關係數。係數的絕對值越大，說明該主成分受該指標的影響也越大。因此，決定第1主成分Z1大小的主要為X1和X2，即SGPT和肝大指數；決定第2主成分Z2大小的主要為X3，即ZnT；決定第3主成分Z3大小的主要為X4，即AFP；決定第4主成分大小的主要為X1和X2，但作用相反。這提示：Z1指向急性炎症；Z2指向慢性炎症；Z3指向原發性肝癌可疑；Z4貢獻率很小，僅作參考，它可能指向其他肝病。
II.主成分分析的應用
除了減少自變數的個數外，主成分分析可以用來解決自變數共線性的問題。線性迴歸分析要求自變數是相互獨立的，但是在實際應用中，經常會遇到自變數相關的問題。這時，一個好的可行的方法就是藉助於主成分分析，用主成分迴歸來求迴歸係數。即先用主成分分析法計算出主成分表示式和主成分得分變數，而主成分得分變數相互獨立，因此可以將因變數對主成分得分變量回歸，然後將主成分的表示式代回回歸模型中，即可得到標準化自變數與因變數的迴歸模型，最後將標準化自變數轉為原始自變數。
例2. 影響女大學生肺活量因素的多元迴歸分析
某學校20名一年級大學生體重（公斤）、胸圍（釐米）、肩寬（釐米）及肺活量（升）實測值如下表所示，試對影響女大學生肺活量的有關因素作多元迴歸分析
1） 模型共線性診斷
princomp2 <- read.csv("princomp2.csv",header=T)
#作線性迴歸
lm.sol<-lm(y~x1+x2+x3, data=princomp2)
summary(lm.sol)由summary結果，按三個變數得到迴歸方程： Y=-4.71 + 0.06X1 +0.036X2 +0.049X3
從引數估計值t檢驗的結果可以看出：變數x1和x2的引數估計值顯著性均<0.05，說明引數估計值與0有顯著的區別，而x3的引數估計值與0無顯著的區別。
共線性診斷
#共線性診斷
#利用kappa函式,計算自變數矩陣的條件數;從實際經驗的角度,一般若條件數<100,則認為多重共線性的程度很小,若100<=條件數<=1000,則認為存在中等程度的多重共線性,若條件數>1000,則認為存在嚴重的多重共線性.
x <- cor(princomp2)
kappa(x, exact=T)
#可以計算X矩陣的秩qr(X)$rank，如果不是滿秩的，說明其中有Xi可以用其他的X的線性組合表示
qr(princomp2)$rank
#相關係數矩陣
cor(princomp2[,-c(0,4)])
#特徵根法。根據矩陣性質，矩陣的行列式等於其特徵根的連乘積。因而當行列式|X′X|→0，矩陣X′X至少有一個特徵根近似等於零。說明解釋變數之間存在多重共線性。
#輸出的內容分別為特徵值和相對應的特徵向量，矩陣中的每一列都為特徵向量。
x <- cbind(rep(1,length(princomp2[,1])),princomp2[,-c(0,4)])
x <- as.matrix(x) #以1，x1，x2，x3為四列的矩陣
eigen(t(x)%*%x) #x的轉置*x 的特徵向量
#條件指數法（Conditional Index，CI）。條件指數CI=（λmax/λmin）0.5，其中λmax，λmin分別是矩陣XX′的最大和最小特徵根。條件指數度量了矩陣XX′的特徵根散佈程度，可以用來判斷多重共線性是否存在以及多重共線性的嚴重程度。一般認為，當0<CI<10 時，X 沒有多重共線性；當10<CI<100 時， X存在較強的多重共線性；當CI>100 時，存在嚴重的多重共線性。
#條件判別法，計算的條件指數值
CI <- eigen(t(x)%*%x)$values[1]/eigen(t(x)%*%x)$value[3] #value指eigen()函式的特徵值value的第一個值
CI
#方差膨脹因子（Variance Inflation Factors，VIF）。自變數j X 的方差擴大因子VIFj=Cjj=1/（1-Rj2），j=1，2，…p，其中C j j為(X ' X)???1中第 j個對角元素， R j 2為Xj為因變數,其餘 p ???1個自變數為自變數的迴歸可決係數,也即複相關係數。
#方差膨脹因子法.若變數膨脹因子都很大，則表明存在嚴重的多重共線性
library(car)
vif(lm.sol)觀察特徵向量，x2和x3出現0.91981490和0.999931723，這個結果接近1。如果一個模型中同時包含這兩個變數，得到的結果就會很不穩定，甚至產生誤導
2） 對原始變數主成分分析
#基本統計量，包括mean，sd，相關係數矩陣,相關係數矩陣的特徵值特徵向量
mean <- c( mean(princomp2$x1),mean(princomp2$x2),mean(princomp2$x3))
sd <- c(sd(princomp2$x1),sd(princomp2$x2),sd(princomp2$x3))
rbind(mean,sd)
cor(princomp2[,-c(0,4)]) #相關係數矩陣，設定[]就只取x1，x2，x3三列，不取y
eigen(cor(princomp2[,-c(0,4)])) #求princomp2[]的特徵值和特徵向量
#作主成分分析
princomp2.pr<-princomp(~x1+x2+x3, data=princomp2, cor=T)
summary(princomp2.pr, loadings=TRUE)
#predict(princomp2.pr) 各樣本的主成分的值，結果篇幅太長，略從特徵值和解釋比例來看，第一主成分和第二主成分的特徵值很大，能夠解釋的因變數變動已經達到0.8827，因此，我們可以選擇前兩個主成分來表示3個指標的資訊。用原始變量表達前兩個主成分的式子如下：
Z1=-0.585003X1-0.447445X2-0.676435X3
Z2=0.55658X1-0.828133X2+0.066442X3
其中Xi為標準指標變數，Xi = (xi-x均)/si, i=1,2,3
3） 對主成分得分變數進行迴歸分析
# 預測樣本主成分, 並作主成分分析
pre<-predict(princomp2.pr)
princomp2$z1<-pre[,1]
princomp2$z2<-pre[,2]
princomp2$z3<-pre[,3]
lm.sol<-lm(y~z1+z2+z3, data=princomp2)
summary(lm.sol)
#write.csv(princomp2,"princomp2_test.csv")模型檢驗的結果F值為21.23，顯著性P<0.001，拒絕原假設，說明主成分得分變數z1和z2均與因變數y具有顯著的相關關係
截距項和β1的t檢驗顯著性p值均<0.0001，說明主成分z1與y顯著相關，而β2的顯著性沒有意義（p=0.942），則因變數y在主成分上的線性迴歸方程式:
Y=2.76300-0.309737 * z1
=2.76300-0.309737 * (-0.585003 * X1-0.447445 * X2-0.676435 * X3)
=2.76300 + 0.1811971 * X1 +0.1385903 * X2 + 0.2095169 * X3
#以x1，x2，x3為三列組成的矩陣A
A <- cbind(princomp2$x1,princomp2$x2,princomp2$x3)
#取x1,x2,x3和X1，X2，X3
x1 <- A[,1]
x2 <- A[,2]
x3 <- A[,3]
X1 <- (x1 - mean(princomp2$x1)) / sd(princomp2$x1)
X2 <- (x2 - mean(princomp2$x2)) / sd(princomp2$x2)
X3 <- (x3 - mean(princomp2$x3)) / sd(princomp2$x3)
#建模算得的結果
Y <- 2.76300 + 0.1811971 * X1 +0.1385903 * X2 + 0.2095169 * X3
Y #去除β2影響的迴歸方程
Z <- -4.128216 + 0.04583787 * x1 + 0.02943588 * x2 + 0.06849709 * x3
Z #換算成用x1，x2，x3表示的式子
I <- -4.27585990 + 0.04774617 * x1 + 0.02930425 * x2 + 0.07038718 * x3
I #編寫計算係數的函式結果，沒有去除β2影響的迴歸方程X1=(x1-49.510)/3.953
X2=(x2-78.790000)/4.708212
X3=(x3-33.615000)/3.058771
將標準自變數還原為原始自變數，X1，X2，X3用x1，x2，x3表示，得到因變數y對原始自變數的迴歸模型：
Y = 2.76300 + 0.1811971 * (x1-49.510)/3.953 + 0.1385903 * (x2-78.790000)/4.708212 + 0.2095169 * (x3-33.615000)/3.058771
= 2.76300 + 0.04583787 * (x1-49.51000) + 0.02943588 * (x2-78.79000) + 0.06849709 * (x3-33.615000)
即: Y= -4.128216 + 0.04583787 * x1 + 0.02943588 * x2 + 0.06849709 * x3
這就是用主成分迴歸分析方法求得的線性迴歸模型
上述例子是先求summary(lm())，根據p值得到主成分，去除其他zi，得到迴歸方程
我們還可以先確定主成分，只將主成分的預測值存放在資料框中，lm()函式中y~只對主成分，直接得到迴歸方程
下面是這種方法迴歸方程係數的計算函式：
編寫計算係數的函式
#這裡得到迴歸方程的係數，是沒有去除z2（β2）影響的，在上面用I表示
#作變換，得到原座標下的關係表示式
beta<-coef(lm.sol); A<-loadings(princomp2.pr)
x.bar<-princomp2.pr$center; x.sd<-princomp2.pr$scale
coef<-(beta[2]*A[,1]+ beta[3]*A[,2])/x.sd
beta0 <- beta[1]- sum(x.bar * coef)
c(beta0, coef)* 迴歸方程為： Y = -4.27585990 + 0.04774617 x1 + 0.02930425 * x2 + 0.07038718 * x3 **
write.csv(princomp1,"write_princomp1.csv")
write.csv(princomp2,"write_princomp2.csv")