### setting enviorment ###
library(foreign)
library(semPLS)
## Loading required package: lattice
library(knitr)
setwd('/Users/huangzongxian/Desktop/20201208高等量化上機/PLS demo')
options(digits = 5, scipen = 999)
rm(list = ls())
### loading data ###
data <- read.csv("Corporate Reputation Data.csv", sep = ";")
str(data)
## 'data.frame': 344 obs. of 46 variables:
## $ serviceprovider: int 3 3 3 3 3 3 1 1 3 3 ...
## $ servicetype : int 2 2 2 2 2 2 1 1 1 2 ...
## $ csor_1 : int 3 2 3 3 4 3 7 4 7 4 ...
## $ csor_2 : int 3 5 1 3 3 3 5 1 5 1 ...
## $ csor_3 : int 3 6 2 5 4 4 7 3 6 5 ...
## $ csor_4 : int 3 4 2 3 4 3 3 3 4 2 ...
## $ csor_5 : int 3 6 4 5 4 3 3 2 6 4 ...
## $ csor_global : int 3 6 4 5 4 4 7 4 7 5 ...
## $ attr_1 : int 5 6 5 3 6 4 5 4 6 5 ...
## $ attr_2 : int 1 6 6 7 6 1 7 1 3 1 ...
## $ attr_3 : int 3 6 5 5 6 5 3 5 7 6 ...
## $ attr_global : int 5 6 6 7 6 5 7 5 7 6 ...
## $ perf_1 : int 5 6 4 5 5 6 4 5 7 6 ...
## $ perf_2 : int 4 6 4 5 6 6 7 6 7 5 ...
## $ perf_3 : int 2 6 2 5 7 4 6 6 4 4 ...
## $ perf_4 : int 5 6 5 3 6 5 5 4 6 6 ...
## $ perf_5 : int 6 6 4 6 5 6 4 7 7 5 ...
## $ perf_global : int 6 6 5 6 7 6 7 7 7 6 ...
## $ qual_1 : int 5 6 3 5 6 5 5 6 7 6 ...
## $ qual_2 : int 6 6 4 6 5 5 5 3 7 6 ...
## $ qual_3 : int 4 6 3 6 7 5 6 2 6 5 ...
## $ qual_4 : int 2 6 4 7 7 6 4 1 7 6 ...
## $ qual_5 : int 4 5 3 5 6 5 7 6 6 7 ...
## $ qual_6 : int 4 6 5 4 6 6 7 5 7 7 ...
## $ qual_7 : int 2 6 4 5 6 3 4 1 6 4 ...
## $ qual_8 : int 5 5 4 6 7 4 4 5 7 7 ...
## $ qual_global : int 6 6 5 7 7 6 7 6 7 7 ...
## $ like_1 : int 3 6 5 6 6 6 4 4 7 6 ...
## $ like_2 : int 1 6 5 5 6 7 1 3 5 6 ...
## $ like_3 : int 2 6 5 6 7 7 7 4 7 6 ...
## $ comp_1 : int 4 6 4 6 6 3 7 6 5 6 ...
## $ comp_2 : int 5 7 5 4 4 4 5 6 7 5 ...
## $ comp_3 : int 5 6 2 4 6 4 7 6 6 5 ...
## $ cusl_1 : int 5 7 7 7 6 7 7 5 5 6 ...
## $ cusl_2 : int 3 7 7 7 7 7 7 4 7 6 ...
## $ cusl_3 : int 3 7 5 7 7 7 7 6 7 7 ...
## $ cusa : int 5 7 6 6 6 6 7 4 6 6 ...
## $ age : int 2 6 2 3 2 2 1 5 1 3 ...
## $ education : int 3 3 3 4 2 2 2 2 1 2 ...
## $ occupation : int 11 -99 11 11 12 11 11 3 11 2 ...
## $ nphh : int 5 2 2 1 5 1 3 3 4 2 ...
## $ sample_type : int 1 1 1 1 1 1 1 1 1 1 ...
## $ mga_1 : int 2 2 2 2 2 2 1 1 1 2 ...
## $ mga_2 : int 1 1 1 1 1 1 1 1 1 1 ...
## $ mga_3 : int 1 1 1 1 1 1 2 2 1 1 ...
## $ mga_4 : int 1 1 1 1 1 1 1 1 1 1 ...
summary(data)
## serviceprovider servicetype csor_1 csor_2 csor_3
## Min. :1 Min. :1.00 Min. :1.00 Min. :1.00 Min. :1.00
## 1st Qu.:1 1st Qu.:1.00 1st Qu.:3.00 1st Qu.:2.00 1st Qu.:3.00
## Median :2 Median :2.00 Median :4.00 Median :3.00 Median :4.00
## Mean :2 Mean :1.64 Mean :4.24 Mean :3.08 Mean :3.99
## 3rd Qu.:3 3rd Qu.:2.00 3rd Qu.:5.00 3rd Qu.:4.00 3rd Qu.:5.00
## Max. :4 Max. :2.00 Max. :7.00 Max. :7.00 Max. :7.00
## csor_4 csor_5 csor_global attr_1 attr_2
## Min. :1.00 Min. :1.00 Min. :1.00 Min. :1.00 Min. :1.00
## 1st Qu.:2.00 1st Qu.:3.00 1st Qu.:4.00 1st Qu.:4.00 1st Qu.:1.00
## Median :3.00 Median :4.00 Median :5.00 Median :5.00 Median :2.00
## Mean :3.12 Mean :3.98 Mean :4.99 Mean :4.99 Mean :2.94
## 3rd Qu.:4.00 3rd Qu.:5.00 3rd Qu.:6.00 3rd Qu.:6.00 3rd Qu.:5.00
## Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00
## attr_3 attr_global perf_1 perf_2 perf_3
## Min. :1.00 Min. :2.00 Min. :1.00 Min. :1.00 Min. :1.00
## 1st Qu.:4.00 1st Qu.:5.00 1st Qu.:4.00 1st Qu.:4.00 1st Qu.:4.00
## Median :5.00 Median :6.00 Median :5.00 Median :5.00 Median :5.00
## Mean :4.81 Mean :5.59 Mean :4.62 Mean :5.07 Mean :4.72
## 3rd Qu.:6.00 3rd Qu.:7.00 3rd Qu.:6.00 3rd Qu.:6.00 3rd Qu.:6.00
## Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00
## perf_4 perf_5 perf_global qual_1 qual_2
## Min. :1.00 Min. :1.00 Min. :3.00 Min. :1.00 Min. :1.00
## 1st Qu.:4.00 1st Qu.:4.00 1st Qu.:5.00 1st Qu.:4.00 1st Qu.:3.00
## Median :5.00 Median :5.00 Median :6.00 Median :5.00 Median :5.00
## Mean :4.92 Mean :4.97 Mean :5.98 Mean :5.05 Mean :4.37
## 3rd Qu.:6.00 3rd Qu.:6.00 3rd Qu.:7.00 3rd Qu.:6.00 3rd Qu.:5.00
## Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00
## qual_3 qual_4 qual_5 qual_6 qual_7
## Min. :1.00 Min. :1.00 Min. :1.00 Min. :1.00 Min. :1.0
## 1st Qu.:4.00 1st Qu.:3.00 1st Qu.:4.00 1st Qu.:4.00 1st Qu.:3.0
## Median :5.00 Median :4.00 Median :5.00 Median :5.00 Median :4.0
## Mean :5.08 Mean :4.41 Mean :5.01 Mean :4.92 Mean :4.4
## 3rd Qu.:6.00 3rd Qu.:5.00 3rd Qu.:6.00 3rd Qu.:6.00 3rd Qu.:6.0
## Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.0
## qual_8 qual_global like_1 like_2 like_3
## Min. :1.00 Min. :2.00 Min. :1.00 Min. :1.00 Min. :1.00
## 1st Qu.:4.00 1st Qu.:5.00 1st Qu.:4.00 1st Qu.:3.00 1st Qu.:3.00
## Median :5.00 Median :6.00 Median :5.00 Median :4.00 Median :5.00
## Mean :4.84 Mean :6.03 Mean :4.58 Mean :4.25 Mean :4.48
## 3rd Qu.:6.00 3rd Qu.:7.00 3rd Qu.:6.00 3rd Qu.:6.00 3rd Qu.:6.00
## Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00 Max. :7.00
## comp_1 comp_2 comp_3 cusl_1 cusl_2
## Min. :1.00 Min. :1.00 Min. :1.00 Min. :-99.00 Min. :-99.00
## 1st Qu.:4.00 1st Qu.:4.00 1st Qu.:4.00 1st Qu.: 4.00 1st Qu.: 4.00
## Median :5.00 Median :6.00 Median :5.50 Median : 5.00 Median : 6.00
## Mean :4.65 Mean :5.42 Mean :5.22 Mean : 4.22 Mean : 4.06
## 3rd Qu.:6.00 3rd Qu.:7.00 3rd Qu.:6.00 3rd Qu.: 6.00 3rd Qu.: 7.00
## Max. :7.00 Max. :7.00 Max. :7.00 Max. : 7.00 Max. : 7.00
## cusl_3 cusa age education
## Min. :-99.00 Min. :-99.00 Min. :-99.00 Min. :-99.000
## 1st Qu.: 5.00 1st Qu.: 5.00 1st Qu.: 2.00 1st Qu.: 2.000
## Median : 6.00 Median : 6.00 Median : 3.00 Median : 2.000
## Mean : 4.74 Mean : 5.14 Mean : 3.04 Mean : -0.105
## 3rd Qu.: 7.00 3rd Qu.: 6.00 3rd Qu.: 4.00 3rd Qu.: 3.000
## Max. : 7.00 Max. : 7.00 Max. : 6.00 Max. : 4.000
## occupation nphh sample_type mga_1 mga_2
## Min. :-99.0 Min. :-99.00 Min. :1.00 Min. :1.00 Min. :1.00
## 1st Qu.: 3.0 1st Qu.: 2.00 1st Qu.:1.00 1st Qu.:1.00 1st Qu.:1.00
## Median : 4.0 Median : 3.00 Median :1.00 Median :2.00 Median :1.00
## Mean : -7.9 Mean : 1.72 Mean :1.83 Mean :1.64 Mean :1.49
## 3rd Qu.: 7.0 3rd Qu.: 4.00 3rd Qu.:3.00 3rd Qu.:2.00 3rd Qu.:2.00
## Max. : 13.0 Max. : 5.00 Max. :4.00 Max. :2.00 Max. :2.00
## mga_3 mga_4
## Min. :1.0 Min. :1.00
## 1st Qu.:1.0 1st Qu.:1.00
## Median :2.0 Median :1.00
## Mean :1.5 Mean :1.29
## 3rd Qu.:2.0 3rd Qu.:2.00
## Max. :2.0 Max. :2.00
data <- data[-which(data$cusa == -99 | data$cusl_1 == -99|
data$cusl_2 == -99 | data$cusl_3 == -99),] # missing value
# measurement model
CRPmm <- rbind(c('qual_1', 'QUAL'),
c('qual_2', 'QUAL'),
c('qual_3', 'QUAL'),
c('qual_4', 'QUAL'),
c('qual_5', 'QUAL'),
c('qual_6', 'QUAL'),
c('qual_7', 'QUAL'),
c('qual_8', 'QUAL'),
c('perf_1', 'PERF'),
c('perf_2', 'PERF'),
c('perf_3', 'PERF'),
c('perf_4', 'PERF'),
c('perf_5', 'PERF'),
c('csor_1', 'CSOR'),
c('csor_2', 'CSOR'),
c('csor_3', 'CSOR'),
c('csor_4', 'CSOR'),
c('csor_5', 'CSOR'),
c('attr_1', 'ATTR'),
c('attr_2', 'ATTR'),
c('attr_3', 'ATTR'),
c('CUSA', 'cusa'),
c('COMP', 'comp_1'),
c('COMP', 'comp_2'),
c('COMP', 'comp_3'),
c('LIKE', 'like_1'),
c('LIKE', 'like_2'),
c('LIKE', 'like_3'),
c('CUSL', 'cusl_1'),
c('CUSL', 'cusl_2'),
c('CUSL', 'cusl_3'))
# structural model
CRPsm <- rbind(c('QUAL', 'COMP'),
c('QUAL', 'LIKE'),
c('PERF', 'COMP'),
c('PERF', 'LIKE'),
c('CSOR', 'COMP'),
c('CSOR', 'LIKE'),
c('ATTR', 'COMP'),
c('ATTR', 'LIKE'),
c('COMP', 'CUSA'),
c('COMP', 'CUSL'),
c('LIKE', 'CUSA'),
c('LIKE', 'CUSL'),
c('CUSA', 'CUSL'))
# fitting
CRP <- plsm(data = data, strucmod = CRPsm, measuremod = CRPmm)
CRP_fit <- sempls(model = CRP, data = data, wscheme = 'pathWeighting')
## All 336 observations are valid.
## Converged after 10 iterations.
## Tolerance: 0.0000001
## Scheme: path weighting
CRP_fit # basic results
## Path Estimate
## gam_1_1 attr_1 -> ATTR 0.418
## gam_1_2 attr_2 -> ATTR 0.204
## gam_1_3 attr_3 -> ATTR 0.656
## gam_2_1 csor_1 -> CSOR 0.274
## gam_2_2 csor_2 -> CSOR 0.035
## gam_2_3 csor_3 -> CSOR 0.418
## gam_2_4 csor_4 -> CSOR 0.094
## gam_2_5 csor_5 -> CSOR 0.421
## gam_3_1 perf_1 -> PERF 0.465
## gam_3_2 perf_2 -> PERF 0.170
## gam_3_3 perf_3 -> PERF 0.186
## gam_3_4 perf_4 -> PERF 0.350
## gam_3_5 perf_5 -> PERF 0.201
## gam_4_1 qual_1 -> QUAL 0.201
## gam_4_2 qual_2 -> QUAL 0.055
## gam_4_3 qual_3 -> QUAL 0.097
## gam_4_4 qual_4 -> QUAL -0.011
## gam_4_5 qual_5 -> QUAL 0.157
## gam_4_6 qual_6 -> QUAL 0.397
## gam_4_7 qual_7 -> QUAL 0.228
## gam_4_8 qual_8 -> QUAL 0.203
## lam_5_1 COMP -> comp_1 0.823
## lam_5_2 COMP -> comp_2 0.823
## lam_5_3 COMP -> comp_3 0.842
## lam_6_1 LIKE -> like_1 0.879
## lam_6_2 LIKE -> like_2 0.866
## lam_6_3 LIKE -> like_3 0.846
## lam_7_1 CUSA -> cusa 1.000
## lam_8_1 CUSL -> cusl_1 0.834
## lam_8_2 CUSL -> cusl_2 0.919
## lam_8_3 CUSL -> cusl_3 0.844
## beta_1_5 ATTR -> COMP 0.085
## beta_2_5 CSOR -> COMP 0.057
## beta_3_5 PERF -> COMP 0.295
## beta_4_5 QUAL -> COMP 0.431
## beta_1_6 ATTR -> LIKE 0.159
## beta_2_6 CSOR -> LIKE 0.190
## beta_3_6 PERF -> LIKE 0.116
## beta_4_6 QUAL -> LIKE 0.378
## beta_5_7 COMP -> CUSA 0.135
## beta_6_7 LIKE -> CUSA 0.445
## beta_5_8 COMP -> CUSL 0.011
## beta_6_8 LIKE -> CUSL 0.334
## beta_7_8 CUSA -> CUSL 0.510
gof(CRP_fit)
## Value
## Average R-squared 0.51
## Average Communality 0.73
## GoF 0.61
rSquared2(CRP_fit)
## R-squared R-squared-corrected predecessors
## ATTR . . 0
## CSOR . . 0
## PERF . . 0
## QUAL . . 0
## COMP 0.63 0.62 4
## LIKE 0.56 0.55 4
## CUSA 0.29 0.29 2
## CUSL 0.56 0.56 3
##
## Average R-squared: 0.51
qSquared(CRP_fit, d = 5)
## Q-Squared
## ATTR .
## CSOR .
## PERF .
## QUAL .
## COMP 0.41
## LIKE 0.39
## CUSA 0.29
## CUSL 0.41
# boot-strapping
CRPfit_Boot <- bootsempls(CRP_fit, nboot = 200, start = "ones", verbose = F)
## Loading required package: boot
##
## Attaching package: 'boot'
## The following object is masked from 'package:lattice':
##
## melanoma
CRPfit_Bootsummary <- summary(CRPfit_Boot , type = "perc", level = 0.95)
tab <- cbind(CRP_fit$coefficients$Path, CRPfit_Bootsummary$table,
CRPfit_Bootsummary$table$Estimate/CRPfit_Bootsummary$table$Std.Error)
kable(tab)
| CRP_fit\(coefficients\)Path | Estimate | Bias | Std.Error | Lower | Upper | CRPfit_Bootsummary\(table\)Estimate/CRPfit_Bootsummary\(table\)Std.Error | |
|---|---|---|---|---|---|---|---|
| gam_1_1 | attr_1 -> ATTR | 0.41812 | 0.00032 | 0.06804 | 0.29453 | 0.55567 | 6.14557 |
| gam_1_2 | attr_2 -> ATTR | 0.20396 | -0.00447 | 0.06829 | 0.05585 | 0.33309 | 2.98695 |
| gam_1_3 | attr_3 -> ATTR | 0.65620 | -0.00347 | 0.06130 | 0.52812 | 0.78245 | 10.70487 |
| gam_2_1 | csor_1 -> CSOR | 0.27435 | -0.00163 | 0.08207 | 0.09770 | 0.44487 | 3.34292 |
| gam_2_2 | csor_2 -> CSOR | 0.03454 | -0.00123 | 0.07525 | -0.11582 | 0.18498 | 0.45903 |
| gam_2_3 | csor_3 -> CSOR | 0.41827 | -0.01796 | 0.08859 | 0.23564 | 0.56252 | 4.72158 |
| gam_2_4 | csor_4 -> CSOR | 0.09417 | -0.00055 | 0.07635 | -0.05319 | 0.24337 | 1.23339 |
| gam_2_5 | csor_5 -> CSOR | 0.42117 | 0.01258 | 0.09216 | 0.24813 | 0.61582 | 4.56983 |
| gam_3_1 | perf_1 -> PERF | 0.46532 | -0.00753 | 0.07153 | 0.31400 | 0.60212 | 6.50504 |
| gam_3_2 | perf_2 -> PERF | 0.17039 | -0.00273 | 0.07166 | 0.01505 | 0.31445 | 2.37785 |
| gam_3_3 | perf_3 -> PERF | 0.18647 | -0.00460 | 0.05796 | 0.05170 | 0.28256 | 3.21713 |
| gam_3_4 | perf_4 -> PERF | 0.35005 | 0.00562 | 0.07033 | 0.21685 | 0.49442 | 4.97748 |
| gam_3_5 | perf_5 -> PERF | 0.20102 | 0.00403 | 0.07135 | 0.05489 | 0.36962 | 2.81749 |
| gam_4_1 | qual_1 -> QUAL | 0.20147 | 0.00069 | 0.06523 | 0.08525 | 0.33633 | 3.08863 |
| gam_4_2 | qual_2 -> QUAL | 0.05531 | -0.00544 | 0.05162 | -0.04817 | 0.15474 | 1.07137 |
| gam_4_3 | qual_3 -> QUAL | 0.09665 | 0.00656 | 0.06569 | -0.00552 | 0.24167 | 1.47128 |
| gam_4_4 | qual_4 -> QUAL | -0.01058 | 0.00664 | 0.05852 | -0.10286 | 0.15532 | -0.18089 |
| gam_4_5 | qual_5 -> QUAL | 0.15670 | -0.00605 | 0.06227 | 0.02334 | 0.27222 | 2.51645 |
| gam_4_6 | qual_6 -> QUAL | 0.39721 | 0.00136 | 0.06842 | 0.26363 | 0.53563 | 5.80585 |
| gam_4_7 | qual_7 -> QUAL | 0.22768 | -0.01227 | 0.05801 | 0.08783 | 0.32582 | 3.92484 |
| gam_4_8 | qual_8 -> QUAL | 0.20295 | -0.00153 | 0.05949 | 0.08193 | 0.32076 | 3.41132 |
| lam_5_1 | COMP -> comp_1 | 0.82347 | 0.00197 | 0.01986 | 0.78406 | 0.86323 | 41.46727 |
| lam_5_2 | COMP -> comp_2 | 0.82250 | 0.00006 | 0.02167 | 0.77789 | 0.86345 | 37.96090 |
| lam_5_3 | COMP -> comp_3 | 0.84247 | 0.00152 | 0.02269 | 0.79188 | 0.88315 | 37.12209 |
| lam_6_1 | LIKE -> like_1 | 0.87859 | -0.00058 | 0.01591 | 0.84457 | 0.90376 | 55.21887 |
| lam_6_2 | LIKE -> like_2 | 0.86624 | 0.00124 | 0.01737 | 0.82983 | 0.89963 | 49.87139 |
| lam_6_3 | LIKE -> like_3 | 0.84645 | -0.00125 | 0.02032 | 0.80065 | 0.88371 | 41.64699 |
| lam_7_1 | CUSA -> cusa | 1.00000 | 0.00000 | 0.00000 | NA | NA | 19376801068279856.00000 |
| lam_8_1 | CUSL -> cusl_1 | 0.83396 | 0.00162 | 0.02449 | 0.77740 | 0.87569 | 34.05830 |
| lam_8_2 | CUSL -> cusl_2 | 0.91939 | 0.00166 | 0.00970 | 0.90074 | 0.93810 | 94.82814 |
| lam_8_3 | CUSL -> cusl_3 | 0.84355 | 0.00011 | 0.02390 | 0.79878 | 0.88538 | 35.29030 |
| beta_1_5 | ATTR -> COMP | 0.08539 | 0.00353 | 0.05636 | -0.02315 | 0.20294 | 1.51521 |
| beta_2_5 | CSOR -> COMP | 0.05689 | -0.00257 | 0.05429 | -0.05351 | 0.15479 | 1.04796 |
| beta_3_5 | PERF -> COMP | 0.29527 | 0.00188 | 0.07315 | 0.13737 | 0.45056 | 4.03659 |
| beta_4_5 | QUAL -> COMP | 0.43140 | 0.00302 | 0.07186 | 0.28322 | 0.56610 | 6.00335 |
| beta_1_6 | ATTR -> LIKE | 0.15864 | -0.00756 | 0.06263 | 0.03064 | 0.26210 | 2.53309 |
| beta_2_6 | CSOR -> LIKE | 0.18987 | 0.00469 | 0.05398 | 0.09634 | 0.30887 | 3.51707 |
| beta_3_6 | PERF -> LIKE | 0.11577 | 0.00039 | 0.06963 | -0.00086 | 0.27266 | 1.66265 |
| beta_4_6 | QUAL -> LIKE | 0.37835 | 0.01074 | 0.06492 | 0.24170 | 0.51655 | 5.82829 |
| beta_5_7 | COMP -> CUSA | 0.13500 | 0.00072 | 0.07004 | -0.00241 | 0.26760 | 1.92733 |
| beta_6_7 | LIKE -> CUSA | 0.44512 | 0.00233 | 0.06361 | 0.32051 | 0.57791 | 6.99794 |
| beta_5_8 | COMP -> CUSL | 0.01149 | 0.00231 | 0.04828 | -0.07633 | 0.11364 | 0.23794 |
| beta_6_8 | LIKE -> CUSL | 0.33356 | -0.00030 | 0.05332 | 0.23573 | 0.45172 | 6.25569 |
| beta_7_8 | CUSA -> CUSL | 0.50994 | -0.00153 | 0.03945 | 0.41893 | 0.57819 | 12.92626 |