####################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’
)

20231205第十三週-多變量作業