R/insightmaker_conv.R

Defines functions split_aux_wrapper remove_brackets_from_names convert_equations_IM_wrapper split_macros_IM replace_safely replace_macro_names_IM convert_macros_IM_wrapper check_nonnegativity clean_units_IM replace_names_IM prep_eqn_IM IM_to_xmile url_to_IM

Documented in url_to_IM

#' 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("&nbsp;", " ", 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)
}

Try the sdbuildR package in your browser

Any scripts or data that you put into this service are public.

sdbuildR documentation built on Nov. 19, 2025, 5:07 p.m.