R/DexiModels.R

In DEXiR: 'DEXi' Library

#' @include DexiClasses.R
#' @include DexiUtils.R
#' @include DexiData.R

EnumAssoc <- c("down", "up")

#' DexiModel
#'
#' `DexiModel` is a RC class representing a DEXi model in R.
#'
#' Normally, `DexiModel` objects are created by reading from a `.dxi` file,
#' previously developed by the DEXi software. In principle, all fields of a `DexiModel`
#' should be considered read-only. DEXiR does not provide any explicit
#' functionality for creating and changing DEXi models in R. Of course, models can still be created
#' and modified in R, but without integrity and consistency guarantees.
#'
#' @field name character. Name of the model.
#' @field description character. An optional textual description of the model.
#' @field linking logical. Indicates whether or not the model uses linked attributes,
#' which are used in DEXi to represent hierarchies of attributes (i.e., directed acyclic graphs) rather than trees.
#' @field root [DexiAttribute]. The virtual root of all subtrees/hierarchies of attributes in the model.
#' @field attributes list. A list of all [DexiAttribute]s that constitute the model.
#' @field att_names character. A list of all attribute names, as defined in the original DEXi model. Notice that
#' these names may contain whitespace and other "strange" characters, and may not be unique.
#' @field att_ids character. A list of unique attribute IDs generated by DEXiR from `att_names`
#' using \code{\link[base]{make.unique}}. When using the DEXiR package, it is strongly advised to refer to
#' attributes with their IDs rather than DEXi names.
#' @field basic list. A list of all basic (input) [DexiAttribute]s in the model.
#' @field aggregate list. A list of all aggregate (output) [DexiAttribute]s in the model.
#' @field links list. A list of all linked [DexiAttribute]s in the model.
#' @field basic_ids character. A vector of all basic attributes' unique names.
#' @field aggregate_ids character.  A vector of all aggregate attributes' unique names.
#' @field link_ids character. A vector of all linked attributes' unique names.
#' @field alternatives data.frame. A data frame representing decision alternatives contained
#'  in the `.dxi` file.
#'
#' @export DexiModel
#'
#' @examples
#' # Get ".dxi" file name
#' CarDxi <- system.file("extdata", "Car.dxi", package = "DEXiR")
#'
#' # Read DEXi model
#' Car <- read_dexi(CarDxi)
#'
#' # Print fields of Car
#' Car
#' Car$verify()
#' Car$name
#' Car$description
#' Car$linking
#' att_names(Car$attributes)
#' Car$att_names
#' Car$att_ids
#' Car$basic_ids
#' Car$aggregate_ids
#' Car$att_stat()
#' Car$scale(Car$aggregate)
#'
#' # Find some attributes in the model
#' Car$first()
#' Car$attributes[[3]]
#' Car$attrib("PRICE")
#' Car$att_index("PRICE")
#'
#' # Display alternatives loaded from "Car.dxi"
#' Car$alternatives
#' Car$as_character(Car$alternatives)
#' Car$as_character(Car$alternatives, transpose = TRUE)
#' Car$as_character(Car$alternatives, transpose = TRUE, structure = TRUE)
#'
#' # Define and evaluate a decision alternative (some car)
#' alt <- Car$alternative("MyCar",
#'          BUY.PRICE="low", MAINT.PRICE=2, X.PERS=3, X.DOORS=3, LUGGAGE="medium", SAFETY=2)
#' Car$evaluate(alt)
#' Car$as_character(Car$evaluate(alt))
#'
#' # Employ the set-based evaluation (notice how the value of SAFETY propagates upwards to TECH.CHAR.)
#' alt <- Car$alternative("MyCar",
#'          BUY.PRICE="low", MAINT.PRICE=2, X.PERS=3, X.DOORS=3, LUGGAGE="medium", SAFETY=c(2,3))
#' Car$evaluate(alt)
#' Car$as_character(Car$evaluate(alt))
#'
#' # Analysis of alternatives
#' Car$selective_explanation(1)
#' Car$selective_explanation(alt)
#' Car$plus_minus(alt)
#' Car$compare_alternatives(alt)
#' Car$compare_alternatives(1, 2)
#' Car$compare_alternatives(1, alt)
#'
#' @seealso \code{\link[DEXiR]{evaluate}}, \code{\link[DEXiR]{set_alternative}}, [read_dexi()]
#'
DexiModel <- setRefClass(DexiModelClass,
  fields = list(
    name = "character",
    description = "character",
    linking = "logical",
    root = "ANY", # of DexiAttribute
    attributes = "list",
    att_names = "character",
    att_ids = "character",
    basic = "list",
    aggregate = "list",
    links = "list",
    basic_ids = "character",
    aggregate_ids = "character",
    link_ids = "character",
    alternatives = "data.frame"
  ),

  methods = list(
    initialize = function(
      name = "",
      description = "",
      root = NULL,
      linking = FALSE,
      ...)
    {
      "Initialize a \\code{DexiModel} object."
      name <<- name
      description <<- description
      root <<- root
      linking <<- linking
      setup()
    },

    verify = function() {
      "Check the correctnes of a \\code{DexiModel} object and its fields. Result: \\code{error()} or \\code{TRUE}."
      stopifnot(is_single_character_or_null(name))
      stopifnot(is_single_character_or_null(description))
      stopifnot(is_class_or_null(root, DexiAttributeClass))
      TRUE
    },

    setup = function () {
      "Called by \\code{initialize()} as the last step that establishes consistent internal data structures by
      making unique attribute IDs, linking attributes (if required), making lists of attributes and their IDs,
      and creating a data frame of alternatives."

      stopifnot(is_class(root, DexiAttributeClass))

      # parent
      for (a in root$inputs) a$parent <- root
      root$parent <<- .self

      attributes <<- collect_attributes(root)
      att_names <<- sapply(attributes, function (x) x$name)
      att_ids <<- unique_names(att_names, reserved = c("name", "structure", "description"))

      # set ids
      for (i in seq_increasing(1, length(attributes))) attributes[[i]]$id <<- att_ids[[i]]

      # linking
      if (linking) link_attributes()

      # sublists
      basic <<- attributes[sapply(attributes, function (att) att$is_basic())]
      aggregate <<- attributes[sapply(attributes, function (att) (!identical(att, root) && att$is_aggregate()))]
      links <<- attributes[sapply(attributes, function (att) att$is_link())]

      basic_ids <<- as.character(att_names(basic))
      aggregate_ids <<- as.character(att_names(aggregate))
      link_ids <<- as.character(att_names(links))

      # alternatives
      len <- sapply(attributes, function(att) length(att$.alternatives))
      max_len <- max(len)
      names <- att_ids
      if (length(names) >= 1) names[[1]] <- "name"
      if (max_len == 0) {
        alts <- data.frame(matrix(ncol = length(attributes), nrow = 0))
      }
      else
      {
        alts <- as.data.frame(
                  sapply(attributes, function(att) att$.alternatives[seq_increasing(1, max_len)]))
      }
      colnames(alts) <- names
      alternatives <<- alts
    },

    first = function() {
      "Return first non-virtual model attribute, i.e., first descendant of model$root."

      if (is.null(root) || length(root) == 0) return(NULL)
      else return(root$inputs[[1]])
    },

    att_stat = function() {
      "Count the number of all attributes (including the virtual root),
      as well as the number of basic, aggregate and linked attributes in the model.
      Result: a list of the form list(all=..., basic=..., aggregate=..., link=...)."

      list(
        all = length(attributes),
        basic = length(basic),
        aggregate = length(aggregate),
        link = length(links)
      )
    },

    att_index = function(atts, use_id = TRUE) {
      "Find the indices of attributes.
      \\code{atts} is a character vector of attribute IDs (when \\code{use_id = TRUE}) or original DEXi attribute
      names (when \\code{use_id = FALSE}). Result: a numeric vector containing the set of indices.
      Example: \\code{Car$att_index(c(\"PRICE\", \"TECH.CHAR.\"))}"

      stopifnot(is.character(atts))
      names <- if (use_id) att_ids else att_names
      c(which(names %in% atts))
    },

    attrib = function(atts) {
      "A general function for finding attributes in the model. \\code{atts} is a vector or list of
      \\code{DexiAttribute}s, attribute indices (integer) or attribute IDs (character).
      Result: a list of found \\code{DexiAttribute}s (or \\code{NA}s if not found).
      Example: \\code{Car$attrib(list(5, \"PRICE\", \"TECH.CHAR.\"))}"

      if (is_class(atts, DexiAttributeClass)) {
        result <- atts
      } else {
        result <- sapply(atts,
                  function(att) {
                    att <-
                      if (is.null(att)) NULL
                      else if (is_class(att, DexiAttributeClass)) att
                      else if (is_empty(att) || !is_single(att)) NA
                      else if (is.character(att)) attributes[att_index(att)]
                      else if (is_in_range(att, 1, length(attributes))) attributes[[att]]
                      else NA;
                   if (is_empty(att)) NA else if (is_class(att, DexiAttributeClass)) att else att[[1]]
                 }
                )
        result <- un_list(result)
      }
      result
    },

    scale = function(atts) {
      "Find attribute scales. \\code{atts} is a vector of \\code{DexiAttribute}s.
      Result: a vector of the corresponding \\code{\\link{DexiScale}}s (or \\code{NA}s)."

      atts <- attrib(atts)
      scales <- sapply(atts,
                  function (att) {
                    if (is_empty(att) || is_empty(att$scale)) NA else att$scale
                  }
                )
      un_list(scales)
    },

    alternative = function(name = "NewAlternative", ...) {
      "Create a data frame containing data of one decision alternative.
      \\code{name}, character(1), represents the alternative's name. The arguments \\code{...}
      define the alternative's values to be put in the data frame.
      Please see \\code{\\link{set_alternative}} for the syntax of \\code{...}."

      alt <- data.frame(matrix(ncol = length(attributes), nrow = 1))
      if (is.character(name)) alt[[1,1]] <- name
      colnames(alt) <- colnames(alternatives)
      alt[sapply(alt, is.na)] <- lapply(alt[sapply(alt, is.na)], as.list)
      if (!missing(...)) alt <- set_alternative(.self, alt, ...)
      alt
    },

    as_character = function(alt, transpose = FALSE, structure = FALSE, round = NULL) {
      "The argument \\code{alt} is assumed to be a data frame containing data of one or more decision alternatives
      with values represented by numeric vectors. \\code{as_character(alt)} transforms the values of
      \\code{alt} into a more human-readable form using character strings.
      Additionally, \\code{transpose = TRUE} transposes the data frame,
      so that rows correspod to attributes and columns to alternatives.
      \\code{structure = TRUE} additionally displays the tree structure of attributes;
      the latter works only with \\code{transpose = TRUE}.
      \\code{round} denotes the number of decimal digits for printing numeric values."

      names <- names(alt)
      stopifnot(!is.na(names))
      if (typeof(alt) != "list") alt <- as.data.frame(as.list(alt))
      for (name in names) {
        att <- attrib(name)
        if (inherits(att, DexiAttributeClass)) {
          values <- alt[name][[1]]
          for (i in seq_increasing(1, length(values))) {
            values[[i]] <- value_text(values[[i]], att, round)
          }
          alt[name][[1]] <- values
        }
      }
      if (transpose && structure) {
        names <- sapply(names,
                  function (name) {
                    if (name == "name") return("structure")
                    att <- attrib(name)
                    if (inherits(att, DexiAttributeClass)) return(paste0(att$structure(), att$name))
                    return(name)
                  })
        names(alt) <- names
      }
      if (transpose) t(alt) else alt
    },

    evaluate = function(...) {
      "Calls \\code{\\link[DEXiR]{evaluate}(.self, ...)} to evaluate decision alternatives.
      Please see \\code{\\link[DEXiR]{evaluate}} for the description of \\code{...} arguments."

      DEXiR::evaluate(.self, ...)
    },

    convert = function(...) {
      "Calls \\code{\\link[DEXiR]{convert_alternatives}(.self, ...)} to convert decision alternatives' data.
      Please see \\code{\\link[DEXiR]{convert_alternatives}} for the description of \\code{...} arguments."

      DEXiR::convert_alternatives(.self, ...)
    },

    selective_explanation = function(...) {
      "Calls \\code{\\link[DEXiR]{selective_explanation}(.self, ...)} to carry out Selective Explanation.
      Please see \\code{\\link[DEXiR]{selective_explanation}} for the description of \\code{...} arguments."

      DEXiR::selective_explanation(.self, ...)
    },

    plus_minus = function(...) {
      "Calls \\code{\\link[DEXiR]{plus_minus}(.self, ...)} to carry out Plus-Minus Analysis.
      Please see \\code{\\link[DEXiR]{plus_minus}} for the description of \\code{...} arguments."

      DEXiR::plus_minus(.self, ...)
    },

    compare_alternatives = function(...) {
      "Calls \\code{\\link[DEXiR]{compare_alternatives}(.self, ...)} to carry out Comparison of Alternatives.
      Please see \\code{\\link[DEXiR]{compare_alternatives}} for the description of \\code{...} arguments."

      DEXiR::compare_alternatives(.self, ...)
    },

    show = function() {
      "Prints out the structure of the model and its components."
      cat("DEXi Model: ", name, "\n")
      if (!is.null(description) && description != "") cat("Description:", description, "\n")

      indices <- sapply(seq_increasing(1, length(attributes)), function (i) paste0("[",i,"]"))
      w_indices <- max(nchar("index"), max(nchar(indices)))
      w_att_ids <- max(nchar("id"), max(nchar(att_ids)))
      tree <- sapply(attributes, function (att) att$structure())
      w_tree <- max(nchar(tree))
      w_att_names <- max(nchar("structure"), max(nchar(att_names)))
      struct <- sapply(seq_increasing(1, length(attributes)), function (i) paste0(tree[[i]], " ", att_names[[i]]))
      if (length(struct) >= 1) struct[[1]] <- stringr::str_trim(struct[[1]])
      w_struct <- max(nchar("structure"),  max(nchar(struct)))
      scale <- sapply(attributes, function (att) if (is.null(att$scale)) "" else att$scale$to_string())
      w_scale <- max(nchar("scale"),  max(nchar(scale)))
      funct <- sapply(attributes, function (att) if (is.null(att$funct)) "" else att$funct$to_string())
      w_funct <- max(nchar("funct"),  max(nchar(funct)))
      link <- sapply(attributes, function (att) if (is.null(att$link)) "" else att$link$id)
      w_link <- max(nchar("link"),  max(nchar(link)))

      cat(stringr::str_pad("index", w_indices), "")
      cat(stringr::str_pad("id", w_att_ids, side = "right"), "")
      cat(stringr::str_pad("structure", w_struct, side = "right"), "")
      if (linking && length(link) > 0) cat(stringr::str_pad("link", w_link, side = "right"), "")
      cat(stringr::str_pad("scale", w_scale, side = "right"), "")
      cat(stringr::str_pad("funct", w_funct, side = "right"), "")
      cat("\n")
      for (i in seq_increasing(1, length(attributes))) {
        cat(stringr::str_pad(indices[[i]], w_indices), "")
        cat(stringr::str_pad(att_ids[[i]], w_att_ids, side = "right"), "")
        cat(stringr::str_pad(struct[[i]], w_struct, side = "right"), "")
        if (linking && length(link) > 0)  cat(stringr::str_pad(link[[i]], w_link, side = "right"), "")
        cat(stringr::str_pad(scale[[i]], w_scale, side = "right"), "")
        cat(stringr::str_pad(funct[[i]], w_funct, side = "right"), "")
        cat("\n")
      }
      if (nrow(alternatives) > 0) {
        cat("\nAlternatives:\n")
        print(alternatives)
      }
    },

    link_attributes = function() {
      "Carries out the linking of attributes.
      DEXi attributes that have the same names and value scales,
      and satisfy some other constraints to prevent making cycles in the model,
      are linked together so that they logically represent a single attribute.
      In this way, a tree of attributes is conceptually turned in a hierarchy (directed acyclic graph).
      If \\code{linking = TRUE}, \\code{link_attributes} is called by \\code{setup()} after reading the model."

      lapply(attributes, function (att) {att$link <- NULL})
      for (i in seq_increasing(2, length(attributes))) {
        link_attribute(.self, attributes[[i]])
      }
    }

  )
)

# Linking helper functions

link_candidates <- function (model, name) {
  stopifnot(inherits(model, DexiModelClass))
  stopifnot(is_single_character(name))
  model$attributes[model$att_index(name, use_id = FALSE)]
}

link_attribute_by_name = function (model, name) {
  stopifnot(inherits(model, DexiModelClass))
  stopifnot(is_single_character(name))
  bas <- NULL
  agg <- NULL
  agg_count <- 0;
  candidates <- link_candidates(model, name)
  for (att in candidates) {
    if (!att$is_link()) {
      if (att$is_basic()) {
        bas <- att
      }
      else
      {
        agg <- att
        agg_count <- agg_count + 1
      }
    }
  }
  link <- if (!is.null(agg) && agg_count == 1) agg else bas
  link
}

link_attribute = function(model, att) {
  stopifnot(inherits(model, DexiModelClass))
  stopifnot(is_class(att, DexiAttributeClass))
  att$link <- NULL
  if (att$is_aggregate()) return()
  link <- link_attribute_by_name(model, att$name);
  if (!is.null(link)) {
    if (identical(att, link)) link <- NULL
    else if (att$affects(link)) link <- NULL
    else if (!equal_scales(att$scale, link$scale)) link <- NULL
    if (!is.null(link)) {
      att$link <- link
    }
  }
}

# Internal .dxi file reading helpers

read_dexi_continuous_scale <- function(scl_xml, order = "ascending") {
  low_point = -Inf
  high_point = +Inf
  items_xml <- xml2::xml_find_all(scl_xml, "LOW")
  if (length(items_xml) > 0) low_point <- xml2::xml_double(items_xml[[1]])
  items_xml <- xml2::xml_find_all(scl_xml, "HIGH")
  if (length(items_xml) > 0) high_point <- xml2::xml_double(items_xml[[1]])
  DexiContinuousScale(order = order, low_point = low_point, high_point = high_point)
}

read_dexi_discrete_scale <- function(scl_xml, order = "ascending") {
  nvals <- length(scl_xml)
  if (nvals == 0) return(NULL)
  values <- vector("list", length = nvals)
  descrs <- vector("list", length = nvals)
  quality <- vector("list", length = nvals)
  for (i in 1:nvals) {
    val_xml <- scl_xml[[i]]
    name_xml <- xml2::xml_find_all(val_xml, "NAME")
    values[[i]] <- if (length(name_xml) == 0) "undef" else xml2::xml_text(name_xml[[1]])
    descr_xml <- xml2::xml_find_all(val_xml, "DESCRIPTION")
    descrs[[i]] <- if (length(descr_xml) == 0) "" else xml2::xml_text(descr_xml[[1]])
    qual_xml <- xml2::xml_find_all(val_xml, "GROUP")
    quality[[i]] <- if (length(qual_xml) == 0) "none" else tolower(xml2::xml_text(qual_xml[[1]]))
  }
  DexiDiscreteScale(unlist(values), order = order, quality = unlist(quality), descriptions = unlist(descrs))
}

read_dexi_scale <- function(att_xml) {
  scl_xml <- xml2::xml_find_all(att_xml, "SCALE")
  if (length(scl_xml) == 0) return(NULL)

  order <- "ascending"
  items_xml <- xml2::xml_find_all(att_xml, "ORDER")
  if (length(items_xml) > 0 ) {
    ord <- xml2::xml_text(items_xml[[1]])
    if (ord == "DESC") order <- "descending" else if (ord == "NONE") order <- "none"
  }
  items_xml <- xml2::xml_find_all(scl_xml, "CONTINUOUS")
  if (length(items_xml) > 0 ) return(read_dexi_continuous_scale(items_xml, order))
  items_xml <- xml2::xml_find_all(scl_xml, "SCALEVALUE")
  if (length(items_xml) > 0 ) return(read_dexi_discrete_scale(items_xml, order))
  NULL
}

read_dexi_tabular_funct_def <- function(att_xml) {
  fnc_xml <- xml2::xml_find_all(att_xml, "FUNCTION")
  tab_xml <- xml2::xml_find_all(att_xml, "TABLE")
  if (length(fnc_xml) > 0) {
    low_xml <- xml2::xml_find_all(fnc_xml, "LOW")
    high_xml <- xml2::xml_find_all(fnc_xml, "HIGH")
    low <- if (length(low_xml) == 0) NULL else xml2::xml_text(low_xml[[1]])
    high <- if (length(high_xml) == 0) NULL else xml2::xml_text(high_xml[[1]])
  }
  else if (length(tab_xml) > 0) {
    low <- ""
    high <- ""
    rul_xml <- xml2::xml_find_all(tab_xml, "RULE")
    for (i in seq_increasing(1, length(rul_xml))) {
      val <- xml2::xml_text(rul_xml[[i]])
      dexi_val <- dexi_value(val)
      low <- paste0(low, values_to_str(dexi_val[[1]]))
      high <- paste0(high, values_to_str(dexi_val[[length(dexi_val)]]))
    }
  }
  else
  {
    return(NULL)
  }
  list(
    low = low,
    high = high
  )
}

read_dexi_discretize_funct_def <- function(att_xml) {
  fnc_xml <- xml2::xml_find_all(att_xml, "DISCRETIZE")
  if (length(fnc_xml) == 0) return(NULL)
  values_xml <- xml2::xml_find_all(fnc_xml, "VALUE")
  bounds_xml <- xml2::xml_find_all(fnc_xml, "BOUND")
  lval <- length(values_xml)
  lbnd <- length(bounds_xml)
  stopifnot(lval == lbnd + 1)
  values <- vector("list", length = lval)
  for (i in seq_increasing(1, lval)) {
    val <- xml2::xml_text(values_xml[[i]])
    dexi_val <- dexi_value(val, add = 1)
    values[[i]] <- dexi_val
  }
  bounds <- vector("list", length = lbnd)
  assoc <- vector("list", length = lbnd)
  for (i in seq_increasing(1, lbnd)) {
    asc <- tolower(xml2::xml_attr(bounds_xml[[i]], "Associate"))
    if (!(asc %in% EnumAssoc)) asc <- "down"
    bnd <- xml2::xml_double(bounds_xml[[i]])
    bounds[[i]] <- bnd
    assoc[[i]] <- asc
  }
  list(
    values = values,
    bounds = bounds,
    assoc = assoc
  )
}

read_dexi_attributes <- function (att_xml, def_name = "", alt_values = TRUE) {

  # name & description
  name_xml <- xml2::xml_find_all(att_xml, "NAME")
  name <- if (length(name_xml) == 0) def_name else xml2::xml_text(name_xml[[1]])
  name <- stringr::str_trim(name)
  descr_xml <- xml2::xml_find_all(att_xml, "DESCRIPTION")
  descr <- if (length(descr_xml) == 0) "" else xml2::xml_text(descr_xml[[1]])

  # read scale and funct_def
  scale <- read_dexi_scale(att_xml)
  tab_funct_def <- read_dexi_tabular_funct_def(att_xml)
  disc_funct_def <- read_dexi_discretize_funct_def(att_xml)

  # make attribute tree
  atts <- xml2::xml_find_all(att_xml, "ATTRIBUTE")
  ninps <- length(atts)
  if (ninps <= 0) {
    att_list <- list()
  }
  else
  {
    att_list <- vector("list", length = ninps)
    for (i in seq_increasing(1, ninps)) {
      att <- read_dexi_attributes(atts[[i]])
      att_list[[i]] <- att
    }
  }

  # attribute
  att <- DexiAttribute(name, descr, inputs = att_list, scale = scale)

  # alternatives
  add <- if (is.null(scale)) 1 else if (scale$is_discrete()) 1 else 0
  att$.alternatives <-
    if (alt_values) read_alternative_values(att_xml, add = add)
    else read_alternative_names(att_xml)

  # function
  funct <- NULL;
  if (!is.null(scale)) {
    if (!is.null(tab_funct_def) && is_class(scale, DexiDiscreteScaleClass)) {
      funct <- DexiTabularFunction(attribute = att, low = tab_funct_def$low, high = tab_funct_def$high)
    }
    else if (!is.null(disc_funct_def) && is_class(scale, DexiDiscreteScaleClass)) {
      funct <- DexiDiscretizeFunction(attribute = att,
                 bounds = disc_funct_def$bounds, assoc = disc_funct_def$assoc, values = disc_funct_def$values)
    }
  }
  att$funct <- funct

  # parent
  for (a in att$inputs) a$parent <- att

  att
}

collect_attributes <- function(root) {
  atts <- list();

  collect <- function (att) {
    atts <<- append(atts, list(att))
    for (i in seq_increasing(1, att$ninp())) {
      collect(att$inputs[[i]])
    }
  }

  collect(root)
  atts
}

read_alternative_names <- function(xml_root) {
  names <- list()
  for (xml in xml2::xml_children(xml_root)) {
    tag <- xml2::xml_name(xml)
    if (tag == "OPTION") {
      names <- append(names, xml2::xml_text(xml))
;    }
    else if (tag == "ALTERNATIVE") {
      name_xml <- xml2::xml_find_all(xml, "NAME")
      name <- if (length(name_xml) == 0) "" else xml2::xml_text(name_xml[[1]])
      names <- append(names, name)
    }
  }
  names
}

read_alternative_values <- function(xml_root, add = 1) {
  count <- 0
  for (xml in xml2::xml_children(xml_root)) {
    tag <- xml2::xml_name(xml)
    if (tag == "OPTION") count <- count + 1
    else if (tag == "ALTERNATIVE") count <- count + 1
  }
  values <- vector("list", length = count)
  i <- 1
  for (xml in xml2::xml_children(xml_root)) {
    tag <- xml2::xml_name(xml)
    if (tag == "OPTION") {
      values[[i]] <- dexi_option_value(xml2::xml_text(xml))
      i <- i + 1
    }
    else if (tag == "ALTERNATIVE") {
      values[[i]] <- dexi_value(xml2::xml_text(xml), add = add)
      i <- i + 1
    }
  }
  values
}

#' read_dexi
#'
#' `read_dexi()` reads a definition of a DEXi model from a `.dxi` file or XML string.
#'
#' @param dxi character(1). A `.dxi` file name or XML string.
#'
#' @return A [DexiModel] RC object.
#' @seealso [DexiModel]
#' @export
#'
#' @examples
#' CarDxi <- system.file("extdata", "Car.dxi", package = "DEXiR")
#' Car <- read_dexi(CarDxi)
#'
read_dexi <- function (dxi) {
  xml <- xml2::read_xml(dxi)
  stopifnot(is_class(xml, "xml_document"))
  stopifnot(xml2::xml_name(xml) == "DEXi")

  # name & description
  name_xml <- xml2::xml_find_all(xml, "NAME")
  name <- if (length(name_xml) == 0) "DEXi Model" else xml2::xml_text(name_xml[[1]])
  descr_xml <- xml2::xml_find_all(xml, "DESCRIPTION")
  descr <- if (length(descr_xml) == 0) "" else xml2::xml_text(descr_xml[[1]])

  # linking
  linking <- FALSE
  set_xml <- xml2::xml_find_all(xml, ".//SETTINGS/LINKING")
  if (length(set_xml) > 0) linking <- dexi_bool(xml2::xml_text(set_xml[[1]]))

  # structure
  root <- read_dexi_attributes(xml2::xml_root(xml), def_name = "root", alt_values = FALSE)
  stopif(is.null(root))
  stopif(root$ninp() == 0)

  DexiModel(name = name, description = descr, root = root, linking = linking)
}