Nothing
#' Launch ggsem Shiny Application
#'
#' Main function to launch the ggsem Shiny application for interactive
#' network and structural equation modeling visualization. The app can be
#' started with pre-existing objects or used to create visualizations from scratch.
#'
#' @param object Optional visualization object. Supported types include:
#' - For SEM: `lavaan`, `qgraph` (from semPaths), `sem_graph` (tidySEM),
#' `MxRAMModel` (OpenMx), `mplusObject`, `grViz` (diagrammeR)
#' - For networks: `igraph`, `network`, `qgraph`
#' @param model_obj Optional model object to accompany visualization objects.
#' Required for some object types like `sem_graph` (tidySEM) for SEM visualizations.
#' @param model Same with model_obj
#' @param metadata Path to a saved RDS file containing a previous ggsem workflow session or RDS-read object.
#' When provided, the app will load this session data instead of creating a new one.
#' @param type Type of analysis: 'sem' for structural equation modeling or
#' 'network' for network analysis. Default is 'sem'.
#' @param session Initial session type (element type) when app launches. Either 'point', 'line', 'annotation', 'loop', 'sem' or 'network'.
#' Default is 'sem'.
#' @param center_x X-coordinate for the center of the visualization. If NULL,
#' defaults to 0.
#' @param center_y Y-coordinate for the center of the visualization. If NULL,
#' defaults to 0.
#' @param width Width of the visualization area. If NULL, defaults to 25.
#' @param height Height of the visualization area. If NULL, defaults to 25.
#' @param random_seed Random seed for reproducibility of layouts. If NULL,
#' uses current time in milliseconds.
#' @param group_id Identifier for grouping in multi-group models
#' @param group_level Level for grouping in multi-group models as in original data file or model object
#'
#' @return Launches a Shiny application. Does not return a value.
#'
#' @details
#' The ggsem Shiny application provides an interactive interface for:
#' - Visualizing and customizing SEM path diagrams
#' - Creating and modifying network visualizations
#' - Adjusting node/edge aesthetics, layouts, and annotations
#' - Exporting high-quality publication-ready graphics
#'
#' When starting with an object, the app will pre-load the visualization
#' and allow further customization. When starting without an object, users
#' can upload data or use built-in examples.
#'
#' @section Supported Object Types:
#' \strong{SEM Objects:}
#' \itemize{
#' \item \code{lavaan}: Fitted lavaan models
#' \item \code{qgraph}: semPaths objects from lavaan models
#' \item \code{sem_graph}: tidySEM objects
#' \item \code{MxRAMModel}: OpenMx models
#' \item \code{mplusObject}: Mplus models
#' \item \code{grViz}: diagrammeR objects from lavaanPlot
#' }
#'
#' \strong{Network Objects:}
#' \itemize{
#' \item \code{igraph}: igraph network objects
#' \item \code{network}: network package objects
#' \item \code{qgraph}: qgraph network objects
#' }
#'
#' @examples
#' \dontrun{
#' # Launch app without pre-existing objects
#' ggsem()
#'
#' # Launch app with a lavaan model
#' library(lavaan)
#' model <- ' visual =~ x1 + x2 + x3
#' textual =~ x4 + x5 + x6
#' speed =~ x7 + x8 + x9 '
#' fit <- cfa(model, data = HolzingerSwineford1939)
#' ggsem(object = fit)
#'
#' # Launch app with an igraph network
#' library(igraph)
#' g <- make_ring(10)
#' ggsem(object = g, type = "network", session = "network")
#'
#' # Launch app with custom dimensions
#' ggsem(object = g, type = "network", center_x = 10, center_y = 10, width = 30, height = 30)
#'
#'
#' # Launch app with no input
#' ggsem()
#' }
#' @importFrom lavaan lavInspect
#' @importFrom blavaan blavInspect
#' @importFrom igraph vcount ecount as_data_frame as_edgelist is_directed E
#' @importFrom network network.vertex.names list.edge.attributes as.edgelist get.edge.attribute
#' @importFrom lavaan lavInspect
#' @importFrom dplyr mutate summarise group_by first
#' @importFrom stats na.omit
#' @importFrom colourpicker colourInput updateColourInput
#' @importFrom memoise memoise
#' @importFrom shinyjs useShinyjs delay disable reset
#' @importFrom DT dataTableProxy renderDataTable renderDT datatable JS datatable formatStyle styleEqual DTOutput
#' @export
ggsem <- function(object = NULL, model_obj = NULL, model = NULL, metadata = NULL,
type = 'sem', session = 'sem',
center_x = NULL, center_y = NULL, width = NULL, height = NULL,
random_seed = NULL, group_id = NULL, group_level = NULL) {
required_packages <- c(
"blavaan", "colourpicker", "DiagrammeR", "DiagrammeRsvg", "dplyr",
"DT", "ggplot2", "grDevices", "grid", "igraph", "lavaan",
"memoise", "methods", "network", "purrr", "qgraph", "RColorBrewer",
"rlang", "Rtsne", "semPlot", "shiny", "shinyjs", "stringr",
"tidyr", "tidySEM", "umap", "xml2"
)
# Check and install missing packages
missing_packages <- required_packages[!sapply(required_packages, requireNamespace, quietly = TRUE)]
if (length(missing_packages) > 0) {
packages_string <- paste0("c('", paste(missing_packages, collapse = "', '"), "')")
stop(
"These packages are required to run the ggsem app but are missing: ",
paste(missing_packages, collapse = ", "), "\n\n",
"Please install them by running:\n\n",
"install.packages(", packages_string, ")"
)
}
if (!is.null(metadata)) {
if (is.character(metadata) && length(metadata) == 1 && grepl("^https?://", metadata)) {
message("Downloading metadata from URL: ", metadata)
tmp <- tempfile(fileext = ".rds")
tryCatch({
utils::download.file(metadata, tmp, mode = "wb", timeout = 600, cacheOK = FALSE)
metadata <- tmp
}, error = function(e) {
stop("Failed to download metadata from URL: ", metadata,
"\nError: ", e$message,
"\nPlease download the file manually and provide a local path.")
})
}
if (is.character(metadata) && length(metadata) == 1) {
# It's a file path string
if (!file.exists(metadata)) {
stop("Metadata file not found: ", metadata)
}
tryCatch({
metadata_content <- readRDS(metadata)
}, error = function(e) {
stop("Error loading metadata file: ", e$message)
})
} else {
metadata_content <- metadata
}
if (!is_valid_workflow(metadata_content)) {
stop("The provided metadata is not a valid ggsem workflow")
}
temp_path <- file.path(tempdir(), "ggsem_metadata.rds")
saveRDS(metadata_content, temp_path)
options(ggsem.metadata = temp_path)
options(ggsem.path = NULL)
options(ggsem.load_metadata = TRUE)
} else {
if (!is.null(model) && !is.null(model_obj)) {
warning("Both 'model' and 'model_obj' provided. Using 'model_obj' and ignoring 'model'.")
model <- NULL
}
model_obj <- if (!is.null(model)) model else model_obj
# plot.new()
network_state <- list(
nodes = NULL,
edges = NULL,
weights = NULL,
data = NULL
)
if (is.null(center_x)) center_x <- 0
if (is.null(center_y)) center_y <- 0
if (is.null(width)) width <- 25
if (is.null(height)) height <- 25
if (is.null(random_seed)) random_seed <- as.numeric(format(Sys.time(), "%OS3")) * 1000
lavaan_string <- "
visual =~ x1 + x2 + x3
textual =~ x4 + x5 + x6
speed =~ x7 + x8 + x9
"
if (!is.null(object)) {
data_file = TRUE
# semPlot + lavaan / blaavan / INLAvaan
if (inherits(object, "qgraph") && type == 'sem') { # lavaan
if (!is.null(model_obj) && (is(model_obj)[[1]] == "lavaan" || is(model_obj)[[1]] == "INLAvaan")) {
lavaan_string <- fit_to_lavstring(model_obj)
lavaan_data <- lavaan::lavInspect(model_obj, "data")
if (inherits(lavaan_data, "matrix")) {
lavaan_data <- as.data.frame(lavaan_data)
} else if (is.list(lavaan_data)) {
# Get the group variable name from the lavaan object
group_var_name <- lavaan::lavInspect(model_obj, "group")
if (is.null(group_var_name)) {
group_var_name <- "Group" # default name if not found
}
# Add group variable to each dataset and then rbind
group_names <- names(lavaan_data)
lavaan_data <- do.call(rbind, lapply(seq_along(lavaan_data), function(i) {
group_data <- as.data.frame(lavaan_data[[i]])
group_data[[group_var_name]] <- group_names[i]
group_data
}))
}
output_df <- generate_graph_from_sempaths(object, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "sem"
output_df$layout <- object$layout # layout matrix
} else if (!is.null(model_obj) && is(model_obj)[[1]] == "blavaan") {
lavaan_string <- blavaan_to_lavstring(model_obj)
lavaan_data <- blavInspect(model_obj, "data")
if (inherits(lavaan_data, "matrix")) {
lavaan_data <- as.data.frame(lavaan_data)
} else if (is.list(lavaan_data)) {
# Get the group variable name from the blavaan object
group_var_name <- blavInspect(model_obj, "group")
if (is.null(group_var_name)) {
group_var_name <- "Group" # default name if not found
}
# Add group variable to each dataset and then rbind
group_names <- names(lavaan_data)
lavaan_data <- do.call(rbind, lapply(seq_along(lavaan_data), function(i) {
group_data <- as.data.frame(lavaan_data[[i]])
group_data[[group_var_name]] <- group_names[i]
group_data
}))
}
output_df <- generate_graph_from_sempaths(object, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "sem"
output_df$layout <- object$layout # layout matrix
} else if (is.null(model_obj)) {
output_df <- generate_graph_from_sempaths(object, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "sem"
output_df$layout <- object$layout # layout matrix
}
} else if (is(object)[[1]] == "lavaan" || is(object)[[1]] == "INLAvaan") {
lavaan_string <- fit_to_lavstring(object)
lavaan_data <- lavInspect(object, "data")
if (inherits(lavaan_data, "matrix")) {
lavaan_data <- as.data.frame(lavaan_data)
} else if (is.list(lavaan_data)) {
# Get the group variable name from the lavaan object
group_var_name <- lavInspect(object, "group")
if (is.null(group_var_name)) {
group_var_name <- "Group" # default name if not found
}
# Add group variable to each dataset and then rbind
group_names <- names(lavaan_data)
lavaan_data <- do.call(rbind, lapply(seq_along(lavaan_data), function(i) {
group_data <- as.data.frame(lavaan_data[[i]])
group_data[[group_var_name]] <- group_names[i]
group_data
}))
}
group_labels <- lavaan::lavInspect(object, "group.label")
if (length(group_labels) == 0) {
multigroup_data_upload <- FALSE
} else {
multigroup_data_upload <- TRUE
}
group_var <- NULL
# group_level <- group_id
sem_paths <- lavaan_to_sempaths(fit = object,
data_file = lavaan_data,
layout_algorithm = 'tree2',
multi_group = multigroup_data_upload,
group_var = group_var,
group_level = group_level,
residuals = TRUE)
output_df <- generate_graph_from_sempaths(sem_paths, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
output_df$sem_paths <- sem_paths
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "sem"
output_df$layout <- sem_paths$layout # layout matrix
} else if (is(object)[[1]] == "blavaan") {
lavaan_string <- blavaan_to_lavstring(object)
lavaan_data <- blavInspect(object, "data")
if (inherits(lavaan_data, "matrix")) {
lavaan_data <- as.data.frame(lavaan_data)
} else if (is.list(lavaan_data)) {
# Get the group variable name from the blavaan object
group_var_name <- blavInspect(object, "group")
if (is.null(group_var_name)) {
group_var_name <- "Group" # default name if not found
}
# Add group variable to each dataset and then rbind
group_names <- names(lavaan_data)
lavaan_data <- do.call(rbind, lapply(seq_along(lavaan_data), function(i) {
group_data <- as.data.frame(lavaan_data[[i]])
group_data[[group_var_name]] <- group_names[i]
group_data
}))
}
group_labels <- lavaan::lavInspect(object, "group.label")
if (length(group_labels) == 0) {
multigroup_data_upload <- FALSE
} else {
multigroup_data_upload <- TRUE
}
group_var <- NULL
# group_level <- group_id
sem_paths <- blavaan_to_sempaths(fit = object,
data_file = lavaan_data,
layout_algorithm = 'tree2',
multi_group = multigroup_data_upload,
group_var = group_var,
group_level = group_level,
residuals = TRUE)
output_df <- generate_graph_from_sempaths(sem_paths, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
output_df$sem_paths <- sem_paths
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "sem"
output_df$layout <- sem_paths$layout # layout matrix
} else if (inherits(object, "MxRAMModel")) {
lavaan_string <- extract_mx_syntax(object)
lavaan_data <- object$data
model_obj <- convert_openmx_to_lavaan(object, data = lavaan_data)
sem_paths <- lavaan_to_sempaths(fit = model_obj, data_file = lavaan_data, residuals = TRUE)
output_df <- generate_graph_from_sempaths(sem_paths, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$sem_paths <- sem_paths
output_df$which_type <- "sem"
output_df$layout <- sem_paths$layout # layout matrix
# Mplus model object
} else if (inherits(object, "mplusObject")) {
mplus_string <- object$MODEL
lavaan_string <- extract_mplus_syntax(mplus_string)
lavaan_data <- if (!is.null(object$rdata)) {
object$rdata
} else if (!is.null(object$data)) {
object$data
} else {
stop("No data provided and no data found in Mplus object")
}
model_obj <- convert_mplus_to_lavaan(object)
sem_paths <- lavaan_to_sempaths(fit = model_obj, data_file = lavaan_data, residuals = TRUE)
output_df <- generate_graph_from_sempaths(sem_paths, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$sem_paths <- sem_paths
output_df$which_type <- "sem"
output_df$layout <- sem_paths$layout # layout matrix
# tidySEM
} else if (inherits(object, "sem_graph")) {
multi_group <- "group" %in% names(object$nodes)
if (multi_group && is.null(group_id)) {
group_levels <- unique(object$nodes$group)
all_group_outputs <- list()
for (i in seq_along(group_levels)) {
# NOTHING - IGNORE
group_id <- group_levels[[i]]
group_output <- generate_graph_from_tidySEM(object,
center_x = center_x,
center_y = center_y,
relative_x_position = width,
relative_y_position = height,
which_group = group_id)
if (!is.null(group_output) && nrow(group_output$points) > 0) {
all_group_outputs[[i]] <- group_output
}
}
if (length(all_group_outputs) > 0) {
output_df <- list(
points = do.call(rbind, lapply(all_group_outputs, function(x) x$points)),
lines = do.call(rbind, lapply(all_group_outputs, function(x) x$lines)),
annotations = do.call(rbind, lapply(all_group_outputs, function(x) x$annotations))
)
} else {
output_df <- list(points = data.frame(), lines = data.frame(), annotations = data.frame())
}
} else if (multi_group && !is.null(group_id)) {
output_df <- generate_graph_from_tidySEM(object,
center_x = center_x,
center_y = center_y,
relative_x_position = width,
relative_y_position = height,
which_group = group_level)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
} else {
output_df <- generate_graph_from_tidySEM(object,
center_x = center_x,
center_y = center_y,
relative_x_position = width,
relative_y_position = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
}
output_df$which_type <- "sem"
if (is(model_obj)[[1]] == "lavaan" || is(model_obj)[[1]] == "INLAvaan") lavaan_string <- fit_to_lavstring(model_obj)
if (is(model_obj)[[1]] == "blavaan") lavaan_string <- blavaan_to_lavstring(model_obj)
if (inherits(model_obj, "MxRAMModel")) {
lavaan_string <- extract_mx_syntax(model_obj)
model_obj <- convert_mx_to_lavaan(model_obj, model_obj$data)
}
if (inherits(model_obj, "mplusObject")) {
lavaan_string <- extract_mplus_syntax(model_obj)
model_obj <- convert_mplus_to_lavaan(model_obj)
}
} else if (inherits(object, "igraph")) {
nodes <- igraph::as_data_frame(object, what = "vertices")
if (ncol(nodes) == 0) {
# No vertex attributes at all
nodes <- data.frame(name = as.character(1:igraph::vcount(object)))
} else if (!"name" %in% colnames(nodes)) {
# Has vertex attributes but no name column
nodes$name <- as.character(1:igraph::vcount(object))
} else {
nodes$name <- as.character(nodes$name)
}
network_state$nodes <- data.frame(node = nodes$name)
if (!is.null(igraph::E(object)$weight)) {
network_state$edges <- data.frame(source = igraph::as_edgelist(object)[,1],
target = igraph::as_edgelist(object)[,2],
weight = igraph::E(object)$weight)
} else {
network_state$edges <- data.frame(source = igraph::as_edgelist(object)[,1],
target = igraph::as_edgelist(object)[,2],
weight = NA)
}
edges <- network_state$edges
nodes <- data.frame(node = nodes$name)
network_state$weights <- igraph::E(object)$weight
network_state$data <- object
directed <- igraph::is_directed(object)
edges <- edges |>
dplyr::mutate(
edge_id = pmin(source, target),
edge_pair = pmax(source, target)
) |>
dplyr::group_by(edge_id, edge_pair) |>
dplyr::summarise(
source = dplyr::first(source),
target = dplyr::first(target),
weight = if ("weight" %in% colnames(edges)) {
if (is.numeric(weight)) {
if (all(is.na(weight))) NA_real_
else mean(weight, na.rm = TRUE)
} else {
if (all(is.na(weight))) NA_character_
else dplyr::first(stats::na.omit(weight)) # Take first non-NA value
}
}
,
two_way = dplyr::n() > 1,
.groups = "drop"
)
network_prep <- generate_network_layout(network_object = object,
edges = edges,
nodes = nodes,
layout_method = "fr",
directed = directed,
random_seed = random_seed)
output_df <- generate_graph_from_network(graph = network_prep$graph,
layout = network_prep$layout,
is_bipartite = network_prep$is_bipartite,
edges = edges,
nodes = nodes,
directed = directed,
x_center = center_x, y_center = center_y,
layout_width = width, layout_height = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "network"
output_df$layout <- network_prep$layout
} else if (inherits(object, "network")) {
nodes <- data.frame(node = as.character(network::network.vertex.names(object)))
if ("weights" %in% network::list.edge.attributes(object)) {
edges <- data.frame(source = network::as.edgelist(object)[,1],
target = network::as.edgelist(object)[,2],
weight = network::get.edge.attribute(object, 'weights'))
} else {
edges <- data.frame(source = network::as.edgelist(object)[,1],
target = network::as.edgelist(object)[,2],
weight = NA)
}
edges$source <- nodes$node[edges$source]
edges$target <- nodes$node[edges$target]
network_state$nodes <- nodes
network_state$edges <- edges
network_state$data <- object
directed <- network::is.directed(object)
edges <- edges |>
dplyr::mutate(
edge_id = pmin(source, target),
edge_pair = pmax(source, target)
) |>
dplyr::group_by(edge_id, edge_pair) |>
dplyr::summarise(
source = dplyr::first(source),
target = dplyr::first(target),
weight = if ("weight" %in% colnames(edges)) {
if (is.numeric(weight)) {
if (all(is.na(weight))) NA_real_
else mean(weight, na.rm = TRUE)
} else {
if (all(is.na(weight))) NA_character_
else dplyr::first(stats::na.omit(weight)) # Take first non-NA value
}
}
,
two_way = dplyr::n() > 1,
.groups = "drop"
)
network_prep <- generate_network_layout(network_object = object,
edges = edges,
nodes = nodes,
layout_method = "fr",
directed = directed,
random_seed = random_seed)
output_df <- generate_graph_from_network(graph = network_prep$graph,
layout = network_prep$layout,
is_bipartite = network_prep$is_bipartite,
edges = edges,
nodes = nodes,
directed = directed,
x_center = center_x, y_center = center_y,
layout_width = width, layout_height = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "network"
output_df$layout <- network_prep$layout
} else if (inherits(object, "qgraph") && type == 'network') {
output_df <- generate_graph_from_qgraph(object, x_center = center_x, y_center = center_y,
layout_width = width, layout_height = height) # list
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- "network"
} else if (inherits(object, 'grViz')) {
output_df <- generate_graph_from_diagrammeR(object, center_x = center_x, center_y = center_y,
relative_x_position = width, relative_y_position = height)
if (!is.null(group_id)) {
if (nrow(output_df$points) > 0) output_df$points$group <- group_id
if (nrow(output_df$lines) > 0) output_df$lines$group <- group_id
if (nrow(output_df$annotations) > 0) output_df$annotations$group <- group_id
}
output_df$which_type <- 'sem'
if (inherits(model_obj, "lavaan") || is(model_obj)[[1]] == "INLAvaan") lavaan_string <- fit_to_lavstring(model_obj)
}
bundle <- list(
object = object,
graph_data = output_df,
random_seed = random_seed,
lavaan_string = lavaan_string,
model_obj = model_obj,
session = output_df$which_type,
group = if (!is.null(group_id)) group_id else if (!is.null(output_df$points$group)) unique(output_df$points$group) else NULL,
group_level = group_level,
center_x = center_x,
center_y = center_y,
width = width,
height = height
)
temp_path <- file.path(tempdir(), "ggsem_data.rds")
saveRDS(bundle, temp_path)
options(ggsem.path = temp_path)
} else {
temp_path <- file.path(tempdir(), "ggsem_data.rds")
bundle <- list(object = NULL,
random_seed = random_seed,
lavaan_string = lavaan_string,
session = session)
saveRDS(bundle, temp_path)
options(ggsem.path = temp_path)
}
}
shiny::runApp(system.file("shiny", package = "ggsem"),
display.mode = "normal",
launch.browser = TRUE)
}
is_valid_workflow <- function(workflow) {
essential_elements <- c(
"sem_groups", "network_groups", "modifications",
"visual_elements", "metadata"
)
if (!all(essential_elements %in% names(workflow))) {
cat("Missing essential elements:",
paste(setdiff(essential_elements, names(workflow)), collapse = ", "), "\n")
return(FALSE)
}
# Visual elements
required_visual <- c("points", "lines", "loops", "annotations")
if (!all(required_visual %in% names(workflow$visual_elements))) {
cat("Missing visual elements:",
paste(setdiff(required_visual, names(workflow$visual_elements)), collapse = ", "), "\n")
return(FALSE)
}
# data_files is optional
if (!"data_files" %in% names(workflow)) {
workflow$data_files <- list()
}
return(TRUE)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.