Skip to content

Commit

Permalink
Update plot function
Browse files Browse the repository at this point in the history
  • Loading branch information
@FloSchuberth
FloSchuberth committed Feb 17, 2025
1 parent 384d9fc commit a25a305
Show file tree
Hide file tree
Showing 13 changed files with 612 additions and 342 deletions.
513 changes: 359 additions & 154 deletions R/helper_plot.cSEMResults.R
View file

Large diffs are not rendered by default.

191 changes: 88 additions & 103 deletions R/plot.cSEMResult.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,26 +7,24 @@
#' @inheritParams csem_arguments
#' @param x An R object of class `cSEMResults_default` object.
#' @param ... Currently ignored.
#'
#' @param .plot_labels Logical. Whether to display edge labels and R² values in the nodes.
#' Defaults to TRUE (i.e. original plot).
#'
#' @seealso [savePlot()] [csem()], [cSEMResults], \link[DiagrammeR]{grViz}
#'
#' @example inst/examples/example_plot.cSEMResults.R
#'
#'
#' @export

plot.cSEMResults_default <- function(
x = NULL,
.title = args_default()$.title,
.plot_significances = args_default()$.plot_significances,
.plot_correlations = args_default()$.plot_correlations,
.plot_structural_model_only = args_default()$.plot_structural_model_only,
.plot_labels = args_default()$.plot_labels,
.graph_attrs = args_default()$.graph_attrs,
...
){

## Install DiagrammeR if not already installed
## Install DiagrammeR if not already installed
if (!requireNamespace("DiagrammeR", quietly = TRUE)) {
stop2(
"Package `DiagrammeR` is required. Use `install.packages(\"DiagrammeR\")` and rerun.")
Expand All @@ -52,7 +50,7 @@ plot.cSEMResults_default <- function(
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)
firstOrderMeasurementEdges(construct, weights, loadings, weight_p_values, loading_p_values, .plot_significances, constructs, plot_labels = .plot_labels)
}

dot_code <- buildDotCode(title = .title,
Expand All @@ -64,18 +62,21 @@ plot.cSEMResults_default <- function(
path_p_values = path_p_values,
correlations = correlations,
plot_significances = .plot_significances,
plot_indicator_correlations = .plot_correlations,
plot_correlations = .plot_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")

is_second_order = FALSE,
model_measurement = x$Information$Model$measurement,
model_error_cor = x$Information$Model$error_cor,
construct_correlations = x$Estimates$Construct_VCV,
indicator_correlations = x$Estimates$Indicator_VCV,
plot_labels = .plot_labels)

out <- DiagrammeR::grViz(dot_code)
class(out) <- c(class(out), "cSEMPlot_single")
return(out)
}


#' `cSEMResults` method for `plot()`
#' `cSEMResults` method for `plot()` for multiple groups.
#'
#' \lifecycle{experimental}
#'
Expand All @@ -84,75 +85,79 @@ plot.cSEMResults_default <- function(
#' @inheritParams csem_arguments
#' @param x An R object of class `cSEMResults_multi` object.
#' @param ... Currently ignored.
#'
#' @param .plot_labels Logical. Whether to display edge labels and node R² values. Defaults to TRUE.
#' @seealso [csem()], [cSEMResults], \link[DiagrammeR]{grViz}
#'
#' @example inst/examples/example_plot.cSEMResults.R
#'
#' @export

plot.cSEMResults_multi <- function(
x = NULL,
.title = args_default()$.title,
.plot_significances = args_default()$.plot_significances,
.plot_correlations = args_default()$.plot_correlations,
.plot_structural_model_only = args_default()$.plot_structural_model_only,
.plot_labels = args_default()$.plot_labels,
.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_correlations = .plot_correlations,
.plot_structural_model_only = .plot_structural_model_only,
.graph_attrs = .graph_attrs)
.title = group_title,
.plot_significances = .plot_significances,
.plot_correlations = .plot_correlations,
.plot_structural_model_only = .plot_structural_model_only,
.plot_labels = .plot_labels,
.graph_attrs = .graph_attrs)
}, names(x), x)

class(plots) <- c("cSEMPlot_multi",class(plots))
class(plots) <- c("cSEMPlot_multi", class(plots))
return(plots)
}


#' `cSEMResults` method for `plot()`
#'
#' `cSEMResults` method for `plot()` for second-order models.
#'
#' \lifecycle{experimental}
#'
#' Creates a plot of a `cSEMResults` object using the \link[DiagrammeR]{grViz} function.
#' Creates a plot of a `cSEMResults_2ndorder` object using the \link[DiagrammeR]{grViz} function.
#'
#' @inheritParams csem_arguments
#' @param x An R object of class `cSEMResults_2ndorder` object.
#' @param ... Currently ignored.
#'
#' @param .plot_labels Logical. Whether to display edge labels and node R² values. Defaults to TRUE.
#' @seealso [csem()], [cSEMResults], \link[DiagrammeR]{grViz}
#'
#' @example inst/examples/example_plot.cSEMResults.R
#'
#' @export
plot.cSEMResults_2ndorder <- function(
x,
.title = args_default()$.title,
.plot_significances = args_default()$.plot_significances,
.plot_correlations = args_default()$.plot_correlations,
.plot_structural_model_only = args_default()$.plot_structural_model_only,
.plot_labels = args_default()$.plot_labels,
.graph_attrs = args_default()$.graph_attrs,
...
){

if (!requireNamespace("DiagrammeR", quietly = TRUE)) {
stop2("Package `DiagrammeR` is required. Use `install.packages(\"DiagrammeR\")` and rerun.")
}
# Extract first– and second–stage models and summaries.
results <- summarize(x)
results_fs <- results$First_stage
results_ss <- results$Second_stage

fs <- x$First_stage
ss <- x$Second_stage
results_fs <- summarize(x)$First_stage
results_ss <- summarize(x)$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))
ct2_names <- names(ct_second)
constructs <- c(ct_second, ct_first)
constructs <- constructs[!duplicated(names(constructs))]

if (.plot_structural_model_only && !(.plot_correlations %in% c("indvcv", "exoind"))) {
constructs <- ct_second
}

# R2 values from second–stage (clean names).
r2_values <- results_ss$Estimates$R2
names(r2_values) <- gsub("_temp$", "", names(r2_values))
Expand All @@ -165,50 +170,27 @@ plot.cSEMResults_2ndorder <- function(
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).
# 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

loadings_ss <- as.data.frame(ss$Estimates$Loading_estimates)
rownames(loadings_ss) <- gsub("_temp$", "", rownames(loadings_ss))
colnames(loadings_ss) <- gsub("_temp$", "", colnames(loadings_ss))
loading_p_ss <- results_ss$Estimates$Loading_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
names(path_p_ss) <- results_ss$Estimates$Path_estimates$Name

# --- 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.
combined_path_coeff <- path_ss
combined_path_p <- path_p_ss

# 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)
Expand All @@ -217,38 +199,37 @@ plot.cSEMResults_2ndorder <- function(
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)
# Only skip measurement edges when no indicator correlations should be added.
measurement_edge_fun <- function(construct) {
if (.plot_structural_model_only && !(.plot_correlations %in% c("indvcv", "exoind"))) return("")
if (construct %in% ct2_names) {
return(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,
loadings_second = loadings_ss,
weight_p_second = weight_p_ss,
loading_p_second = loading_p_ss,
plot_signif = .plot_significances,
plot_labels = .plot_labels,
constructTypes = constructs,
only_second_stage = FALSE))
} else {
return(firstOrderMeasurementEdges(construct,
weights = weights_fs,
loadings = loadings_fs,
weight_p_values = weight_p_fs,
loading_p_values = loading_p_fs,
plot_signif = .plot_significances,
plot_labels = .plot_labels,
constructTypes = constructs))
}
}

# Build the DOT script.
# Pass is_second_order = TRUE so that buildDotCode always calls the measurement_edge_fun.
# 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,
Expand All @@ -258,12 +239,16 @@ plot.cSEMResults_2ndorder <- function(
path_p_values = combined_path_p,
correlations = correlations,
plot_significances = .plot_significances,
plot_indicator_correlations = .plot_correlations,
plot_correlations = .plot_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")

plot_labels = .plot_labels,
is_second_order = TRUE,
model_measurement = x$First_stage$Information$Model$measurement,
model_error_cor = x$First_stage$Information$Model$error_cor,
construct_correlations = results_fs$Estimates$Construct_VCV,
indicator_correlations = fs$Estimates$Indicator_VCV)

out <- DiagrammeR::grViz(dot_code)
class(out) <- c(class(out), "cSEMPlot_single")
return(out)
}
12 changes: 8 additions & 4 deletions R/zz_arguments.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -142,7 +142,7 @@
#' @param .full_output Logical. Should the full output of summarize be printed.
#' Defaults to `TRUE`.
#' @param .graph_attrs Character String. Additional attributes that should be passed
#' to the DiagrammeR syntax, e.g., c("rankdir=LR", "ranksep=1.0"). Defaults to *c("rankdir=LR","fixedsize=true)*.
#' to the DiagrammeR syntax, e.g., c("rankdir=LR", "ranksep=1.0"). Defaults to *c("rankdir=LR")*.
#' @param .H The (N x J) matrix of construct scores.
#' @param .handle_inadmissibles Character string. How should inadmissible results
#' be treated? One of "*drop*", "*ignore*", or "*replace*". If "*drop*", all
Expand Down Expand Up @@ -225,7 +225,10 @@
#' "*geo_of_harmonic*". Defaults to "*dist_squared_euclid*".
#' Ignored if `.disattenuate = FALSE` or if `.approach_weights` is not PLS-PM.
#' @param .plot_correlations Character string. Specify which correlations should be plotted, i.e.,
#' between the exogenous constructs (`exo`), between the exogenous constructs and between the indicators (`both`), or not at all (`none`)? Defaults to `exo`.
#' between the exogenous constructs (`exo`), between the exogenous constructs and the indicators (`exoind`),
#' between the constructs VCV (`convcv`), between the indicator VCV (`indvcv`), or not at all (`none`)?
#' Defaults to `exo`.
#' @param .plot_labels Logical. Whether to display edge labels. Defaults to TRUE.
#' @param .plot_package Character string. Indicates which packages should be used for plotting.
#' @param .plot_significances Logical. Should p-values in the form of stars be plotted? Defaults to `TRUE`.
#' @param .plot_structural_model_only Logical. Should only the structural model,
Expand Down Expand Up @@ -489,7 +492,7 @@ args_default <- function(.choices = FALSE) {
.first_resample = NULL,
.force = FALSE,
.full_output = TRUE,
.graph_attrs = c("rankdir=LR","fixedsize=true"),
.graph_attrs = c("rankdir=LR"),
.handle_inadmissibles = c("drop", "ignore", "replace"),
.H = NULL,
.id = NULL,
Expand Down Expand Up @@ -520,7 +523,8 @@ args_default <- function(.choices = FALSE) {
.parameters_to_compare = NULL,
.path = NULL,
.path_coefficients = NULL,
.plot_correlations = c("exo", "both", "none"),
.plot_correlations = c("exo", "none", "convcv", "exoind", "indvcv"),
.plot_labels = TRUE,
.plot_package = NULL,
.plot_significances = TRUE,
.plot_structural_model_only = FALSE,
Expand Down
Loading

0 comments on commit a25a305

Please sign in to comment.