Nothing
#' Extract Insight Maker model from URL
#'
#' Create XML string from Insight Maker URL. For internal use; use `insightmaker_to_sfm()` to import an Insight Maker model.
#'
#' @param URL String with URL to an Insight Maker model
#' @param file If specified, file path to save Insight Maker model to. If NULL, do not save model.
#'
#' @returns XML string with Insight Maker model
#' @seealso [insightmaker_to_sfm()]
#' @export
#' @family insightmaker
#' @examplesIf has_internet()
#' xml <- url_to_IM(
#' URL =
#' "https://insightmaker.com/insight/43tz1nvUgbIiIOGSGtzIzj/Romeo-Juliet"
#' )
#'
url_to_IM <- function(URL, file = NULL) {
# Read URL
url_data <- rvest::read_html(URL)
# Get link from page
iframe_src <- url_data |>
rvest::html_element("iframe") |>
rvest::html_attr("src")
full_iframe_url <- rvest::url_absolute(iframe_src, URL) # Create absolute link out of relative link
iframe_page <- rvest::read_html(full_iframe_url)
# Get elements with <script tag
script_texts <- iframe_page |> rvest::html_elements("script")
# Keep script with certain keywords
script_model <- as.character(
script_texts[stringr::str_detect(
rvest::html_text(script_texts, trim = TRUE), "model_id"
) & stringr::str_detect(rvest::html_text(script_texts, trim = TRUE), "model_title")]
)
# Extract part of interest
xml_str <- stringr::str_match_all(
script_model,
stringr::regex("<mxGraphModel>(.*?)</mxGraphModel>", dotall = TRUE)
)[[1]][1] |>
stringr::str_replace_all("mxGraphModel", "insightmakermodel") |>
# Remove escape characters for writing an XML file
stringr::str_replace_all(stringr::fixed("\\\\\""), "\\\"") |>
stringr::str_replace_all(stringr::fixed("\\\""), "\"") |>
stringr::str_replace_all(stringr::fixed("\\\\n"), "\\n")
xml_str
# Extract meta-data - this is embedded in the webpage, but not saved in the .InsightMaker file. Add to .InsightMaker file to preserve the original author of the model.
header_names <- c("model_id", "model_title", "model_author_id", "model_author_name")
header_info <- vapply(header_names, function(x) {
stringr::str_match(
script_model,
sprintf("\"%s\":\"(.*?)\"", x)
)[, 2]
}, character(1)) |> as.list()
header_str <- sprintf("<header> %s </header>", paste0(names(header_info),
"=\"",
unname(textutils::HTMLencode(header_info, encode.only = c("&", "<", ">"))), "\"",
collapse = ", "
))
# Insert header in xml_str
idx_root <- stringr::str_locate(xml_str, "<root>")
stringr::str_sub(xml_str, idx_root[, "start"], idx_root[, "end"]) <- paste0("<root> \\n", header_str)
# Save and read .InsightMaker file
if (is.null(file)) {
delete_after <- TRUE
file <- tempfile(fileext = ".InsightMaker")
} else {
delete_after <- FALSE
}
writeLines(xml_str, file)
xml_file <- xml2::read_xml(file)
# If no file path was specified before, delete file
if (delete_after) {
file.remove(file)
file <- NULL
}
return(xml_file)
}
#' Convert XML nodes to list
#'
#' @param xml_file XML structured model
#'
#' @returns Nested list in XMILE style
#' @noRd
#'
IM_to_xmile <- function(xml_file) {
# Get the children nodes
children <- xml2::xml_children(xml_file)
if (xml2::xml_name(children) == "root") {
children <- xml2::xml_children(children) # Double to remove nested layer
}
# Get attributes, also of children
tags <- c("Setting", "Variable", "Converter", "Stock", "Flow", "Link", "Ghost")
node_names <- xml2::xml_name(children)
# Check whether the model has any components
if (!any(c("Variable", "Stock", "Flow") %in% node_names)) {
stop("This model does not contain any variables, stocks, or flows!\nNote that sdbuildR only supports importing stock-and-flow models.", call. = FALSE)
}
if ("header" %in% node_names) {
# Step 1: Split by comma and trim spaces
header_str <- children[match("header", node_names)] |>
xml2::xml_text(trim = TRUE)
pairs <- strsplit(header_str, ",\\s*")[[1]]
# Step 2: Split each pair into name and value, then clean up extra quotes
header_list <- vapply(pairs, function(pair) {
key_value <- strsplit(pair, "=\\s*")[[1]]
key <- key_value[1]
return(gsub('\"', "", key_value[2])) # Remove extra quotes
}, character(1))
# Convert to named list
names(header_list) <- vapply(pairs, function(pair) {
strsplit(pair, "=\\s*")[[1]][1]
}, character(1))
header_list <- as.list(header_list)
} else {
header_list <- list()
}
# Get attributes as well as deeper attributes
children_attrs <- lapply(children, function(x) {
c(unlist(xml2::xml_attrs(x)), unlist(xml2::xml_attrs(xml2::xml_children(x))))
})
children_attrs <- lapply(children_attrs[node_names %in% tags], as.list)
node_names <- node_names[node_names %in% tags]
# Get first setting
settings <- children_attrs[[match("Setting", node_names)[1]]]
settings[["method"]] <- ifelse(settings[["SolutionAlgorithm"]] == "RK1", "euler",
ifelse(settings[["SolutionAlgorithm"]] == "RK4", "rk4", settings[["SolutionAlgorithm"]])
)
if (as.numeric(settings[["TimeStep"]]) >= 1 & settings[["method"]] == "rk4") {
message(sprintf("The chosen timestep %s is not suitable for the Runge-Kutta 4th order solver. Setting timestep to 0.1...", settings[["TimeStep"]]))
settings[["TimeStep"]] <- ".1"
}
# Check whether the model uses an early version of Insight Maker
if (as.numeric(settings[["Version"]]) < 37) {
message(sprintf("This model uses an earlier version of Insight Maker (%s), in which links were bi-directional by default. This may cause issues in translating the model. Please choose 'Clone Insight' in Insight Maker, and provide the URL to the updated model.", settings[["Version"]]))
}
# Check whether model is later version of Insight Maker than the package was made for
if (as.numeric(settings[["Version"]]) > .sdbuildR_env[["P"]][["insightmaker_version"]]) {
message(sprintf(
"This model uses Insight Maker version %s, whereas sdbuildR was based on Insight Maker version %d. Some features may not be available.", settings[["Version"]],
.sdbuildR_env[["P"]][["insightmaker_version"]]
))
}
# Add version to header
header_list[["insightmaker_version"]] <- settings[["Version"]]
# Change links to access_ids
keep_idx <- node_names %in% c("Link", "Flow")
children_connectors <- children_attrs[keep_idx]
connector_names <- node_names[keep_idx]
bidirectional <- get_map(children_connectors, "BiDirectional")
ids <- get_map(children_connectors, "id")
sources <- get_map(children_connectors, "source")
targets <- get_map(children_connectors, "target")
# Add Stocks as sources for Flows as targets
add_stock_sources <- c(sources[connector_names == "Flow"], targets[connector_names == "Flow"])
add_stock_targets <- c(ids[connector_names == "Flow"], ids[connector_names == "Flow"])
# Replace ghost ids with original
if (any(node_names == "Ghost")) {
ghost_sources <- children_attrs[node_names == "Ghost"] |> get_map("Source")
ghost_ids <- children_attrs[node_names == "Ghost"] |> get_map("id")
replace_dict <- stats::setNames(ghost_sources, ghost_ids)
sources <- stringr::str_replace_all(sources, replace_dict)
targets <- stringr::str_replace_all(targets, replace_dict)
}
# In case of a bidirectional link, switch around source and target
add_bi_targets <- sources[bidirectional == "true"]
add_bi_sources <- targets[bidirectional == "true"]
targets <- c(targets, add_bi_targets, add_stock_targets)
sources <- c(sources, add_bi_sources, add_stock_sources)
# Remove doubles
temp <- data.frame(targets = targets, sources = sources)
temp <- temp[!duplicated(temp), ]
targets <- temp[["targets"]]
sources <- temp[["sources"]]
# Construct dictionary for replacement of id
keep_idx <- node_names %in% c("Variable", "Converter", "Stock", "Flow")
model_element_names <- node_names[keep_idx]
ids <- children_attrs[keep_idx] |> get_map("id")
old_names <- children_attrs[keep_idx] |> get_map("name")
stock_names <- children_attrs[keep_idx][model_element_names == "Stock"] |> get_map("name")
# Variables cannot be the same name as Insight Maker functions
IM_func_names <- get_syntax_IM()[["conv_df"]][["insightmaker"]]
new_names <- clean_name(old_names,
# Normally, names_df is specified here
NULL,
protected = c(
IM_func_names, tolower(IM_func_names),
toupper(IM_func_names)
)
)
# Add to which ids it has access
model_elements <- lapply(children_attrs[keep_idx], function(x) {
x[["access_ids"]] <- sources[targets == x[["id"]]]
x[["access"]] <- new_names[match(x[["access_ids"]], ids)]
return(x)
})
# Rename to eqn_insightmaker
model_elements <- lapply(seq_along(model_elements), function(y) {
x <- model_elements[[y]]
idx <- which(names(x) %in% c("FlowRate", "Equation", "InitialValue"))
if (length(idx) != 0) {
x[["eqn_insightmaker"]] <- x[[idx]]
# Default is zero
if (!nzchar(x[["eqn_insightmaker"]])) {
x[["eqn_insightmaker"]] <- "0.0"
}
x[idx] <- NULL
} else if (length(idx) == 0 & model_element_names[y] %in% c("Variable", "Stock", "Flow")) {
# The default value of a Stock/Flow/Variable is 0 - add in case left unspecified
x[["eqn_insightmaker"]] <- "0.0"
}
# Rename Note to doc
if ("Note" %in% names(x)) {
x[["doc"]] <- x[["Note"]]
# Some notes still have HTML? tags
x[["doc"]] <- gsub("<span[^>]*>", " ", x[["doc"]]) # Remove opening <span> tags
x[["doc"]] <- gsub("</span>", " ", x[["doc"]]) # Remove closing </span> tags
x[["doc"]] <- gsub("<a[^>]*>", " ", x[["doc"]]) # Remove opening <a> tags
x[["doc"]] <- gsub("</a>", " ", x[["doc"]]) # Remove closing </a> tags
x[["doc"]] <- gsub("<br>", "\n", x[["doc"]]) # Remove closing line breaks
x[["doc"]] <- gsub("<div[^>]*>", " ", x[["doc"]]) # Remove opening <div> tags
x[["doc"]] <- gsub("</div>", " ", x[["doc"]]) # Remove closing </div> tags
x[["doc"]] <- gsub(" ", " ", x[["doc"]])
x[["Note"]] <- NULL
} else {
x[["doc"]] <- ""
}
# Rename constraints
if ("MinConstraint" %in% names(x)) {
x[["min"]] <- ifelse(x[["MinConstraintUsed"]] == "true", x[["MinConstraint"]], "")
x[["max"]] <- ifelse(x[["MaxConstraintUsed"]] == "true", x[["MaxConstraint"]], "")
x[c("MinConstraint", "MinConstraintUsed", "MaxConstraint", "MaxConstraintUsed")] <- NULL
}
return(x)
})
# Replace old names with new names
model_elements <- lapply(model_elements, function(x) {
x[["eqn_insightmaker"]] <- stringr::str_replace_all(
x[["eqn_insightmaker"]],
stringr::fixed(c("\\n" = "\n"))
)
x[["eqn_insightmaker"]] <- replace_names_IM(x[["eqn_insightmaker"]],
original = old_names[ids %in% x[["access_ids"]]],
replacement = new_names[ids %in% x[["access_ids"]]]
)
x[["name_insightmaker"]] <- x[["name"]]
x[["name"]] <- replace_names_IM(x[["name_insightmaker"]],
original = old_names[match(x[["id"]], ids)],
replacement = new_names[match(x[["id"]], ids)], with_brackets = FALSE
)
return(x)
}) |>
# Remove comments from equations
lapply(function(x) {
# Graphical functions won't have an equation
if (is_defined(x[["eqn_insightmaker"]])) {
out <- prep_eqn_IM(x[["eqn_insightmaker"]])
x[["eqn_insightmaker"]] <- out[["eqn"]]
x[["doc"]] <- paste0(x[["doc"]], out[["doc"]])
}
return(x)
})
model_elements
# Converters
converter_prop <- c(
"doc", "units_insightmaker", "name_insightmaker", "type", "name",
"min", "max", "xpts", "ypts", "interpolation", "source", "extrapolation",
# "access", "access_ids",
"id_insightmaker"
)
model_elements[model_element_names == "Converter"] <-
lapply(model_elements[model_element_names == "Converter"], function(x) {
# Get x and y data for interpolation function
data_split <- strsplit(x[["Data"]], ";")[[1]] |>
strsplit(",") |>
do.call(rbind, args = _)
x[["type"]] <- "gf"
x[["xpts"]] <- as.numeric(trimws(data_split[, 1]))
x[["ypts"]] <- as.numeric(trimws(data_split[, 2]))
x[["interpolation"]] <- ifelse(x[["Interpolation"]] == "None", "constant", tolower(x[["Interpolation"]]))
x[["source"]] <- ifelse(x[["Source"]] == "Time", .sdbuildR_env[["P"]][["time_name"]], new_names[x[["Source"]] == ids])
x[["extrapolation"]] <- "nearest" # Default
x[["units_insightmaker"]] <- x[["Units"]]
x[["id_insightmaker"]] <- x[["id"]]
# Only keep selected properties
x <- x[names(x) %in% converter_prop]
return(x)
})
# Variables -> Auxiliaries
variable_prop <- c(
"doc", "eqn_insightmaker", "units_insightmaker", "name_insightmaker",
"type", "name", "min", "max",
# "access", "access_ids",
"id_insightmaker"
)
model_elements["Variable" == model_element_names] <- model_elements["Variable" == model_element_names] |>
lapply(function(x) {
x[["units_insightmaker"]] <- x[["Units"]]
x[["id_insightmaker"]] <- x[["id"]]
# Only keep selected properties
x[["type"]] <- "aux"
x <- x[names(x) %in% variable_prop]
return(x)
})
# Stocks
stock_prop <- c(
"doc", "units_insightmaker", "name_insightmaker", "type", "name",
"min", "max", "eqn_insightmaker",
# "StockMode", "Delay",
"conveyor", "len", "non_negative",
# "access", "access_ids",
"id_insightmaker"
)
flows <- model_elements["Flow" == model_element_names]
flow_ids <- get_map(flows, "id")
flow_sources <- get_map(flows, "source")
flow_targets <- get_map(flows, "target")
# Only keep selected properties and rename
model_elements["Stock" == model_element_names] <-
lapply(model_elements["Stock" == model_element_names], function(x) {
x[["non_negative"]] <- ifelse(tolower(x[["NonNegative"]]) == "true", TRUE, FALSE)
x[["units_insightmaker"]] <- x[["Units"]]
x[["type"]] <- "stock"
x[["id_insightmaker"]] <- x[["id"]]
if (is_defined(x[["StockMode"]])) {
if (x[["StockMode"]] == "Conveyor") {
x[["conveyor"]] <- TRUE
x[["len"]] <- x[["Delay"]]
}
}
# Only keep selected properties
x <- x[names(x) %in% stock_prop]
return(x)
})
# Flows
flow_prop <- c(
"doc", "eqn_insightmaker", "units_insightmaker", "name_insightmaker",
"type", "name", "min", "max", "from", "to", "non_negative",
# "access", "access_ids",
"id_insightmaker"
)
# Only keep selected properties and rename
model_elements["Flow" == model_element_names] <-
lapply(model_elements["Flow" == model_element_names], function(x) {
x[["id_insightmaker"]] <- x[["id"]]
# Which stocks are the flows connected to?
x[["from"]] <- ifelse("source" %in% names(x), new_names[x[["source"]] == ids], "")
x[["to"]] <- ifelse("target" %in% names(x), new_names[x[["target"]] == ids], "")
x[["type"]] <- "flow"
# Flows can use [Alpha] and [Omega] to refer to the stock they flow from and to, respectively. Change to new variable names
x[["eqn_insightmaker"]] <- stringr::str_replace_all(
x[["eqn_insightmaker"]],
stringr::regex(c(
"\\[Alpha\\]" = paste0("[", x[["from"]], "]"),
"\\[Omega\\]" = paste0("[", x[["to"]], "]")
), ignore_case = TRUE)
)
x[["non_negative"]] <- ifelse(x[["OnlyPositive"]] == "true", TRUE, FALSE)
x[["units_insightmaker"]] <- x[["Units"]]
# Only keep selected properties
x <- x[names(x) %in% flow_prop]
return(x)
})
# Name elements
model_elements <- stats::setNames(model_elements, get_map(model_elements, "name"))
# Ensure year and month match Insight Maker's unit definition - a year in Insight Maker is 365 days, not 365.25 days
time_units <- settings[["TimeUnits"]] |>
stringr::str_replace_all(stringr::regex(c(
"[Y|y]ear[s]?" = "common_yr",
"[Q|q]uarter[s]?" = "common_quarter",
"[M|m]onth[s]?" = "common_month"
), ignore_case = TRUE))
# Set-up basic structure
sfm <- new_sdbuildR_xmile() |>
sim_specs(
method = settings[["method"]],
time_units = time_units,
start = settings[["TimeStart"]],
stop = as.numeric(settings[["TimeStart"]]) + as.numeric(settings[["TimeLength"]]),
dt = settings[["TimeStep"]],
save_at = settings[["TimeStep"]],
save_from = settings[["TimeStart"]]
)
# Header
header_list[["insightmaker_method"]] <- settings[["SolutionAlgorithm"]]
# Rename elements in header
new_names <- names(header_list)
new_names[new_names == "model_author_name"] <- "author"
new_names[new_names == "model_author_id"] <- "insightmaker_author_id"
new_names[new_names == "model_title"] <- "name"
new_names[new_names == "model_id"] <- "insightmaker_model_id"
names(header_list) <- new_names
sfm[["header"]] <- utils::modifyList(sfm[["header"]], header_list)
# Variables
sfm[["model"]][["variables"]] <- sfm[["model"]][["variables"]] |>
utils::modifyList(list(
stock = model_elements["Stock" == model_element_names],
aux = model_elements["Variable" == model_element_names],
flow = model_elements["Flow" == model_element_names],
gf = model_elements["Converter" == model_element_names]
))
# Add globals to define at top of script
out_global <- prep_eqn_IM(settings[["Macros"]] |>
# Remove leading and last \" before replacing \" with "
stringr::str_replace("^\\\"", "") |>
stringr::str_replace("\\\"$", ""))
# Temporary entries in sfm
sfm[["model_units_str"]] <- settings[["Units"]]
sfm[["global"]] <- list(
eqn = out_global[["eqn"]],
eqn_insightmaker = out_global[["eqn"]],
doc = out_global[["doc"]]
)
if (.sdbuildR_env[["P"]][["debug"]]) {
message(sprintf(
"Detected %d Stock%s, %d Flow%s, %d Auxiliar%s, and %d Graphical Function%s",
length(sfm[["model"]][["variables"]][["stock"]]),
ifelse(length(sfm[["model"]][["variables"]][["stock"]]) == 1, "", "s"),
length(sfm[["model"]][["variables"]][["flow"]]),
ifelse(length(sfm[["model"]][["variables"]][["flow"]]) == 1, "", "s"),
length(sfm[["model"]][["variables"]][["aux"]]),
ifelse(length(sfm[["model"]][["variables"]][["aux"]]) == 1, "y", "ies"),
length(sfm[["model"]][["variables"]][["gf"]]),
ifelse(length(sfm[["model"]][["variables"]][["gf"]]) == 1, "", "s")
))
if (nzchar(out_global[["eqn"]])) {
message("User-defined macros and globals detected")
} else {
message("No user-defined macros and globals detected")
}
}
# Conveyors Stocks have a fixed delay with a specified delay length. If a stock "A" is referred to as [A], it refers to the delayed value of A, whereas [[A]] refers to the accumulated value to the 'true' current value of A. If the stock is of StockMode Conveyor, any reference to [A] refers to the delayed value of A.
# In short:
# for a stock A which is a conveyor,
# [A] refers to A_conveyor
# [[A]] refers to A
conveyor_stocks <- names(unlist(lapply(sfm[["model"]][["variables"]][["stock"]], `[[`, "conveyor")))
if (length(conveyor_stocks) > 0) {
# Ensure correct referencing of conveyors
dict <- paste0("[", conveyor_stocks, .sdbuildR_env[["P"]][["conveyor_suffix"]], "]") |>
stats::setNames(paste0("[[", conveyor_stocks, "]]"))
sfm[["model"]][["variables"]] <- lapply(sfm[["model"]][["variables"]], function(x) {
lapply(x, function(y) {
if ("eqn_insightmaker" %in% names(y)) {
y[["eqn_insightmaker"]] <- stringr::str_replace_all(y[["eqn_insightmaker"]], stringr::fixed(dict, ignore_case = TRUE))
# Remove any left-over double bracket notations - these should be []
y[["eqn_insightmaker"]] <- stringr::str_replace_all(y[["eqn_insightmaker"]], stringr::fixed(c("[[" = "[", "]]" = "]")))
}
return(y)
})
})
}
converters <- names(sfm[["model"]][["variables"]][["gf"]])
converters_sources <- unlist(lapply(sfm[["model"]][["variables"]][["gf"]], `[[`, "source"))
if (length(converters) > 0) {
# Ensure correct referencing of converters
dict_t <- stats::setNames(
paste0("(", .sdbuildR_env[["P"]][["time_name"]], ")"),
paste0("([", .sdbuildR_env[["P"]][["time_name"]], "])")
)
dict <- paste0("[", converters, "]", "([", converters_sources, "])") |>
# Some sources are time t, remove [t]
stringr::str_replace_all(stringr::fixed(dict_t)) |>
stats::setNames(paste0("[", converters, "]"))
# Some sources are other graphical functions, replace there as well
dict_extra <- stats::setNames(paste0("(", unname(dict), ")"), paste0("(", names(dict), ")"))
dict_extra <- stringr::fixed(dict_extra)
dict <- stats::setNames(stringr::str_replace_all(unname(dict), dict_extra), names(dict))
# Temporary placeholder
placeholders <- vapply(seq_along(dict), function(x) {
paste0(sample(c(letters, LETTERS, 0:9), 12, replace = TRUE), collapse = "")
}, character(1))
dict_temp <- stats::setNames(placeholders, names(dict))
dict_real <- stats::setNames(unname(dict), unname(dict_temp))
dict_temp <- stringr::fixed(dict_temp)
dict_real <- stringr::fixed(dict_real)
# Replace graphical functions in all equations
sfm[["model"]][["variables"]] <- lapply(sfm[["model"]][["variables"]], function(x) {
lapply(x, function(y) {
if ("eqn_insightmaker" %in% names(y)) {
y[["eqn_insightmaker"]] <- stringr::str_replace_all(y[["eqn_insightmaker"]], dict_temp) |>
stringr::str_replace_all(dict_real)
}
return(y)
})
})
}
# Already add eqn and units
sfm[["model"]][["variables"]] <- lapply(sfm[["model"]][["variables"]], function(y) {
lapply(y, function(x) {
if ("eqn_insightmaker" %in% names(x)) {
x[["eqn"]] <- trimws(x[["eqn_insightmaker"]])
if (!nzchar(x[["eqn"]])) {
x[["eqn"]] <- "0.0"
}
}
if ("units_insightmaker" %in% names(x)) {
x[["units"]] <- trimws(x[["units_insightmaker"]])
if (!nzchar(x[["units"]])) {
x[["units"]] <- "1"
}
}
return(x)
})
})
sfm <- validate_xmile(sfm)
return(sfm)
}
#' Prepare Insight Maker equation
#'
#' @param eqn Insight Maker equation to prepare
#'
#' @returns List with eqn and doc
#' @noRd
prep_eqn_IM <- function(eqn) {
# HTML and escape character replacements
eqn <- eqn |>
textutils::HTMLdecode() |>
stringr::str_replace_all(stringr::fixed("\""), "'") |>
stringr::str_replace_all(stringr::fixed("\'"), "'") |>
stringr::str_replace_all(stringr::fixed("\\n"), "\n") |>
trimws() |>
# Ensure there is no scientific notation
scientific_notation()
# Replace_comments
eqn <- replace_comments(eqn)
# Extract and remove comments
out <- remove_comments(eqn)
return(out)
}
#' Replace Insight Maker ids
#'
#' Replace Insight Maker name with id, replace id with name
#'
#' @param string String to apply replacement to
#' @param original Vector with strings to replace
#' @param replacement Vector with strings as replacements
#' @param with_brackets Boolean; whether to include square brackets around the match and replacement
#'
#' @returns Updated string
#' @noRd
#'
replace_names_IM <- function(string, original, replacement, with_brackets = TRUE) {
if (is.null(string)) {
return(string)
} else {
replace_dict <- stats::setNames(
paste0(ifelse(with_brackets, "\\[", ""), replacement, ifelse(with_brackets, "\\]", "")),
# First make string suitable for regular expressions by adding escape characters, then add brackets around which cannot be preceded by a square bracket (in order to correctly translate conveyors)
# paste0("([^\\[]]*)\\[", stringr::str_escape(original), "\\]"))
paste0(ifelse(with_brackets, "(?<!\\[)\\[", ""), stringr::str_escape(original), ifelse(with_brackets, "\\]", ""))
)
new_string <- stringr::str_replace_all(
string,
# Insight Maker is not case-sensitive in the use of names
stringr::regex(replace_dict, ignore_case = TRUE)
)
return(new_string)
}
}
#' Prepare units for Julia's Unitful package
#'
#' @inheritParams build
#' @inheritParams clean_unit
#'
#' @returns Updated sfm
#' @noRd
#'
clean_units_IM <- function(sfm, regex_units) {
# Get names of all model elements
var_names <- get_model_var(sfm)
# Remove year because Insight Maker's year is 365 days
regex_units <- regex_units[!regex_units %in% c("yr", "month", "quarter")]
regex_units <- c(regex_units, c(
"^[Y|y]ear[s]?$" = "common_yr",
"^[Q|q]uarter[s]?$" = "common_quarter",
"^[M|m]onth[s]?$" = "common_month"
))
# Define custom units
if (nzchar(sfm[["model_units_str"]])) {
# Create data.frame with custom units, splitting by <> to separate name, eqn, and alias
custom_units_df <- strsplit(
# In Insight Maker, units are not case-sensitive
tolower(sfm[["model_units_str"]]), "\n"
)[[1]] |>
lapply(function(x) {
stringr::str_split_fixed(x, "<>", n = 3)
}) |>
do.call(rbind, args = _) |>
magrittr::set_colnames(c("name", "eqn", "alias")) |>
as.data.frame()
# Create new equation if alias is defined; alias can now be discarded
custom_units_df[["eqn"]] <- ifelse(nzchar(custom_units_df[["alias"]]),
paste0(custom_units_df[["eqn"]], " ", custom_units_df[["alias"]]),
custom_units_df[["eqn"]]
)
# Clean units and keep mapping between old and new unit
name_translation <- lapply(custom_units_df[["name"]], function(y) {
clean_unit(y, regex_units, ignore_case = TRUE, include_translation = TRUE, unit_name = TRUE)
})
eqn_translation <- lapply(custom_units_df[["eqn"]], function(y) {
clean_unit(y, regex_units, ignore_case = TRUE, include_translation = TRUE)
})
# Add translated units
custom_units_df[["new_name"]] <- unlist(lapply(name_translation, `[[`, "x_new"))
custom_units_df[["new_eqn"]] <- unlist(lapply(eqn_translation, `[[`, "x_new"))
# Remove custom units of which all parts already exist
idx_keep <- lapply(seq_along(name_translation), function(i) {
x <- name_translation[i]
# Check whether all parts already exist; only check for parts with letters in them
not_all_parts_exist <- !all(x[["x_parts"]][grepl("[a-zA-Z]", x[["x_parts"]])] %in% c(custom_units_df[["new_name"]][-i], unname(regex_units)))
# If the equation isn't zero, the existing unit is otherwise defined
not_all_parts_exist | custom_units_df[["new_eqn"]][i] != "1"
}) |> unlist()
if (any(idx_keep)) {
custom_units_df <- custom_units_df[idx_keep, ]
# Create list of model units to add
# Both name and eqn now need to be cleaned and split into parts; we cannot define units with a name such as "whales^2"; instead we should define "whale"
add_model_units <- detect_undefined_units(sfm,
new_eqns = "",
new_units = c(
custom_units_df[["new_name"]],
custom_units_df[["new_eqn"]]
),
regex_units = regex_units, R_or_Julia = "R"
)
# Create list with custom unit definitions
custom_units_list <- lapply(seq_len(nrow(custom_units_df)), function(i) {
custom_unit <- custom_units_df[i, ][["new_name"]]
list(name = custom_unit, eqn = custom_units_df[i, ][["new_eqn"]], prefix = FALSE)
}) |> stats::setNames(custom_units_df[["new_name"]])
# Add to regex dictionary
custom_dict <- c(
unlist(lapply(name_translation, `[[`, "x_parts")),
unlist(lapply(eqn_translation, `[[`, "x_parts"))
)
custom_dict <- custom_dict[unname(custom_dict) %in% names(add_model_units)]
custom_dict <- custom_dict[!duplicated(custom_dict)] # Remove duplicate entries
if (length(custom_dict)) {
names(custom_dict) <- paste0("^", stringr::str_escape(names(custom_dict)), "$")
regex_units <- c(custom_dict, regex_units)
}
# Create custom model units
sfm[["model_units"]] <- add_model_units |>
# Overwrite units which already have a definition in custom_units
utils::modifyList(custom_units_list[names(custom_units_list) %in% names(add_model_units)])
}
}
sfm[["model_units_str"]] <- NULL
# Define function to clean units contained in curly brackets
clean_units_curly <- function(x, regex_units) {
# First check if there are any curly brackets
if (!grepl("\\{", x)) {
return(x)
}
# Get indices of curly brackets
paired_idxs <- get_range_all_pairs(x, var_names, type = "curly", names_with_brackets = TRUE)
if (nrow(paired_idxs) == 0) {
return(x)
}
# At least one letter needs to be in between the curly brackets and there cannot be commas
paired_idxs <- paired_idxs[stringr::str_detect(paired_idxs[["match"]], "[a-zA-Z]") &
!stringr::str_detect(paired_idxs[["match"]], ","), ]
if (nrow(paired_idxs) == 0) {
return(x)
}
# Apply clean unit here already, because Insight Maker doesn't care about case, though it will also be applied when converting equations
# Find replacements by applying clean_unit()
replacements <- lapply(
seq.int(nrow(paired_idxs)),
function(i) {
# Remove curly brackets
# Insight Maker treats units as case-insensitive
stringr::str_sub(tolower(x), paired_idxs[i, "start"] + 1, paired_idxs[i, "end"] - 1) |>
clean_unit(regex_units, ignore_case = TRUE)
}
)
# Replace in reverse order
for (i in rev(seq.int(nrow(paired_idxs)))) {
stringr::str_sub(x, paired_idxs[i, "start"], paired_idxs[i, "end"]) <- paste0("u(\"", replacements[[i]], "\")")
}
return(x)
}
# Replace units in macros - only one macro in case of Insight Maker model
sfm[["global"]][["eqn"]] <- clean_units_curly(sfm[["global"]][["eqn"]], regex_units)
# Replace units in equations and unit definition
sfm[["model"]][["variables"]] <- lapply(sfm[["model"]][["variables"]], function(y) {
lapply(y, function(x) {
if (is_defined(x[["eqn"]])) {
x[["eqn"]] <- clean_units_curly(x[["eqn"]], regex_units)
}
if (is_defined(x[["units"]])) {
x[["units"]] <- clean_unit(tolower(x[["units"]]), regex_units, ignore_case = TRUE)
}
return(x)
})
})
# Ensure all units are defined
add_model_units <- detect_undefined_units(sfm,
new_eqns = c(
sfm[["model"]][["variables"]] |>
lapply(function(x) {
lapply(x, `[[`, "eqn")
}) |> unlist(),
sfm[["global"]][["eqn"]],
unlist(lapply(sfm[["macro"]], `[[`, "eqn"))
),
new_units = unlist(sfm[["model"]][["variables"]] |>
lapply(function(x) {
lapply(x, `[[`, "units")
})),
regex_units = regex_units, R_or_Julia = "R"
)
sfm[["model_units"]] <- utils::modifyList(add_model_units, sfm[["model_units"]])
sfm <- validate_xmile(sfm)
return(sfm)
}
#' Check non-negative Stocks and Flows
#'
#' @inheritParams build
#' @inheritParams insightmaker_to_sfm
#'
#' @returns Updated sfm
#' @noRd
#'
check_nonnegativity <- function(sfm, keep_nonnegative_flow, keep_nonnegative_stock, keep_solver) {
# Non-negative Stocks and Flows
if (length(sfm[["model"]][["variables"]][["stock"]]) == 0) {
return(sfm)
}
nonneg_stock <- which(unlist(lapply(sfm[["model"]][["variables"]][["stock"]], `[[`, "non_negative")))
if (keep_nonnegative_stock & length(nonneg_stock) > 0) {
if (!keep_solver & sfm[["sim_specs"]][["method"]] == "rk4") {
message("Non-negative Stocks detected! Switching the ODE solver to Euler to ensure Insight Maker and sdbuildR produce the same output. Turn off by setting keep_solver = TRUE.")
sfm[["sim_specs"]][["insightmaker_method"]] <- sfm[["sim_specs"]][["method"]]
sfm[["sim_specs"]][["method"]] <- "euler"
}
}
return(sfm)
}
#' Convert global Insight Maker script to macros
#'
#' @inheritParams build
#' @inheritParams clean_unit
#'
#' @returns Updated stock-and-flow model with macros
#' @noRd
convert_macros_IM_wrapper <- function(sfm, regex_units) {
if (nzchar(sfm[["global"]][["eqn"]])) {
# Convert each equation and create list of model elements to add
var_names <- get_model_var(sfm)
sfm <- replace_macro_names_IM(sfm)
# Convert equations in macro
out <- convert_equations_IM(
type = "global",
name = "global",
eqn = sfm[["global"]][["eqn"]],
var_names = var_names,
regex_units = regex_units
)
if (.sdbuildR_env[["P"]][["debug"]]) {
message(out)
}
sfm[["global"]][["eqn"]] <- unname(unlist(out[["global"]][["global"]][["eqn"]]))
# Extract names and separate equations
sfm <- split_macros_IM(sfm)
}
# Remove placeholder
sfm[["global"]] <- NULL
return(sfm)
}
#' Replace Insight Maker names in macros with syntactically valid names
#'
#' @inheritParams build
#'
#' @returns Updated stock-and-flow model with replaced macro names all throughout the model
#' @noRd
replace_macro_names_IM <- function(sfm) {
eqn <- sfm[["global"]][["eqn"]]
# Get names of all model elements
var_names <- get_model_var(sfm)
# Variables cannot be the same name as Insight Maker functions
IM_func_names <- get_syntax_IM()[["conv_df"]][["insightmaker"]]
# Find functions
functions <- stringr::str_locate_all(eqn, stringr::regex("(\\n|^)[ ]*function\\b", ignore_case = TRUE))[[1]]
# For each <-, find preceding \n and next <-
newlines <- unique(c(1, stringr::str_locate_all(eqn, "\\n")[[1]][, "start"], nchar(eqn)))
assignment_op <- stringr::str_locate_all(eqn, "<-")[[1]]
# Exclude <- & \n in comments and strings
seq_quot <- get_seq_exclude(eqn, var_names = NULL, type = "quot")
functions <- functions[!(functions[, "start"] %in% seq_quot), , drop = FALSE]
assignment_op <- assignment_op[!(assignment_op[, "start"] %in% seq_quot), , drop = FALSE]
newlines <- newlines[!(newlines %in% seq_quot)]
# Merge functions and assignments
assignment <- rbind(assignment_op, functions)
assignment <- assignment[order(assignment[, "start"]), , drop = FALSE]
if (nrow(assignment) > 0 & length(newlines) > 0) {
# Find preceding newline before assignment
start_idxs <- vapply(assignment[, "start"], function(idx) {
idxs_newline <- which(newlines <= idx)
newlines[idxs_newline[length(idxs_newline)]] # select last newline before assignment
}, numeric(1))
# Split macros by assignment
split_macros <- lapply(seq_len(nrow(assignment)), function(i) {
# Extract equation indices
start_eqn <- start_idxs[i]
end_eqn <- ifelse(i == nrow(assignment), nchar(eqn), start_idxs[i + 1] - 1)
# Extract name
name_insightmaker <- trimws(stringr::str_sub(eqn, start_eqn, assignment[i, "start"] - 1))
is_multiline_function <- stringr::str_detect(
stringr::str_sub(eqn, start_eqn, start_eqn + nchar("function")),
stringr::regex("function", ignore_case = TRUE)
)
names_arg <- names_arg_insightmaker <- c()
if (is_multiline_function) {
# Extract function name; In a multiline function, the function name comes after function
sub_eqn <- stringr::str_sub(eqn, start_eqn, end_eqn)
name_insightmaker <- trimws(sub("^function", "", sub("\\(.*", "", sub_eqn, ignore.case = TRUE), ignore.case = TRUE))
# Variables cannot be the same name as Insight Maker functions
name <- clean_name(name_insightmaker,
# Normally, names_df is specified here
var_names,
protected = c(
IM_func_names, tolower(IM_func_names),
toupper(IM_func_names)
)
)
# Add opening bracket
name_insightmaker <- paste0(name_insightmaker, "(")
name <- paste0(name, "(")
} else {
# Take care of function assignment
is_function <- stringr::str_detect(name_insightmaker, "\\(")
if (is_function) {
# Extract argument names
arg <- trimws(stringr::str_extract(name_insightmaker, "\\(.*\\)$"))
arg <- parse_args(stringr::str_replace_all(arg, c("^\\(" = "", "\\)$" = "")))
# Find names and values of arguments
contains_name <- stringr::str_detect(arg, "=")
arg_split <- stringr::str_split_fixed(arg, "=", n = 2)
names_arg_insightmaker <- arg_split[, 1]
names_arg <- clean_name(names_arg_insightmaker,
# Normally, names_df is specified here
var_names,
protected = c(
IM_func_names, tolower(IM_func_names),
toupper(IM_func_names)
)
)
# Extract function name, but add opening bracket
name_insightmaker <- trimws(sub("\\(.*", "", name_insightmaker))
name <- clean_name(name_insightmaker,
# Normally, names_df is specified here
var_names,
protected = c(
IM_func_names, tolower(IM_func_names),
toupper(IM_func_names)
)
)
# Add opening bracket
name_insightmaker <- paste0(name_insightmaker, "(")
name <- paste0(name, "(")
} else {
# Variables cannot be the same name as Insight Maker functions
name <- clean_name(name_insightmaker,
# Normally, names_df is specified here
var_names,
protected = c(
IM_func_names, tolower(IM_func_names),
toupper(IM_func_names)
)
)
}
}
z <- list(
start_eqn = start_eqn,
end_eqn = end_eqn,
name = name,
name_insightmaker = name_insightmaker,
names_arg = names_arg,
names_arg_insightmaker = names_arg_insightmaker
)
return(z)
})
# Replace argument names only in those parts that are functions. This needs to be done after split_macros to preserve indices.
# Reverse order indices
for (i in rev(seq_len(nrow(assignment)))) {
if (length(split_macros[[i]][["names_arg"]]) > 0) {
# Construct replacement dictionary for replacing argument names in this equation
dict <- stats::setNames(split_macros[[i]][["names_arg"]], paste0("\\b", stringr::str_escape(split_macros[[i]][["names_arg_insightmaker"]]), "\\b"))
# Important! Don't simply replace names, as some names may be in (unit) strings.
# Even arguments are not case-sensitive
stringr::str_sub(eqn, split_macros[[i]][["start_eqn"]], split_macros[[i]][["end_eqn"]]) <- replace_safely(
eqn = stringr::str_sub(eqn, split_macros[[i]][["start_eqn"]], split_macros[[i]][["end_eqn"]]),
dict = dict,
var_names = var_names,
ignore_case = TRUE
)
}
}
# Construct replacement dictionary for replacing names in macros and other equations
# Important: even if the name did not need to be changed, still apply dict because of differences in case
old_names <- vapply(split_macros, `[[`, character(1), "name_insightmaker")
new_names <- vapply(split_macros, `[[`, character(1), "name")
dict <- stats::setNames(new_names, paste0("\\b", stringr::str_escape(old_names), "\\b"))
# Insight Maker is not case-sensitive!
# Important! Don't simply replace names, as some names may be in (unit) strings.
sfm[["global"]][["eqn"]] <- replace_safely(
eqn = sfm[["global"]][["eqn"]],
dict = dict,
var_names = var_names, ignore_case = TRUE
)
# Use same dictionary to replace macro names in other equations
# Replace units in equations and unit definition
sfm[["model"]][["variables"]] <- lapply(sfm[["model"]][["variables"]], function(y) {
lapply(y, function(x) {
if (is_defined(x[["eqn"]])) {
# Important! Don't simply replace names, as some names may be in (unit) strings.
x[["eqn"]] <- replace_safely(
eqn = x[["eqn"]],
dict = dict,
var_names = var_names, ignore_case = TRUE
)
}
return(x)
})
})
}
return(sfm)
}
#' Replace dictionary matches in equation safely
#'
#' @param eqn Equation
#' @param dict Dictionary
#' @param var_names Variable names
#' @param ignore_case If TRUE, ignore case. Defaults to TRUE.
#'
#' @returns Updated equation
#' @noRd
replace_safely <- function(eqn, dict, var_names, ignore_case = TRUE) {
# Remove those matches that are in quotation marks or names
idxs_exclude <- get_seq_exclude(eqn, var_names)
idx_df <- lapply(seq_along(dict), function(i) {
matches <- gregexpr(names(dict)[i], eqn, perl = TRUE, ignore.case = ignore_case)[[1]]
if (matches[1] == -1) {
return(data.frame(start = integer(), end = integer()))
} else {
data.frame(
match = rep(names(dict)[i], length(matches)),
replacement = rep(unname(dict)[i], length(matches)),
start = as.integer(matches),
end = as.integer(matches + attr(matches, "match.length") - 1)
)
}
}) |>
do.call(rbind, args = _) |>
as.data.frame()
if (nrow(idx_df) > 0) idx_df <- idx_df[!(idx_df[["start"]] %in% idxs_exclude | idx_df[["end"]] %in% idxs_exclude), ]
if (nrow(idx_df) > 0) {
# Replace in reverse order
for (i in rev(seq.int(nrow(idx_df)))) {
stringr::str_sub(eqn, idx_df[i, "start"], idx_df[i, "end"]) <- idx_df[i, "replacement"]
}
}
return(eqn)
}
#' Split macro equation and names
#'
#' @inheritParams build
#'
#' @returns Updated stock-and-flow model with split macros
#' @noRd
split_macros_IM <- function(sfm) {
eqn <- sfm[["global"]][["eqn"]]
assignment <- stringr::str_locate_all(eqn, "=")[[1]]
newlines <- unique(c(1, stringr::str_locate_all(eqn, "\\n")[[1]][, "start"], nchar(eqn)))
# Exclude <- & \n in comments and strings
seq_quot <- get_seq_exclude(eqn, var_names = NULL, type = "quot")
assignment <- assignment[!(assignment[, "start"] %in% seq_quot), , drop = FALSE]
newlines <- newlines[!(newlines %in% seq_quot)]
if (nrow(assignment) > 0) {
# Identify curly brackets to exclude assignment matches in for-loops, while-loops, ifelse etc.
paired_idxs <- get_range_all_pairs(eqn, var_names = NULL, type = "curly", names_with_brackets = FALSE)
if (nrow(paired_idxs) > 0) {
idxs_curly <- unlist(mapply(seq, paired_idxs[, "start"], paired_idxs[, "end"], SIMPLIFY = FALSE))
assignment <- assignment[!(assignment[, "start"] %in% idxs_curly), , drop = FALSE]
newlines <- newlines[!(newlines %in% idxs_curly)]
}
# Find preceding newline before assignment
start_idxs <- vapply(assignment[, "start"], function(idx) {
idxs_newline <- which(newlines <= idx)
newlines[idxs_newline[length(idxs_newline)]] # select last newline before assignment
}, numeric(1))
# Split macros by assignment
split_macros <- lapply(seq_len(nrow(assignment)), function(i) {
# Extract equation indices
start_eqn <- start_idxs[i]
end_eqn <- ifelse(i == nrow(assignment), nchar(eqn), start_idxs[i + 1] - 1)
# Extract name
name <- trimws(stringr::str_sub(eqn, start_eqn, assignment[i, "start"] - 1))
sub_eqn <- trimws(stringr::str_sub(eqn, assignment[i, "end"] + 1, end_eqn))
return(list(name = name, eqn = sub_eqn))
})
new_macros <- stats::setNames(split_macros, vapply(split_macros, `[[`, character(1), "name"))
# Add original equation and documentation to first macro - it will be deleted afer
new_macros[[1]][["eqn_insightmaker"]] <- sfm[["global"]][["eqn_insightmaker"]]
new_macros[[1]][["doc"]] <- sfm[["global"]][["doc"]]
sfm[["macro"]] <- new_macros
}
return(sfm)
}
#' Convert Insight Maker equations to R code
#'
#' @inheritParams build
#' @inheritParams clean_unit
#'
#' @returns Updated stock-and-flow model with converted equations to R.
#' @noRd
#'
convert_equations_IM_wrapper <- function(sfm, regex_units) {
# Convert each equation and create list of model elements to add
var_names <- get_model_var(sfm)
unlist_vars <- unlist(unname(sfm[["model"]][["variables"]][c("stock", "aux", "flow")]),
recursive = FALSE
)
# add_model_elements1 <- lapply(unlist_vars, function(x) {
# if (.sdbuildR_env[["P"]][["debug"]]) {
# message(x[["name"]])
# message(x[["eqn"]])
# }
#
# # Convert equation
# out <- convert_equations_IM(
# type = x[["type"]],
# name = x[["name"]],
# eqn = x[["eqn"]],
# var_names = var_names,
# regex_units = regex_units
# )
#
# if (.sdbuildR_env[["P"]][["debug"]]) {
# message(out)
# }
#
# return(out)
# }) |>
# purrr::flatten()
#
#
#
# add_model_elements1 <- lapply(add_model_elements, function(x) {
# z <- names(x)
# lapply(seq_along(x), function(i) {
# y <- x[[i]]
# name <- names(x)[i]
# y[["name"]] <- name
# return(y)
# }) |> stats::setNames(z)
# })
# Extract all fields as vectors (much faster than repeated list access)
types <- vapply(unlist_vars, `[[`, character(1), "type")
names <- vapply(unlist_vars, `[[`, character(1), "name")
eqns <- vapply(unlist_vars, `[[`, character(1), "eqn")
# Call function with vectorized arguments
add_model_elements <- Map(
convert_equations_IM,
type = types,
name = names,
eqn = eqns,
MoreArgs = list(
var_names = var_names,
regex_units = regex_units
)
) |>
purrr::flatten()
# Add name
add_model_elements <- lapply(add_model_elements, function(x) {
for (i in seq_along(x)) {
x[[i]][["name"]] <- names(x)[i]
}
x
})
# Add to sfm
for (i in seq_along(add_model_elements)) {
sfm[["model"]][["variables"]] <- sfm[["model"]][["variables"]] |>
utils::modifyList(add_model_elements[i])
}
sfm <- validate_xmile(sfm)
return(sfm)
}
#' Remove brackets around R names
#'
#' Add units and add sources for graphical functions
#'
#' @inheritParams clean_units_IM
#' @inheritParams build
#'
#' @returns Updated sfm
#' @noRd
#'
remove_brackets_from_names <- function(sfm) {
# Remove brackets
var_names <- get_model_var(sfm)
dict <- stringr::fixed(stats::setNames(var_names, paste0("[", var_names, "]")))
sfm[["model"]][["variables"]] <- lapply(sfm[["model"]][["variables"]], function(y) {
lapply(y, function(x) {
x[["eqn"]] <- stringr::str_replace_all(x[["eqn"]], dict)
return(x)
})
})
return(sfm)
}
#' Split auxiliaries into static parameters or dynamic variables
#'
#' @inheritParams build
#'
#' @returns Vector of variable names that are constants
#' @noRd
#'
split_aux_wrapper <- function(sfm) {
# Get names
var_names <- get_model_var(sfm)
# Separate auxiliary variables into static parameters and dynamically updated auxiliaries
dependencies <- lapply(sfm[["model"]][["variables"]][["aux"]], `[[`, "eqn") |>
find_dependencies_(sfm, eqns = _, only_model_var = FALSE)
# Constants are not dependent on time, have no dependencies in names, or are only dependent on constants
temp <- dependencies
temp <- temp[vapply(temp, function(x) {
(!.sdbuildR_env[["P"]][["time_name"]] %in% x) & (length(intersect(x, var_names)) == 0)
}, logical(1))]
constants <- names(temp)
rm(temp)
# Iteratively find constants
done <- FALSE
if (!done) {
old_constants <- constants
# Are there any remaining auxiliary variables to be split into constants or aux?
remaining_aux <- setdiff(names(sfm[["model"]][["variables"]][["aux"]]), constants)
if (length(remaining_aux) == 0) {
done <- TRUE
} else {
new_constants <- dependencies[remaining_aux] |>
purrr::keep(function(x) {
(!.sdbuildR_env[["P"]][["time_name"]] %in% x) & all(intersect(x, var_names) %in% constants)
})
constants <- c(constants, names(new_constants))
# While-loop ends if there is no change
if (setequal(old_constants, constants)) {
done <- TRUE
}
}
}
sfm[["model"]][["variables"]][["constant"]] <- sfm[["model"]][["variables"]][["aux"]][constants]
sfm[["model"]][["variables"]][["aux"]][constants] <- NULL
sfm[["model"]][["variables"]][["constant"]] <- lapply(
sfm[["model"]][["variables"]][["constant"]],
function(x) {
x[["type"]] <- "constant"
return(x)
}
)
sfm <- validate_xmile(sfm)
return(sfm)
}
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.