R Notebook

Add a new chunk by clicking the Insert Chunk button on the toolbar or by pressing Ctrl+Alt+I.

setwd("C:/Users/cmhon/Downloads")
library(tigerstats )

경고: 패키지 ‘tigerstats’는 R 버전 4.2.2에서 작성되었습니다필요한 패키지를 로딩중입니다: abd
경고: 패키지 ‘abd’는 R 버전 4.2.2에서 작성되었습니다필요한 패키지를 로딩중입니다: nlme
필요한 패키지를 로딩중입니다: lattice
필요한 패키지를 로딩중입니다: grid
필요한 패키지를 로딩중입니다: mosaic
경고: 패키지 ‘mosaic’는 R 버전 4.2.2에서 작성되었습니다Registered S3 method overwritten by 'mosaic':
  method                           from   
  fortify.SpatialPolygonsDataFrame ggplot2

The 'mosaic' package masks several functions from core packages in order to add 
additional features.  The original behavior of these functions should not be affected by this.

다음의 패키지를 부착합니다: ‘mosaic’

The following objects are masked from ‘package:dplyr’:

    count, do, tally

The following object is masked from ‘package:Matrix’:

    mean

The following object is masked from ‘package:ggplot2’:

    stat

The following objects are masked from ‘package:stats’:

    binom.test, cor, cor.test, cov, fivenum, IQR, median,
    prop.test, quantile, sd, t.test, var

The following objects are masked from ‘package:base’:

    max, mean, min, prod, range, sample, sum

Welcome to tigerstats!
To learn more about this package, consult its website:
    http://homerhanumat.github.io/tigerstats

library(tidyverse)

경고: 패키지 ‘tidyverse’는 R 버전 4.2.2에서 작성되었습니다Registered S3 methods overwritten by 'dbplyr':
  method         from
  print.tbl_lazy     
  print.tbl_sql      
── Attaching packages ────────────────────────────────── tidyverse 1.3.2 ──✔ tibble  3.1.7     ✔ purrr   0.3.5
✔ tidyr   1.2.1     ✔ stringr 1.4.1
✔ readr   2.1.3     ✔ forcats 0.5.2경고: 패키지 ‘tidyr’는 R 버전 4.2.2에서 작성되었습니다경고: 패키지 ‘readr’는 R 버전 4.2.2에서 작성되었습니다경고: 패키지 ‘purrr’는 R 버전 4.2.2에서 작성되었습니다경고: 패키지 ‘stringr’는 R 버전 4.2.2에서 작성되었습니다경고: 패키지 ‘forcats’는 R 버전 4.2.2에서 작성되었습니다── Conflicts ───────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::collapse() masks nlme::collapse()
✖ mosaic::count()   masks dplyr::count()
✖ purrr::cross()    masks mosaic::cross()
✖ mosaic::do()      masks dplyr::do()
✖ tidyr::expand()   masks Matrix::expand()
✖ dplyr::filter()   masks stats::filter()
✖ dplyr::lag()      masks stats::lag()
✖ tidyr::pack()     masks Matrix::pack()
✖ mosaic::stat()    masks ggplot2::stat()
✖ mosaic::tally()   masks dplyr::tally()
✖ tidyr::unpack()   masks Matrix::unpack()

library(DT)

경고: 패키지 ‘DT’는 R 버전 4.2.2에서 작성되었습니다Registered S3 method overwritten by 'htmlwidgets':
  method           from         
  print.htmlwidget tools:rstudio

library(psych)

경고: 패키지 ‘psych’는 R 버전 4.2.2에서 작성되었습니다
다음의 패키지를 부착합니다: ‘psych’

The following objects are masked from ‘package:mosaic’:

    logit, rescale

The following objects are masked from ‘package:ggplot2’:

    %+%, alpha

library(dplyr)

# PLS:SEM 
df =read.csv("df.csv")

colnames(df)

 [1] "Type"              "ID"                "X3_card"          
 [4] "X5_pay.amount"     "gender"            "age"              
 [7] "region"            "smartphone"        "online_perception"
[10] "on_Simple"         "On_Card"           "Off_Simple"       
[13] "Off_Card"          "WTP"               "bag"              
[16] "shoes"             "tshirt"            "clock"            
[19] "convenience"       "pain"              "adoption"         
[22] "form"             

# load devtools
library(devtools)
# then download 'plspm' using 'install_github'
install_github("M-E-Rademaker/cSEM")

Skipping install of 'cSEM' from a github remote, the SHA1 (48ff5c8d) has not changed since last install.
  Use `force = TRUE` to force installation

install_github("gastonstat/plspm")

Skipping install of 'plspm' from a github remote, the SHA1 (bd21cb15) has not changed since last install.
  Use `force = TRUE` to force installation

library(plspm)

다음의 패키지를 부착합니다: ‘plspm’

The following objects are masked from ‘package:psych’:

    alpha, rescale, unidim

The following object is masked from ‘package:mosaic’:

    rescale

The following object is masked from ‘package:ggplot2’:

    alpha

# PLS:SEM 
df =read.csv("df.csv")

colnames(df)

 [1] "Type"              "ID"                "X3_card"          
 [4] "X5_pay.amount"     "gender"            "age"              
 [7] "region"            "smartphone"        "online_perception"
[10] "on_Simple"         "On_Card"           "Off_Simple"       
[13] "Off_Card"          "WTP"               "bag"              
[16] "shoes"             "tshirt"            "clock"            
[19] "convenience"       "pain"              "adoption"         
[22] "form"             

df <- df %>% mutate(wtp = WTP/10000)
convenience = c(0,0,0,0)
pain = c(0,0,0,0)
adoption = c(1,1,0,0)
wtp= c(1,1,1,0)

x = rbind(convenience, pain, adoption, wtp)
colnames(x)= rownames(x)
innerplot(x)

out = list(19, 20, 21, 15:18)
mode = c("A", "A", "A", "A")

xx = plspm(df, x, out, scheme ="path", boot.val = T, br=100)

summary(xx)

PARTIAL LEAST SQUARES PATH MODELING (PLS-PM) 

---------------------------------------------------------- 
MODEL SPECIFICATION 
1   Number of Cases      2964 
2   Latent Variables     4 
3   Manifest Variables   7 
4   Scale of Data        Standardized Data 
5   Non-Metric PLS       FALSE 
6   Weighting Scheme     path 
7   Tolerance Crit       1e-06 
8   Max Num Iters        100 
9   Convergence Iters    3 
10  Bootstrapping        TRUE 
11  Bootstrap samples    100 

---------------------------------------------------------- 
BLOCKS DEFINITION 

---------------------------------------------------------- 
BLOCKS UNIDIMENSIONALITY 

---------------------------------------------------------- 
OUTER MODEL 
                 weight  loading  communality  redundancy
convenience                                              
  1 convenience   1.000    1.000        1.000     0.00000
pain                                                     
  2 pain          1.000    1.000        1.000     0.00000
adoption                                                 
  3 adoption      1.000    1.000        1.000     0.38918
wtp                                                      
  4 bag           0.424    0.761        0.579     0.00521
  4 shoes         0.373    0.664        0.441     0.00397
  4 tshirt        0.504    0.725        0.525     0.00473
  4 clock         0.157    0.407        0.166     0.00149

---------------------------------------------------------- 
CROSSLOADINGS 
                 convenience     pain  adoption     wtp
convenience                                            
  1 convenience       1.0000   0.3116    0.6227  0.0881
pain                                                   
  2 pain              0.3116   1.0000    0.2303  0.0605
adoption                                               
  3 adoption          0.6227   0.2303    1.0000  0.0609
wtp                                                    
  4 bag               0.0551   0.0625    0.0287  0.7607
  4 shoes             0.0500   0.0500    0.0329  0.6641
  4 tshirt            0.0753   0.0452    0.0669  0.7246
  4 clock             0.0515  -0.0478    0.0174  0.4071

---------------------------------------------------------- 
INNER MODEL 
$adoption
              Estimate   Std. Error    t value    Pr(>|t|)
Intercept     1.11e-15       0.0144   7.76e-14    1.00e+00
convenience   6.10e-01       0.0151   4.04e+01   3.07e-284
pain          4.03e-02       0.0151   2.66e+00    7.79e-03

$wtp
              Estimate   Std. Error    t value   Pr(>|t|)
Intercept     1.23e-16       0.0183   6.73e-15    1.00000
convenience   7.20e-02       0.0240   3.00e+00    0.00269
pain          3.63e-02       0.0193   1.88e+00    0.06013
adoption      7.74e-03       0.0234   3.31e-01    0.74081

---------------------------------------------------------- 
CORRELATIONS BETWEEN LVs 
             convenience    pain  adoption     wtp
convenience       1.0000  0.3116    0.6227  0.0881
pain              0.3116  1.0000    0.2303  0.0605
adoption          0.6227  0.2303    1.0000  0.0609
wtp               0.0881  0.0605    0.0609  1.0000

---------------------------------------------------------- 
SUMMARY INNER MODEL 

---------------------------------------------------------- 
GOODNESS-OF-FIT 
[1]  0.2918

---------------------------------------------------------- 
TOTAL EFFECTS 

--------------------------------------------------------- 
BOOTSTRAP VALIDATION 
weights 

loadings 

paths 

rsq 

total.efs 

NA

library(dplyr)
data <- data %>%
     mutate( form_1 = case_when(
     form ==  1   ~ "On",
     form ==  2   ~ "On",
     form ==  3   ~ "Off",
     form ==  4   ~ "Off",
     TRUE            ~ "Off"
    ))
data$form_1 = as.factor(data$form_1)

data <- data %>%
     mutate( form_2 = case_when(
     form ==  1   ~ "SP",
     form ==  2   ~ "Card",
     form ==  3   ~ "SP",
     form ==  4   ~ "Card",
     TRUE         ~ "Card"
    ))
data$form_2 = as.factor(data$form_2)

# permutation test with 100 permutations
 form_1_perm = plspm.groups(xx, data$form_1,
                           method="permutation", reps=100)
 form_1_perm 

GROUP COMPARISON IN PLS-PM FOR PATH COEFFICIENTS 

Scale of Data:       TRUE 
Weighting Scheme:    path 
Selected method:     permutation 
Num of replicates:   100 

$test 

Inner models in the following objects: 
$global  
$group1  
$group2  

# permutation test with 100 permutations
 form_2_perm = plspm.groups(xx, data$form_2,
                           method="permutation", reps=100)
 form_2_perm 

GROUP COMPARISON IN PLS-PM FOR PATH COEFFICIENTS 

Scale of Data:       TRUE 
Weighting Scheme:    path 
Selected method:     permutation 
Num of replicates:   100 

$test 

Inner models in the following objects: 
$global  
$group1  
$group2  

# permutation test with 100 permutations
 gender_perm = plspm.groups(xx, data$gender,
                           method="permutation", reps=100)
 gender_perm

GROUP COMPARISON IN PLS-PM FOR PATH COEFFICIENTS 

Scale of Data:       TRUE 
Weighting Scheme:    path 
Selected method:     permutation 
Num of replicates:   100 

$test 

Inner models in the following objects: 
$global  
$group1  
$group2  

data <- data %>%
     mutate( Age = case_when(
     age ==  '20s'   ~ "Young",
     age ==  '30s'   ~ "Young",
     age ==  '40s'   ~ "Old",
     age ==  '50s'   ~ "Old",
     age ==  '60s'   ~ "Old",
     TRUE            ~ "Old"
    ))
data$Age = as.factor(data$Age)

# permutation test with 100 permutations  
 age_perm = plspm.groups(xx, data$Age,
                           method="permutation", reps=100)
 age_perm

GROUP COMPARISON IN PLS-PM FOR PATH COEFFICIENTS 

Scale of Data:       TRUE 
Weighting Scheme:    path 
Selected method:     permutation 
Num of replicates:   100 

$test 

Inner models in the following objects: 
$global  
$group1  
$group2  

# permutation test with 100 permutations  
 region_perm = plspm.groups(xx, data$region,
                           method="permutation", reps=100)
 region_perm

GROUP COMPARISON IN PLS-PM FOR PATH COEFFICIENTS 

Scale of Data:       TRUE 
Weighting Scheme:    path 
Selected method:     permutation 
Num of replicates:   100 

$test 

Inner models in the following objects: 
$global  
$group1  
$group2