This PR is for reporting bootstrapping results

CHANGELOG.md

@@ -14,6 +14,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 - A new feature for automated calculation of HOC
 - A new feature for two-stage calculation of interactions
 - A file for all references and citations
+- A return object in summary(boot_seminr_model) containing boot mean, SD, tvalue, and CIs for bootstrapped paths, loadings, weights and HTMT, 
+- A test for the bootstrap summary return object
 - Descriptive statistics for item and construct data
 - S3 print method for class "table_output" for printing generic tables
 

R/library.R

@@ -258,6 +258,16 @@ measure_interaction <- function(intxn) {
   }
 }
 
+conf_int <- function(boot_array, from, to, through = NULL, alpha = 0.05) {
+  if (is.null(through)) {
+    coefficient <- boot_array[from, to,]
+  } else {
+    coefficient <- boot_array[from, through,] * boot_array[through, to,]
+  }
+  quantiles <- stats::quantile(coefficient, probs = c(alpha/2,1-(alpha/2)))
+  return(quantiles)
+}
+
 kurt <- function(x, na.rm = FALSE) {
    if (!is.vector(x))
      apply(x, 2, kurt, na.rm = na.rm)

R/report_paths_and_intervals.R

@@ -71,9 +71,9 @@ report_paths <- function(seminr_model, digits=3) {
   final_paths
 }
 
-report_bootstrapped_paths <- function(seminr_model, na.print=".", digits=3) {
-  bootstrapresults <- seminr_model$bootstrapMatrix
-  nboots <- seminr_model$boots
+report_bootstrapped_paths <- function(boot_seminr_model, na.print=".", digits=3) {
+  bootstrapresults <- seminr_model$
+  nboots <- boot_seminr_model$boots
   bootstraplist <- list()
   j <- ncol(bootstrapresults)/3
   k <- j+1
@@ -168,3 +168,33 @@ confidence_interval <- function(boot_seminr_model, from, to, through = NULL, alp
   quantiles <- stats::quantile(coefficient, probs = c(alpha/2,1-(alpha/2)))
   return(quantiles)
 }
+
+parse_boot_array <- function(original_matrix, boot_array, alpha = 0.05) {
+  Path <- c()
+  original <- c()
+  boot_mean <- c()
+  boot_SD <- c()
+  t_stat <- c()
+  lower <- c()
+  upper <- c()
+  alpha_text <- alpha/2*100
+  original_matrix[is.na(original_matrix)] <- 0
+  for (i in 1:nrow(original_matrix)) {
+    for (j in 1:ncol(original_matrix)) {
+      if (original_matrix[i,j]!=0 ) {
+        Path <- append(Path, paste(rownames(original_matrix)[i], " -> ", colnames(original_matrix)[j]))
+        original <- append(original, original_matrix[i,j])
+        boot_mean <- append(boot_mean, mean(boot_array[i,j,]))
+        boot_SD <- append(boot_SD, stats::sd(boot_array[i,j,]))
+        t_stat <- append(t_stat,  original_matrix[i,j]/ stats::sd(boot_array[i,j,]))
+        lower <- append(lower, (conf_int(boot_array, from = rownames(original_matrix)[i], to = colnames(original_matrix)[j], alpha = alpha))[[1]])
+        upper <- append(upper, (conf_int(boot_array, from = rownames(original_matrix)[i], to = colnames(original_matrix)[j], alpha = alpha))[[2]])
+      }
+    }
+  }
+  return_matrix <- cbind(original, boot_mean, boot_SD, t_stat, lower, upper)
+  colnames(return_matrix) <- c( "Original Est.", "Bootstrap Mean", "Bootstrap SD", "T Stat.",paste(alpha_text, "% CI", sep = ""),paste((100-alpha_text), "% CI", sep = ""))
+  rownames(return_matrix) <- Path
+  class(return_matrix) <- append(class(return_matrix), "table_output")
+  return(return_matrix)
+}

R/report_summary.R

@@ -39,28 +39,25 @@ print.summary.seminr_model <- function(x, na.print=".", digits=3, ...) {
 
 # Summary for bootstrapped seminr model
 #' @export
-summary.boot_seminr_model <- function(object, ...) {
+summary.boot_seminr_model <- function(object, alpha = 0.05, ...) {
   stopifnot(inherits(object, "boot_seminr_model"))
   boot_matrix <- object$paths_descriptives
   n <- nrow(object$data)
 
-  # REFACTOR: Extract endogenous column names, means, and SEs from boot_matrix
-  num_endogenous <- ncol(boot_matrix) / 3
-  column_names <- colnames(boot_matrix)[1:num_endogenous]
-  endogenous_names <- as.vector(substr(column_names, 1, nchar(column_names)-nchar(" PLS Est.")))
-  boot_mean <- as.matrix(boot_matrix[, c((1*num_endogenous+1):(2*num_endogenous))])
-  boot_SE   <- as.matrix(boot_matrix[, c((2*num_endogenous+1):(3*num_endogenous))])
+  # bootstrapped direct paths
+  paths_summary <- parse_boot_array(object$path_coef, object$boot_paths, alpha = alpha)
+  # bootstrapped weights
+  weights_summary <- parse_boot_array(object$outer_weights, object$boot_weights, alpha = alpha)
+  # bootstrapped loadings
+  loadings_summary <- parse_boot_array(object$outer_loadings, object$boot_loadings, alpha = alpha)
+  # bootstrapped HTMT
+  htmt_summary <- parse_boot_array(HTMT(object), object$boot_HTMT, alpha = alpha)
 
-  # calculate t-values and two-tailed p-values; 0 paths become NaN
-  boot_t <- abs(boot_mean / boot_SE)
-  boot_p <- 2*stats::pt(boot_t, df = object$boots-1, lower.tail = FALSE)
-
-  colnames(boot_t) <- endogenous_names
-  colnames(boot_p) <- endogenous_names
-  boot_t[is.nan(boot_t)] <- NA
-  boot_p[is.nan(boot_p)] <- NA
-
-  boot_summary <- list(nboot = object$boots, t_values = boot_t, p_values = boot_p)
+  boot_summary <- list(nboot = object$boots,
+                       bootstrapped_paths = paths_summary,
+                       bootstrapped_weights = weights_summary,
+                       bootstrapped_loadings = loadings_summary,
+                       bootstrapped_HTMT = htmt_summary)
   class(boot_summary) <- "summary.boot_seminr_model"
   boot_summary
 }
@@ -74,13 +71,19 @@ print_matrix <- function(pmatrix, na.print=".", digits=3) {
 # Print for summary of bootstrapped seminr model
 #' @export
 print.summary.boot_seminr_model <- function(x, na.print=".", digits=3, ...) {
-  cat("\n", sprintf("Bootstrapped resamples: %s", x$nboot))
+  cat("\n", sprintf("Bootstrap resamples: %s", x$nboot))
+
+  cat("\n\nBootstrapped Structural Paths:\n")
+  print_matrix(x$bootstrapped_paths[,c(1,2,3,4,5,6)], na.print, digits)
+
+  cat("\nBootstrapped Weights:\n")
+  print_matrix(x$bootstrapped_weights[,c(1,2,3,4,5,6)], na.print, digits)
 
-  cat("\n\nStructural Path t-values:\n")
-  print_matrix(x$t_values, na.print, digits)
+  cat("\nBootstrapped Loadings:\n")
+  print_matrix(x$bootstrapped_loadings[,c(1,2,3,4,5,6)], na.print, digits)
 
-  cat("\nStructural Path p-values:\n")
-  print_matrix(x$p_values, na.print, digits)
+  cat("\nBootstrapped HTMT:\n")
+  print_matrix(x$bootstrapped_HTMT[,c(1,2,3,5,6)], na.print, digits)
 
   cat("\n")
   invisible(x)

tests/fixtures/V_3_5_X/boot_report_htmt.csv

@@ -0,0 +1,7 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"Image  ->  Expectation",0.88803042750925,0.903763533939115,0.113237020996731,7.8422270357579,0.695644278671879,1.13136995716998
+"Image  ->  Value",0.651659392487802,0.656767668965328,0.0715412552586562,9.10886159505783,0.49651911575411,0.78109097134066
+"Image  ->  Satisfaction",0.910100923782741,0.911894262698361,0.0357324808027179,25.4698499331039,0.835660831767158,0.974030606854113
+"Expectation  ->  Value",0.588628982316289,0.602469101793313,0.119544003750428,4.92395238447232,0.385795503501754,0.846058850354921
+"Expectation  ->  Satisfaction",0.865108193553153,0.874508973894666,0.0977494522419293,8.85026129263636,0.688397792048741,1.0818978036812
+"Value  ->  Satisfaction",0.740808927759395,0.749514286741443,0.0726897591783579,10.1913795854197,0.585713450823247,0.874067897012301

tests/fixtures/V_3_5_X/boot_report_loadings.csv

@@ -0,0 +1,14 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"IMAG1  ->  Image",0.763199100938388,0.760566891183999,0.0332331007928875,22.9650283220555,0.69210001505751,0.817931549483672
+"IMAG2  ->  Image",0.598825742061012,0.59946066744219,0.056760046008164,10.550127848291,0.483885257088059,0.693252575867056
+"IMAG3  ->  Image",0.561373435201573,0.558496757880991,0.0652281499928016,8.60630625371906,0.420107203814631,0.672753707403284
+"IMAG4  ->  Image",0.76917060820122,0.770222298607795,0.0437173999655483,17.5941526441959,0.679375718970625,0.837503778288184
+"IMAG5  ->  Image",0.73625435746935,0.73524775871036,0.035162597236367,20.938565843705,0.655258951885249,0.797947607082986
+"CUEX1  ->  Expectation",0.76152466539557,0.756921221239139,0.0568328889345541,13.3993657488097,0.620972876073113,0.838373579337657
+"CUEX2  ->  Expectation",0.710214472518844,0.701152999544215,0.0857824229859703,8.27925404526053,0.505693869964122,0.840089802010062
+"CUEX3  ->  Expectation",0.597659373657607,0.596039049294156,0.0802783617674163,7.444837693489,0.429291116857192,0.732671810501814
+"PERV1  ->  Value",0.901400554962627,0.899260335870302,0.0214304246076163,42.0617216628677,0.853778582389032,0.936273857069465
+"PERV2  ->  Value",0.940265063862509,0.940244684597881,0.00728822526175798,129.011526138767,0.925265977989535,0.953075462975145
+"CUSA1  ->  Satisfaction",0.804053676874834,0.802316037830407,0.0299787614633406,26.8207770310347,0.733950426259512,0.852522687198918
+"CUSA2  ->  Satisfaction",0.842878555812946,0.842449556137943,0.0244807593599892,34.4302455417509,0.791360493199126,0.881565604101984
+"CUSA3  ->  Satisfaction",0.850379560919916,0.849834787539673,0.0194057887560021,43.8209222831459,0.801730191542965,0.881744288950928

tests/fixtures/V_3_5_X/boot_report_paths.csv

@@ -0,0 +1,4 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"Image  ->  Satisfaction",0.447003896753383,0.448951169085565,0.0594358770197897,7.52077565212926,0.339992717182445,0.56099444605743
+"Expectation  ->  Satisfaction",0.171830104491587,0.168593203505039,0.0634852873636992,2.70661300636782,0.0567534183820042,0.292193391618314
+"Value  ->  Satisfaction",0.316425319256028,0.320455830182269,0.0713285632056388,4.43616561213745,0.181926856905005,0.463104286046052

tests/fixtures/V_3_5_X/boot_report_weights

@@ -0,0 +1,14 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"IMAG1  ->  Image",0.331565496837403,0.330724945994358,0.0237139978147838,13.9818473218673,0.28945377592744,0.377400490279072
+"IMAG2  ->  Image",0.253381407777625,0.254218052294043,0.0319933983676613,7.9198028563837,0.193181207712981,0.319478784515802
+"IMAG3  ->  Image",0.19957423850573,0.197244576390276,0.0347898419297301,5.73656640662057,0.12705048423279,0.265947173739739
+"IMAG4  ->  Image",0.330983162965217,0.330821421495373,0.0289826090909301,11.4200609726609,0.276180414322223,0.400415724148075
+"IMAG5  ->  Image",0.310490528776397,0.309278978158059,0.0270542256066421,11.4766001175125,0.257340155886892,0.36224609054251
+"CUEX1  ->  Expectation",0.505837721216892,0.504190083636178,0.0582573797858959,8.68280933807729,0.382594673843755,0.620908907968337
+"CUEX2  ->  Expectation",0.49867124599148,0.495751671958743,0.0784250923466108,6.35856753330339,0.330831377749945,0.645412461145209
+"CUEX3  ->  Expectation",0.43608211325906,0.433478710390776,0.0750752362693077,5.80860127692118,0.283142401601135,0.579603124296798
+"PERV1  ->  Value",0.476812933927711,0.476437745991487,0.022821121635596,20.8934925084482,0.428190851464622,0.518336991839968
+"PERV2  ->  Value",0.60642533542816,0.60752033774143,0.0296605585319265,20.4455130126901,0.548127244130507,0.668912128123537
+"CUSA1  ->  Satisfaction",0.387272947521168,0.386130889737434,0.0196189495350074,19.7397392164209,0.347553541879076,0.424184904956049
+"CUSA2  ->  Satisfaction",0.373939896289369,0.375967909006956,0.0179841941887859,20.792696762724,0.342289419112303,0.411896917658497
+"CUSA3  ->  Satisfaction",0.439128431593844,0.43883424037469,0.022969906544697,19.1175541241035,0.400410139703778,0.487478284940975

tests/fixtures/V_3_6_0/boot_report_htmt.csv

@@ -0,0 +1,7 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"Image  ->  Expectation",0.88803042750925,0.900979407267204,0.104358945220271,8.50938485086145,0.71614999993462,1.12115196099408
+"Image  ->  Value",0.651659392487802,0.652992095381172,0.0701022147560394,9.2958459979563,0.502793794265395,0.782724775662622
+"Image  ->  Satisfaction",0.910100923782741,0.910585205382836,0.0348292315180538,26.1303762418929,0.84384466053941,0.981660013666325
+"Expectation  ->  Value",0.588628982316289,0.594137955677674,0.118754444897233,4.95669010811067,0.380678333468043,0.839796564761663
+"Expectation  ->  Satisfaction",0.865108193553153,0.870606979504858,0.0955774496723796,9.05138394588442,0.702993738546453,1.0830568786467
+"Value  ->  Satisfaction",0.740808927759395,0.740043625782101,0.0746714861275302,9.92090778124034,0.585351069227359,0.874727270726421

tests/fixtures/V_3_6_0/boot_report_loadings.csv

@@ -0,0 +1,14 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"IMAG1  ->  Image",0.763199100938388,0.758905965275604,0.0357880555932124,21.3255257456105,0.678193113236361,0.821261082102688
+"IMAG2  ->  Image",0.598825742061012,0.597969147064729,0.0589618044952215,10.1561637603806,0.471919660460888,0.70252033725858
+"IMAG3  ->  Image",0.561373435201573,0.555944095412828,0.0627942979003474,8.93987916056416,0.412657752595117,0.668077545806821
+"IMAG4  ->  Image",0.76917060820122,0.767988409507916,0.0459178590839776,16.7510119928394,0.669699401930144,0.846613483299382
+"IMAG5  ->  Image",0.73625435746935,0.739189736927558,0.0327384820829588,22.4889582725214,0.67337139320005,0.797194679051417
+"CUEX1  ->  Expectation",0.76152466539557,0.757827028390345,0.0583188637607411,13.057947571129,0.629257492218864,0.843027874485391
+"CUEX2  ->  Expectation",0.710214472518844,0.698452101014081,0.0854270875652831,8.31369174298609,0.510512321588768,0.846581589842127
+"CUEX3  ->  Expectation",0.597659373657607,0.59889262461522,0.0796201195498212,7.50638628825004,0.438537564763175,0.725939494126062
+"PERV1  ->  Value",0.901400554962627,0.900315629743086,0.0206776588260606,43.5929697140842,0.85202229919693,0.933602662599488
+"PERV2  ->  Value",0.940265063862509,0.94060048916446,0.00763419073055759,123.164995092261,0.924338193533042,0.953274759548268
+"CUSA1  ->  Satisfaction",0.804053676874834,0.802595444228567,0.0297104392959106,27.0630019592307,0.736589079152987,0.849041406057884
+"CUSA2  ->  Satisfaction",0.842878555812946,0.843233366219225,0.0229483093290721,36.7294402270037,0.792325423041941,0.884398857344249
+"CUSA3  ->  Satisfaction",0.850379560919916,0.85094982077905,0.0188456147139225,45.1234716313969,0.81137337922541,0.884381365854845

tests/fixtures/V_3_6_0/boot_report_paths.csv

@@ -0,0 +1,4 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"Image  ->  Satisfaction",0.447003896753383,0.45127621370901,0.0572238862848615,7.81149142035181,0.339811279111052,0.56395415385025
+"Expectation  ->  Satisfaction",0.171830104491587,0.169990070887359,0.0623038910786675,2.75793536353334,0.0489936437832836,0.283511734169091
+"Value  ->  Satisfaction",0.316425319256028,0.314688008062073,0.0741495960314683,4.26739100671216,0.166813752689476,0.457482672463782

tests/fixtures/V_3_6_0/boot_report_weights

@@ -0,0 +1,14 @@
+"","Original Est.","Bootstrap Mean","Bootstrap SD","T Stat.","2.5% CI","97.5% CI"
+"IMAG1  ->  Image",0.331565496837403,0.329884381739061,0.0244820961721063,13.5431825161757,0.287732166344617,0.377251329426638
+"IMAG2  ->  Image",0.253381407777625,0.255194735124052,0.0312390577319581,8.111045152249,0.195126558248835,0.313892537124646
+"IMAG3  ->  Image",0.19957423850573,0.197678882397733,0.0357810684765989,5.57764893567259,0.126257972981921,0.262679052471791
+"IMAG4  ->  Image",0.330983162965217,0.32981283631994,0.0275176396737316,12.0280360848381,0.280763449153631,0.391222489257726
+"IMAG5  ->  Image",0.310490528776397,0.311118220145151,0.0274697309598026,11.303005815046,0.26428652002383,0.371517721644111
+"CUEX1  ->  Expectation",0.505837721216892,0.503827105984516,0.0644089314459357,7.85353381683545,0.381814879254952,0.626787798539578
+"CUEX2  ->  Expectation",0.49867124599148,0.491549074473864,0.0781628515018365,6.37990089166288,0.341533640518279,0.645085691953323
+"CUEX3  ->  Expectation",0.43608211325906,0.437550701630344,0.073653848117595,5.9206969412218,0.296755231267694,0.58349129026235
+"PERV1  ->  Value",0.476812933927711,0.476345140758372,0.0232874068242128,20.4751408143886,0.422729633983159,0.516853457109176
+"PERV2  ->  Value",0.60642533542816,0.60683968063961,0.0288290238741121,21.0352365059685,0.557001307622655,0.671394139061667
+"CUSA1  ->  Satisfaction",0.387272947521168,0.386296716237279,0.0199157712476426,19.4455410591749,0.347970649766012,0.425316056210862
+"CUSA2  ->  Satisfaction",0.373939896289369,0.375314996244238,0.0186711222872375,20.0277139497379,0.339868943784373,0.412747290210002
+"CUSA3  ->  Satisfaction",0.439128431593844,0.438216647508833,0.0227888505475847,19.2694418999727,0.396074154367775,0.483627018246555

tests/testthat/test-summary.R

@@ -72,27 +72,42 @@ boot_seminr_model <- bootstrap_model(seminr_model, nboot = 500,cores = 2, seed =
 summary_object <- summary(boot_seminr_model)
 
 # Load outputs
-t_values <- summary_object$t_values
-p_values <- summary_object$p_values
+paths <- summary_object$bootstrapped_paths
+loadings <- summary_object$bootstrapped_loadings
+weights <- summary_object$bootstrapped_weights
+htmt <- summary_object$bootstrapped_HTMT
 
 ## Output originally created using following lines
-# write.csv(summary_object$t_values, file = "tests/fixtures/V_3_5_X/tvalues.csv")       # V3.5.X
-# write.csv(summary_object$p_values, file = "tests/fixtures/V_3_5_X/pvalues.csv")       # V3.5.X
-# write.csv(summary_object$t_values, file = "tests/fixtures/V_3_6_0/tvalues.csv")       # V3.6.0
-# write.csv(summary_object$p_values, file = "tests/fixtures/V_3_6_0/pvalues.csv")       # V3.6.0
+# write.csv(summary_object$bootstrapped_paths, file = "tests/fixtures/V_3_6_0/boot_report_paths.csv")
+# write.csv(summary_object$bootstrapped_loadings, file = "tests/fixtures/V_3_6_0/boot_report_loadings.csv")
+# write.csv(summary_object$bootstrapped_weights, file = "tests/fixtures/V_3_6_0/boot_report_weights")
+# write.csv(summary_object$bootstrapped_HTMT, file = "tests/fixtures/V_3_5_X/boot_report_htmt.csv")
+# write.csv(summary_object$bootstrapped_paths, file = "tests/fixtures/V_3_5_X/boot_report_paths.csv")
+# write.csv(summary_object$bootstrapped_loadings, file = "tests/fixtures/V_3_5_X/boot_report_loadings.csv")
+# write.csv(summary_object$bootstrapped_weights, file = "tests/fixtures/V_3_5_X/boot_report_weights")
+# write.csv(summary_object$bootstrapped_HTMT, file = "tests/fixtures/V_3_5_X/boot_report_htmt.csv")
 
 # Load controls
-t_values_control <- as.matrix(read.csv(file = paste(test_folder,"tvalues.csv", sep = ""), row.names = 1))
-p_values_control <- as.matrix(read.csv(file = paste(test_folder,"pvalues.csv", sep = ""), row.names = 1))
-
+paths_control <- as.matrix(read.csv(file = paste(test_folder,"boot_report_paths.csv", sep = ""), row.names = 1))
+loadings_control <- as.matrix(read.csv(file = paste(test_folder,"boot_report_loadings.csv", sep = ""), row.names = 1))
+weights_control <- as.matrix(read.csv(file = paste(test_folder,"boot_report_weights", sep = ""), row.names = 1))
+htmt_control <- as.matrix(read.csv(file = paste(test_folder,"boot_report_htmt.csv", sep = ""), row.names = 1))
 # Testing
 
-test_that("Seminr estimates the t-values correctly", {
-  expect_equal(t_values, t_values_control, tolerance = 0.00001)
+test_that("Seminr summarizes the bootstrapped paths correctly", {
+  expect_equal(as.vector(paths[1, 1:6]), as.vector(paths_control[1, 1:6]), tolerance = 0.00001)
+})
+
+test_that("Seminr summarizes the bootstrapped loadings correctly", {
+  expect_equal(as.vector(loadings[1, 1:6]), as.vector(loadings_control[1, 1:6]), tolerance = 0.00001)
+})
+
+test_that("Seminr summarizes the bootstrapped weights correctly", {
+  expect_equal(as.vector(weights[1, 1:6]), as.vector(weights_control[1, 1:6]), tolerance = 0.00001)
 })
 
-test_that("Seminr estimates the p-values correctly", {
-  expect_equal(p_values, p_values_control, tolerance = 0.00001)
+test_that("Seminr summarizes the bootstrapped htmt correctly", {
+  expect_equal(as.vector(htmt[1, 1:6]), as.vector(htmt_control[1, 1:6]), tolerance = 0.00001)
 })
 
 context("SEMinR:::evaluate_measurement_model() correctly evaluates FACTORS for class seminr_model\n")