Prepare for merge

NAMESPACE

@@ -6,9 +6,9 @@ S3method(fit,cSEMResults_multi)
 S3method(plot,cSEMIPMA)
 S3method(plot,cSEMNonlinearEffects)
 S3method(plot,cSEMPredict)
-S3method(plotModel,cSEMResults_2ndorder)
-S3method(plotModel,cSEMResults_default)
-S3method(plotModel,cSEMResults_multi)
+S3method(plot,cSEMResults_2ndorder)
+S3method(plot,cSEMResults_default)
+S3method(plot,cSEMResults_multi)
 S3method(print,cSEMAssess)
 S3method(print,cSEMNonlinearEffects)
 S3method(print,cSEMPlotPredict)
@@ -60,11 +60,10 @@ export(fit)
 export(getConstructScores)
 export(infer)
 export(parseModel)
-export(plotModel)
 export(predict)
 export(resampleData)
 export(resamplecSEMResults)
-export(saveplotModel)
+export(savePlot)
 export(summarize)
 export(testCVPAT)
 export(testHausman)

R/00_csem.R

@@ -266,6 +266,7 @@
 #'   fit measures, HTMT, R2 etc.}
 #' \item{[infer()]}{Calculate common inferential quantities, e.g., standard errors, 
 #'   confidence intervals.}
+#' \item{[plot()]}{Creates a plot of the model. For the help file see [plot.cSEMResults_default()].}  
 #' \item{[predict()]}{Predict endogenous indicator scores and compute common prediction metrics.}
 #' \item{[summarize()]}{Summarize the results. Mainly called for its side-effect the print method.}
 #' \item{[verify()]}{Verify/Check admissibility of the estimates.}
@@ -274,10 +275,11 @@
 #' Tests are performed using the test-family of functions. Currently the following
 #' tests are implemented:
 #' \describe{
+#' \item{[testCVPAT()]}{Cross-validated predictive ability test proposed by \insertCite{Liengaard2021;textual}{cSEM}}
 #' \item{[testOMF()]}{Bootstrap-based test for overall model fit based on 
-#'   \insertCite{Beran1985;textual}{cSEM}}
+#'   \insertCite{Beran1985;textual}{cSEM}.}
 #' \item{[testMICOM()]}{Permutation-based test for measurement invariance of composites
-#' proposed by \insertCite{Henseler2016;textual}{cSEM}}
+#' proposed by \insertCite{Henseler2016;textual}{cSEM}.}
 #' \item{[testMGD()]}{Several (mainly) permutation-based tests for multi-group comparisons.}
 #' \item{[testHausman()]}{Regression-based Hausman test to test for endogeneity.}
 #' }
@@ -297,7 +299,7 @@
 #'   \insertAllCited{}
 #'
 #' @seealso [args_default()], [cSEMArguments], [cSEMResults], [foreman()], [resamplecSEMResults()],
-#'   [assess()], [infer()], [predict()], [summarize()], [verify()], [testOMF()],
+#'   [assess()], [infer()], [plot.cSEMResults_default()], [predict()], [summarize()], [verify()], [testCVPAT()], [testOMF()],
 #'   [testMGD()], [testMICOM()], [testHausman()]
 #' 
 #' @example inst/examples/example_csem.R

R/plot.cSEMResult.R

@@ -0,0 +1,263 @@
+#' `cSEMResults` method for `plot()`
+#' 
+#' \lifecycle{experimental}
+#'
+#' Creates a plot of a `cSEMResults` object using the \link[DiagrammeR]{grViz} function.
+#' 
+#' @inheritParams csem_arguments
+#' 
+#' 
+#' 
+#' @seealso [save.cSEMPlot_single()] [csem()], [cSEMResults], \link[DiagrammeR]{grViz}
+#' 
+#' @example inst/examples/example_plot.cSEMResults.R
+#'
+#' 
+#' @export
+
+plot.cSEMResults_default <- function(
+    .object = NULL, 
+    .title = args_default()$.title,
+    .plot_significances = args_default()$.plot_significances, 
+    .plot_indicator_correlations = args_default()$.plot_indicator_correlations,
+    .plot_structural_model_only = args_default()$.plot_structural_model_only,
+    .graph_attrs = args_default()$.graph_attrs
+){
+
+  ## Install DiagrammeR if not already installed
+  if (!requireNamespace("DiagrammeR", quietly = TRUE)) {
+    stop2(
+      "Package `DiagrammeR` is required. Use `install.packages(\"DiagrammeR\")` and rerun.")
+  }
+
+  results <- summarize(.object)
+  constructs <- .object$Information$Model$construct_type  # named vector of construct types
+  r2_values <- results$Estimates$R2
+  weights <- as.data.frame(.object$Estimates$Weight_estimates)
+  loadings <- as.data.frame(.object$Estimates$Loading_estimates)
+  weight_p_values <- results$Estimates$Weight_estimates$p_value
+  names(weight_p_values) <- results$Estimates$Weight_estimates$Name
+  loading_p_values <- results$Estimates$Loading_estimates$p_value
+  names(loading_p_values) <- results$Estimates$Loading_estimates$Name
+  path_coefficients <- as.data.frame(.object$Estimates$Path_estimates)
+  path_p_values <- results$Estimates$Path_estimates$p_value
+  ind_corr <- list(names = results$Estimates$Indicator_correlation$Name,
+                   estimates = results$Estimates$Indicator_correlation$Estimate,
+                   p_values = results$Estimates$Indicator_correlation$p_value)
+  exo_corr <- list(names = results$Estimates$Exo_construct_correlation$Name,
+                   estimates = results$Estimates$Exo_construct_correlation$Estimate,
+                   p_values = results$Estimates$Exo_construct_correlation$p_value)
+  correlations <- list(ind = ind_corr, exo = exo_corr)
+
+  measurement_edge_fun <- function(construct) {
+    firstOrderMeasurementEdges(construct, weights, loadings, weight_p_values, loading_p_values, .plot_significances, constructs)
+  }
+
+  dot_code <- buildDotCode(title = .title,
+                           graph_attrs = .graph_attrs,
+                           constructs = constructs,
+                           r2_values = r2_values,
+                           measurement_edge_fun = measurement_edge_fun,
+                           path_coefficients = path_coefficients,
+                           path_p_values = path_p_values,
+                           correlations = correlations,
+                           plot_significances = .plot_significances,
+                           plot_indicator_correlations = .plot_indicator_correlations,
+                           plot_structural_model_only = .plot_structural_model_only,
+                           is_second_order = FALSE)
+
+  out=DiagrammeR::grViz(dot_code)
+  class(out)=c(class(out),"cSEMPlot_single")
+
+  return(out)
+}
+
+
+#' `cSEMResults` method for `plot()`
+#' 
+#' \lifecycle{experimental}
+#'
+#' Creates a plot of a `cSEMResults` object using the \link[DiagrammeR]{grViz} function.
+#' 
+#' @inheritParams csem_arguments
+#' 
+#' 
+#' @seealso [csem()], [cSEMResults], \link[DiagrammeR]{grViz}
+#' 
+#' @example inst/examples/example_plot.cSEMResults.R
+#' 
+#' @export
+
+plot.cSEMResults_multi <- function(
+    .object = NULL, 
+    .title =  args_default()$.title,
+    .plot_significances = args_default()$.plot_significances, 
+    .plot_indicator_correlations = args_default()$.plot_indicator_correlations,
+    .plot_structural_model_only = args_default()$.plot_structural_model_only,
+    .graph_attrs = args_default()$.graph_attrs
+) {
+  plots <- Map(function(group_name, group_object) {
+    group_title <- if (.title == "") paste0("Group_", group_name) else paste0(.title, " Group_", group_name)
+    plot(group_object,
+              .title = group_title,
+              .plot_significances = .plot_significances,
+              .plot_indicator_correlations = .plot_indicator_correlations,
+              .plot_structural_model_only = .plot_structural_model_only,
+              .graph_attrs = .graph_attrs)
+  }, names(.object), .object)
+
+  class(plots) <- c("cSEMPlot_multi",class(plots))
+  return(plots)
+}
+
+
+#' `cSEMResults` method for `plot()`
+#' 
+#' \lifecycle{experimental}
+#'
+#' Creates a plot of a `cSEMResults` object using the \link[DiagrammeR]{grViz} function.
+#' 
+#' @inheritParams csem_arguments
+#' 
+#' 
+#' @seealso [csem()], [cSEMResults], \link[DiagrammeR]{grViz}
+#' 
+#' @example inst/examples/example_plot.cSEMResults.R
+#' 
+#' @export
+plot.cSEMResults_2ndorder <- function(
+    .object,
+    .title = args_default()$.title,
+    .plot_significances = args_default()$.plot_significances,
+    .plot_indicator_correlations = args_default()$.plot_indicator_correlations,
+    .plot_structural_model_only = args_default()$.plot_structural_model_only,
+    .graph_attrs = args_default()$.graph_attrs
+){
+
+  # Extract first– and second–stage models and summaries.
+  fs <- .object$First_stage
+  ss <- .object$Second_stage
+  results_fs <- summarize(.object)$First_stage
+  results_ss <- summarize(.object)$Second_stage
+
+  # Merge construct types from first– and second–stage.
+  ct_first <- fs$Information$Model$construct_type
+  ct_second <- ss$Information$Model$construct_type
+  names(ct_second) <- gsub("_temp$", "", names(ct_second))
+  constructs <- c(ct_second, ct_first)
+  constructs <- constructs[!duplicated(names(constructs))]
+
+  # R2 values from second–stage (clean names).
+  r2_values <- results_ss$Estimates$R2
+  names(r2_values) <- gsub("_temp$", "", names(r2_values))
+
+  # First–stage measurement parameters.
+  weights_fs <- as.data.frame(fs$Estimates$Weight_estimates)
+  loadings_fs <- as.data.frame(fs$Estimates$Loading_estimates)
+  weight_p_fs <- results_fs$Estimates$Weight_estimates$p_value
+  names(weight_p_fs) <- results_fs$Estimates$Weight_estimates$Name
+  loading_p_fs <- results_fs$Estimates$Loading_estimates$p_value
+  names(loading_p_fs) <- results_fs$Estimates$Loading_estimates$Name
+
+  # Second–stage measurement parameters (clean row and col names).
+  weights_ss <- as.data.frame(ss$Estimates$Weight_estimates)
+  rownames(weights_ss) <- gsub("_temp$", "", rownames(weights_ss))
+  colnames(weights_ss) <- gsub("_temp$", "", colnames(weights_ss))
+  weight_p_ss <- results_ss$Estimates$Weight_estimates$p_value
+
+  # Structural model paths from second–stage.
+  path_ss <- as.data.frame(ss$Estimates$Path_estimates)
+  rownames(path_ss) <- gsub("_temp$", "", rownames(path_ss))
+  colnames(path_ss) <- gsub("_temp$", "", colnames(path_ss))
+  path_p_ss <- results_ss$Estimates$Path_estimates$p_value
+
+  # --- Structural paths: if .plot_structural_model_only is TRUE, use only second-stage edges.
+  if (.plot_structural_model_only) {
+    combined_path_coeff <- path_ss
+    combined_path_p <- path_p_ss
+  } else {
+    # Merge second-stage and non–duplicate first-stage edges.
+    path_fs <- as.data.frame(fs$Estimates$Path_estimates)
+    path_p_fs <- results_fs$Estimates$Path_estimates$p_value
+    names(path_p_fs) <- results_fs$Estimates$Path_estimates$Name
+    combined_path_coeff <- path_ss
+    combined_path_p <- path_p_ss
+    for (dependent in rownames(path_fs)) {
+      fs_paths <- path_fs[dependent, ]
+      predictors <- names(fs_paths)[which(fs_paths != 0)]
+      for (predictor in predictors) {
+        found <- FALSE
+        if (dependent %in% rownames(combined_path_coeff)) {
+          if (predictor %in% colnames(combined_path_coeff)) {
+            if (isTRUE(combined_path_coeff[dependent, predictor] != 0)) found <- TRUE
+          }
+        }
+        if (!found) {
+          combined_path_coeff[dependent, predictor] <- fs_paths[predictor]
+          path_name <- paste(dependent, "~", predictor)
+          combined_path_p[path_name] <- path_p_fs[path_name]
+        }
+      }
+    }
+  }
+  # --- End structural path merging.
+
+  # Correlations: exogenous from 2nd-stage; indicator from first-stage.
+  exo_corr <- list(names = gsub("_temp$", "", results_ss$Estimates$Exo_construct_correlation$Name),
+                   estimates = results_ss$Estimates$Exo_construct_correlation$Estimate,
+                   p_values = results_ss$Estimates$Exo_construct_correlation$p_value)
+  ind_corr <- list(names = results_fs$Estimates$Indicator_correlation$Name,
+                   estimates = results_fs$Estimates$Indicator_correlation$Estimate,
+                   p_values = results_fs$Estimates$Indicator_correlation$p_value)
+  correlations <- list(exo = exo_corr, ind = ind_corr)
+
+  # Define measurement edge function for second–order.
+  # When .plot_structural_model_only is TRUE, we set only_second_stage = TRUE so that only second-stage edges are drawn.
+  if (.plot_structural_model_only) {
+    measurement_edge_fun <- function(construct) {
+      secondOrderMeasurementEdges(construct,
+                                  weights_first = weights_fs,
+                                  loadings_first = loadings_fs,
+                                  weight_p_first = weight_p_fs,
+                                  loading_p_first = loading_p_fs,
+                                  weights_second = weights_ss,
+                                  weight_p_second = weight_p_ss,
+                                  plot_signif = .plot_significances,
+                                  constructTypes = constructs,
+                                  only_second_stage = TRUE)
+    }
+  } else {
+    measurement_edge_fun <- function(construct) {
+      secondOrderMeasurementEdges(construct,
+                                  weights_first = weights_fs,
+                                  loadings_first = loadings_fs,
+                                  weight_p_first = weight_p_fs,
+                                  loading_p_first = loading_p_fs,
+                                  weights_second = weights_ss,
+                                  weight_p_second = weight_p_ss,
+                                  plot_signif = .plot_significances,
+                                  constructTypes = constructs,
+                                  only_second_stage = FALSE)
+    }
+  }
+
+  # Build the DOT script.
+  # Pass is_second_order = TRUE so that buildDotCode always calls the measurement_edge_fun.
+  dot_code <- buildDotCode(title = .title,
+                           graph_attrs = .graph_attrs,
+                           constructs = constructs,
+                           r2_values = r2_values,
+                           measurement_edge_fun = measurement_edge_fun,
+                           path_coefficients = combined_path_coeff,
+                           path_p_values = combined_path_p,
+                           correlations = correlations,
+                           plot_significances = .plot_significances,
+                           plot_indicator_correlations = .plot_indicator_correlations,
+                           plot_structural_model_only = .plot_structural_model_only,
+                           is_second_order = TRUE)
+
+  out=DiagrammeR::grViz(dot_code)
+  class(out)=c(class(out),"cSEMPlot_single")
+
+  return(out)
+}