# Electronic Suplementary Material 1 (ESM 1)

# "Measuring non-electoral political participation: bi-factor model as a tool 
# to extract dimensions", Social Indicators Research
# Piotr Koc, Institute of Philosophy and Sociology, Polish Academy of Sciences
# e-mail: piotr.koc@yahoo.com


#########################################################################################
############################# Data preparation ##########################################
#########################################################################################
if (!require('haven')) install.packages('haven'); library('haven')
if (!require('dplyr')) install.packages('dplyr'); library('dplyr')
if (!require('rio')) install.packages('rio'); library('rio')
if (!require('tidyr')) install.packages('tidyr'); library('tidyr')

# setting up the working directory
path<-"C:/Users/Username/Desktop"
setwd(path)

# loading the data (stata format); double slash (//) is used in case the directory
# of the dataset is different than the working directory 
E <- data.frame(as_factor(read_dta("C://Users//Username//Desktop//ESS8e02_1.dta")))

# subsetting the dataset
ESS1 <- E %>%
  select(cntry, idno, contplt:pstplonl, agea) 
# removing the old dataset
remove(E)

# inspecting the frequencies and recoding the variables
sapply(ESS1[, 3:10], table, useNA = "always")
ESS_ALL <- ESS1 %>% 
  mutate_at(3:10, list(~recode(., `Yes`=1, `No`=0, .default = NA_real_))) 
sapply(ESS_ALL[, 3:10], table, useNA = "always")

# excluding interviewees below 18
ESS_ALL$agea <- as.numeric(as.character(ESS_ALL$agea))
ESS_ALL <- ESS_ALL %>%
  filter(agea >= 18)

# calculating proportions (Table 3)
cntryXform <- ESS_ALL %>%
  filter_at(vars(c(contplt:pstplonl)), all_vars(!is.na(.))) %>%
  group_by(cntry) %>%
  summarise_at(vars(c(contplt:pstplonl)), mean)
# the sample size (Table 3)
N <- ESS_ALL  %>%
  filter_at(vars(c(contplt:pstplonl)), all_vars(!is.na(.))) %>%
  group_by(cntry) %>%
  summarise(N = length(contplt))
# combaining the two together (Table 3)
 descriptives <- cbind(cntryXform, N[,2])

#saving the descriptives (proportions & sample size; Table 3)
write.csv2(descriptives, "C:/Users/Username/Desktop/Frequencies.csv")

#saving the dataset
save(ESS_ALL, file = "C:/Users/Username/Desktop/ESS_ALL.rda")

#########################################################################################
########### Extracting dimensions using eigenvalues and Kaiser-1 rule   #################
############################ Table 1  ###################################################

# creating a vector with the names of countires 
cy <- unique(ESS_ALL$cntry)

# subsetting the dataset (list-wise deletion)
ESS_SS <- ESS_ALL %>%
  filter_at(vars(contplt:pstplonl), all_vars(!is.na(.)))

# loading the psych package needed for computing polychoric correlations
if (!require('psych')) install.packages('psych'); library('psych')

# creating a loop which will extract the number of eigenvalues greater than 1 for each
# country; eigendecomposion is done for the matrix of polychoric correlations since the items
# are dichotomous; 
results <- data.frame()
for (i in 1:length(cy)){
  
  ESS_C <- ESS_SS[ESS_SS$cntry == cy[i],]
  
  matrix <- polychoric(ESS_C[,3:10])[["rho"]] 
  
  egnvls  <- eigen(matrix)[["values"]]
  
  Kaiser1 <- sum(as.numeric(egnvls > 1))
  
  result <- data.frame(Country = cy[i], Kaiser1 = Kaiser1)
  
  results <- rbind.data.frame(result, results)
  
}

# reordering the rows and saving the results
results <- results[order(results$Country, decreasing =T),]
output_directory <-paste0( path,"/", "Results" ,"/", "Kaiser",".csv")
write.csv2(results, output_directory)

#########################################################################################
#### Calculating model fit indices of the unidimensional and bidimensional model   ######
########################## Table 1  #####################################################

# subsetting the dataset (list-wise deletion)
ESS_SS <- ESS_ALL %>%
  filter_at(vars(contplt:pstplonl), all_vars(!is.na(.)))

# extracting the names of items
list <- names(ESS_ALL[,3:10])

# creating a vector with the names of countires 
cntry <- unique(ESS_ALL$cntry)

# loading the lavaan package
if (!require('lavaan')) install.packages('lavaan'); library('lavaan')

# defining the unidimensional and the bidimensional models
model_uni <- '
fak1 =~ pbldmn + badge + pstplonl + bctprd + sgnptit + wrkorg + wrkprty + contplt  
'
model_bid <- '
fak1 =~ pbldmn + badge + pstplonl + bctprd + sgnptit
fak2 =~ wrkorg + wrkprty + contplt 
'


# estimating the models and extracting the quantities of interest for each country
results <- data.frame()

for (i in 1:length(cntry)){
  
  ESS_C <- ESS_SS[ESS_SS$cntry == cntry[i],]
  
  cfa_uni <- lavaan::cfa(model_uni, ESS_C[,3:10], ordered = list, std.lv = TRUE)
  
  u_CFI <- lavaan::summary(cfa_uni, fit.measures = T, standardize = T)[["FIT"]][["cfi.scaled"]]
  u_TLI <- lavaan::summary(cfa_uni, fit.measures = T, standardize = T)[["FIT"]][["tli.scaled"]]
  u_RMSEA <- lavaan::summary(cfa_uni, fit.measures = T, standardize = T)[["FIT"]][["rmsea.scaled"]]
  u_RMSEA_90CI_L <- lavaan::summary(cfa_uni, fit.measures = T, standardize = T)[["FIT"]][["rmsea.ci.lower.scaled"]]
  u_RMSEA_90CI_U <- lavaan::summary(cfa_uni, fit.measures = T, standardize = T)[["FIT"]][["rmsea.ci.upper.scaled"]]
  u_SRMR <- lavaan::summary(cfa_uni, fit.measures = T, standardize = T)[["FIT"]][["srmr"]]
  
  cfa_bid <- lavaan::cfa(model_bid, ESS_C[,3:10], ordered = list, std.lv = TRUE)
  
  b_CFI <- lavaan::summary(cfa_bid, fit.measures = T, standardize = T)[["FIT"]][["cfi.scaled"]]
  b_TLI <- lavaan::summary(cfa_bid, fit.measures = T, standardize = T)[["FIT"]][["tli.scaled"]]
  b_RMSEA <- lavaan::summary(cfa_bid, fit.measures = T, standardize = T)[["FIT"]][["rmsea.scaled"]]
  b_RMSEA_90CI_L <- lavaan::summary(cfa_bid, fit.measures = T, standardize = T)[["FIT"]][["rmsea.ci.lower.scaled"]]
  b_RMSEA_90CI_U <- lavaan::summary(cfa_bid, fit.measures = T, standardize = T)[["FIT"]][["rmsea.ci.upper.scaled"]]
  b_SRMR <- lavaan::summary(cfa_bid, fit.measures = T, standardize = T)[["FIT"]][["srmr"]]
  
  mc <- anova(cfa_uni, cfa_bid)
  
  Chisq_Diff <- mc[2,5]
  
  Sig_Chisq_Diff <- mc[2,7]
  
  
  result <- data.frame(Country = cntry[i],  u_CFI = u_CFI, u_TLI=u_TLI, u_RMSEA=u_RMSEA, u_RMSEA_90CI_L ,
                       u_RMSEA_90CI_U, u_SRMR, b_CFI = b_CFI, b_TLI=b_TLI, b_RMSEA=b_RMSEA, b_RMSEA_90CI_L ,
                       b_RMSEA_90CI_U, b_SRMR, Chisq_Diff, Sig_Chisq_Diff)
  
  results <- rbind.data.frame(result, results)
  
}

# saving the results
results <- results[order(results$Country, decreasing =T),]
output_directory <-paste0( path,"/", "Results" ,"/", "Uni_Bid_Comp_Lavaan",".csv")
write.csv2(results, output_directory)


#########################################################################################
####        Calculating the bi-factor model and the bi-factor indices              ######
###########################   Table 2   #################################################


# subsetting the dataset (list-wise deletion)
ESS_SS <- ESS_ALL %>%
  filter_at(vars(contplt:pstplonl), all_vars(!is.na(.)))

# creating a vector with the names of countires 
cntry <- unique(ESS_SS$cntry)

# loading the mirt package 
if (!require('mirt')) install.packages('mirt'); library('mirt')

# defining the bi-factor model: first three items (measuring the institutionalized dimension
# of political participation) should load on one group factor, and the remaining five (
# measuring the non-institutionalized dimension of political participation) - on a
# different group factor. All the items load on the general factor - there is no need to
# to specify this at this stage. 

m3 <- c(rep(1,3), rep(2, 5))




# calculating the percentage of uncontaminated correlations (PUC)
nu <- ((ncol(ESS_SS[3:10]))*((ncol(ESS_SS[3:10]))-1))/2
sc <- ((3*2)+(5*4))/2
delta <- nu - sc
PUC <- delta/nu

# Estimating the bi-factor model and indices
results <- data.frame()
for (i in 1:length(cntry)){
  
  ESS_C <- ESS_SS[ESS_SS$cntry == cntry[i],]
  
  # using the bfactor function to speed up the calculations; increased number of iterations
  # to 25,000
  irt_bifak <- bfactor(ESS_C[,3:10], m3, itemtype = "2PL", 
                       technical = list(NCYCLES = 25000))
  bf <- as.data.frame(mirt::summary(irt_bifak)[["rotF"]])
  
  # calculating the ECV values for the general trait and the specific modes
  ECV_GEN <- sum(bf$G^2)/(sum(bf$G^2) + sum(bf$S1^2) + sum(bf$S2^2))
  
  ECV_S1 <- sum(bf$S1^2)/(sum(bf$G^2) + sum(bf$S1^2) + sum(bf$S2^2))
  
  ECV_S2 <- sum(bf$S2^2)/(sum(bf$G^2) + sum(bf$S1^2) + sum(bf$S2^2))
  
  # unique variance
  uniqvar <- sum(1- (bf$G^2 + bf$S1^2 + bf$S2^2))
  
  # sum of factor loadings 
  sumfacload <- (sum(bf$G))^2 + (sum(bf$S1))^2 + (sum(bf$S2))^2
  
  # omega coefficient for all the items
  omega <- sumfacload/(sumfacload+uniqvar)
  
  # omegaH
  omegaH <- (sum(bf$G))^2/(sumfacload+uniqvar)
  
  # ratio of omegaH to omega
  omegaHR <- omegaH/omega
  
  # omega for each dimension of political participation
  omegaS1 <- ((sum(bf$S1))^2 + (sum(bf$G[1:3]))^2)/((sum(bf$S1))^2 + (sum(bf$G[1:3]))^2 + 
                                                      sum((1- (bf$G^2 + bf$S1^2 + bf$S2^2))[1:3]))
  omegaS2 <- ((sum(bf$S2))^2 + (sum(bf$G[4:8]))^2)/((sum(bf$S2))^2 + (sum(bf$G[4:8]))^2 + 
                                                      sum((1- (bf$G^2 + bf$S1^2 + bf$S2^2))[4:8]))
  
  # omega subscale for each dimension 
  omegaSS1 <- (sum(bf$S1))^2 /((sum(bf$S1))^2 + (sum(bf$G[1:3]))^2 + 
                                 sum((1- (bf$G^2 + bf$S1^2 + bf$S2^2))[1:3]))
  omegaSS2 <- (sum(bf$S2))^2 /((sum(bf$S2))^2 + (sum(bf$G[4:8]))^2 + 
                                 sum((1- (bf$G^2 + bf$S1^2 + bf$S2^2))[4:8]))
 
  # ratios of omega subscale to omega for each dimension
  omegaSS1R <- omegaSS1/omegaS1
  omegaSS2R <- omegaSS2/omegaS2
  
  # H-index for each factor
  H_Gen <-  1/(1+(1/(sum(bf$G^2/(1-bf$G^2)))))
  H_I <-  1/(1+(1/(sum(bf$S1^2/(1-bf$S1^2)))))
  H_IN <-  1/(1+(1/(sum(bf$S2^2/(1-bf$S2^2)))))
  
  # convergence check
  test <- extract.mirt(irt_bifak, what="converged")
  
  
  result <- data.frame(Country = cntry[i], ECV_GEN = ECV_GEN, ECV_S1 = ECV_S1, ECV_S2 = ECV_S2,
                       omegaHR = omegaHR,  
                       omegaSS1R = omegaSS1R, omegaSS2R=omegaSS2R,
                       H_Gen = H_Gen, H_I = H_I, H_IN = H_IN,
                       Convergence = test)
  
  results <- rbind.data.frame(result, results)
  
}
# saving the results
output_directory <-paste0( path,"/", "Results" ,"/", "IFA_results_mirt",".csv")
write.csv2(results, output_directory)

