library(haven)
library(sjmisc)
## Warning: package 'sjmisc' was built under R version 4.0.3
## Install package "strengejacke" from GitHub (`devtools::install_github("strengejacke/strengejacke")`) to load all sj-packages at once!
cgss2017 <- read_dta("D:/Rmodels/cgss2017/cgss2017.dta")
table(cgss2017$a15)
##
## 1 2 3 4 5 98 99
## 593 2014 3261 4409 2300 3 2
c2017 <- sjmisc::to_label(cgss2017)
table(c2017$a15)
##
## 很不健康 比较不健康 一般 比较健康 很健康 不知道 拒绝回答
## 593 2014 3261 4409 2300 3 2
c2017[c2017=="拒绝回答"] <- NA
c2017[c2017=="不知道"] <- NA
c2017[c2017=="不适用"] <- NA
c2017[c2017=="无法回答"] <- NA
c2017[c2017=="无法选择"] <- NA
c2017[c2017=="不好说"] <- NA
c2017 <- droplevels(c2017)
table(c2017$a15)
##
## 很不健康 比较不健康 一般 比较健康 很健康
## 593 2014 3261 4409 2300
library("dplyr")
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
d19<-select(c2017,d191,d192,d193,d194,d195,d196,d197)
library(psych)
## Warning: package 'psych' was built under R version 4.0.3
d19$d191<-as.numeric(d19$d191)
d19$d192<-as.numeric(d19$d192)
d19$d193<-as.numeric(d19$d193)
d19$d196<-as.numeric(d19$d196)
d19$d194<-as.numeric(d19$d194)
d19$d195<-as.numeric(d19$d194)
d19$d197<-as.numeric(d19$d197)
lowerCor(d19)
## d191 d192 d193 d194 d195 d196 d197
## d191 1.00
## d192 0.51 1.00
## d193 0.26 0.29 1.00
## d194 0.30 0.40 0.03 1.00
## d195 0.30 0.40 0.03 1.00 1.00
## d196 0.24 0.20 0.30 0.06 0.06 1.00
## d197 0.29 0.38 0.04 0.63 0.63 0.13 1.00
cor.plot(d19,numbers=TRUE,main="6 variables from Test Score")
test<-d19
uls <- fa(test,2,rotate="varimax")
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## In smc, smcs < 0 were set to .0
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## In smc, smcs < 0 were set to .0
## Warning in cor.smooth(R): Matrix was not positive definite, smoothing was done
## In smc, smcs < 0 were set to .0
## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done
## In factor.scores, the correlation matrix is singular, an approximation is used
## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done
print(uls,sort=TRUE)
## Factor Analysis using method = minres
## Call: fa(r = test, nfactors = 2, rotate = "varimax")
## Standardized loadings (pattern matrix) based upon correlation matrix
## item MR1 MR2 h2 u2 com
## d195 5 0.99 0.08 0.99 0.011 1.0
## d194 4 0.99 0.08 0.99 0.011 1.0
## d197 7 0.62 0.21 0.43 0.571 1.2
## d192 2 0.37 0.60 0.50 0.495 1.7
## d191 1 0.27 0.60 0.43 0.567 1.4
## d193 3 -0.03 0.51 0.26 0.740 1.0
## d196 6 0.03 0.42 0.18 0.823 1.0
##
## MR1 MR2
## SS loadings 2.56 1.22
## Proportion Var 0.37 0.17
## Cumulative Var 0.37 0.54
## Proportion Explained 0.68 0.32
## Cumulative Proportion 0.68 1.00
##
## Mean item complexity = 1.2
## Test of the hypothesis that 2 factors are sufficient.
##
## The degrees of freedom for the null model are 21 and the objective function was 23.62 with Chi Square of 297047.1
## The degrees of freedom for the model are 8 and the objective function was 17.59
##
## The root mean square of the residuals (RMSR) is 0.03
## The df corrected root mean square of the residuals is 0.05
##
## The harmonic number of observations is 4109 with the empirical chi square 168.12 with prob < 3.2e-32
## The total number of observations was 12582 with Likelihood Chi Square = 221165.6 with prob < 0
##
## Tucker Lewis Index of factoring reliability = -0.955
## RMSEA index = 1.482 and the 90 % confidence intervals are 1.477 1.488
## BIC = 221090.1
## Fit based upon off diagonal values = 0.99
## Measures of factor score adequacy
## MR1 MR2
## Correlation of (regression) scores with factors 0.99 0.81
## Multiple R square of scores with factors 0.99 0.65
## Minimum correlation of possible factor scores 0.97 0.30
fa.diagram(uls,digits = 2,main="Test Score Factors")
plot(uls)
fs <- factor.scores(test,uls) #obtain factor scores
## Warning in cor.smooth(r): Matrix was not positive definite, smoothing was done
fs <- fs$scores #get the columns of factor scores for each case
bfi <- cbind(c2017,fs) #append factor scores to dataset