####################HW###########################
#從資料庫中的 涉入度、互動、品牌形象、信任 四個變項依據 主成分分析,萃
#取第一個主成分(要命名),然後進行對購買意願的影響,分別檢驗
#(1) 線性迴歸分析
#(2) 中位數迴歸分析
#(3) 是否有二次曲線特徵
#加入性別和教育程度為控制變數。
Data<-read.csv(“C:/Users/zxcvb/Desktop/研/多變量/data3.csv”)
summary(Data)
str(Data)
for(i in 2:31){
temp_mean<-mean(Data[,i],na.rm=T)
na.rows<-is.na(Data[,i])Data[na.rows,i]<-temp_mean
}
str(Data)
Data$涉入度 <-rowMeans(Data[ ,c(2:6,8)])
Data$ 互動 <-rowMeans(Data[ ,c(9:13)])
Data$ 信任 <-rowMeans(Data[ ,c(14:20)])
Data$品牌形象 <-rowMeans(Data[ ,c(21:26)])
Data$購買意願 <-rowMeans(Data[ ,c(27:31)])Data$High <- ifelse(Data$購買意願 >= median(Data$購買意願),1,0)
Data$sex <- ifelse(Data$g1==1,’Boy’,’Girl’)
for (i in 1:384){
if( Data[i,’g2′] <=3 ) {Data[i,’Edu’] <- ‘高中(含以下)’}
if( Data[i,’g2′] ==4 ) {Data[i,’Edu’] <- ‘大學、大專’}
if( Data[i,’g2′] ==5 ) {Data[i,’Edu’] <- ‘研究所’}
}
#########################PCA
##主成分分析
###1.產生一個新的變項,由舊的變項線性組合(加權)而成
###主要源自於 舊的變項有高度相關
###有一種 形成性變項 = 主成分
###目的
###複製 舊的變項的變異數 => 形成 一個新的指標 用在後面的分析
###把受試者加以 差異化
###2.除了差異化以外
###解決 高度共線性問題 => 舊的變項高度相關
###做 主成分回歸
###3.在因素分析中做為萃取法之用
##特徵
##1.有多少個舊的變項 就會 形成多少個主成分
##2.上述主成分之間 彼此獨立
##3.第一個主成分 約略就是 舊的變項的平均數
##4.這個第一主成分有最大的變異數,就是舊的變項的最大特徵值
##5.第二個主成分 約略是 舊變項之間的對比(正負)
PCAHW <- princomp(Data[,34:37],cor = TRUE,scores= TRUE)
summary(PCAHW)
#Importance of components:
# Comp.1 Comp.2 Comp.3 Comp.4
#Standard deviation 1.5917706 0.8240888 0.6724596 0.57874177
#Proportion of Variance 0.6334334 0.1697806 0.1130505 0.08373551
#Cumulative Proportion 0.6334334 0.8032140 0.9162645 1.00000000
#第一個組成分跟第二個,一起解釋了80% (0.8032140)
#第三個只有解釋11%,為甚麼可以一起解釋,因為他們互相獨立
PCAHW$loadings
##Loadings: 加權係數
# Comp.1 Comp.2 Comp.3 Comp.4
#涉入度 0.416 0.909
#互動 0.536 -0.236 -0.343 0.734
#信任 0.532 -0.223 -0.459 -0.675
#品牌形象 0.506 -0.263 0.819
#第一個組成分,相當於舊的變項的平均數
#第二個組成分,相當於’對比’
PCA1 <- PCAHW $scores[, 1]
HW<- cbind(Data,PCA1)
summary(reg <- lm(data = HW ,購買意願 ~ PCA1))
#(1) 線性迴歸分析
reg1 <- lm(data =HW ,購買意願 ~ PCA1 + sex + Edu)
#(2) 中位數迴歸分析
library(quantreg)
reg2 <- rq(data =HW ,購買意願 ~ PCA1 + sex + Edu)
#(3) 是否有二次曲線特徵
HW$PCA1_squared <- HW$PCA1^2
reg3 <- lm(購買意願 ~ PCA1 + PCA1_squared + sex + Edu, data = HW)
library(stargazer)
stargazer(reg1,reg2,reg3,
type = ‘html’, #html , #text
digits = 2 ,
#header = FALSE,
out = ‘C:/Users/zxcvb/Desktop/研/多變量/logit.html’,
title = ‘Regression Results’
)