R/env.R

#' @title Creates an environment from a given list of arguments
#' @param ... List of objects (possibly named).
#' @return An \code{environment}.
#' @seealso dict, set_in_env
make_env <- function(...) {
  args <- list(...)
  arg_names <- names(args)
  e <- new.env(parent = baseenv())

  # empty args
  if (length(args) == 0)
    return(e)

  # at least one argument
  arg1 <- args[[1]]
  if (length(args) == 1) {
    if (none_empty(arg_names)) {
      set_in_env(arg_names, arg1, e)
      return(e)
    }

    if (is.environment(arg1)) {
      message("copying the environment")
      env_as_list <- as.list(arg1, all.names = TRUE)

      # create env from the copy
      return(list2env(env_as_list, hash = TRUE))
    }

    if (is.list(arg1)) {
      return(list2env(arg1, hash = TRUE))
    }

    # if not obvious (env, named args, or list), fallback to set_in_env
    set_in_env(names(arg1), unname(arg1), e)
    return(e)
  }

  # at least 2 arguments supplied
  arg2 <- args[[2]]
  if (length(args) == 2) {
    if (all_explicit(arg_names)) {
      # args of the form (keys = ..., values = ...)
      set_in_env(get_keys(args), get_values(args), e)
      return(e)
    }

    if (any_explicit(arg_names))
      warning("ignoring explicitly provided keys or values")

    if (none_empty(arg_names)) {
      set_in_env(arg_names, args, e)
      return(e)
    }

    # if not named explicitly, fallback on 1st being keys, 2nd being values
    if (any_empty(arg_names)) {
      set_in_env(arg1, arg2, e)
      return(e)
    }
  }

  # if all named, assume the names are keys
  if (none_empty(arg_names)) {
    if (any_explicit(arg_names))
      warning("ignoring explicitly provided keys or values")

    set_in_env(arg_names, args, e)
    return(e)
  }

  stop("no constructor defined for the supplied input")
}

#' @title Set values in an environment
#' @param keys Vector of names.
#' @param values Vector of values.
#' @param e Environment. If \code{NULL} (default), then a new environment
#' is created.
#' @return Environment with \code{values} named with \code{keys}.
set_in_env <- function(keys, values, e = NULL) {
  stopifnot(typeof(keys) == "character")

  if (length(keys) == 1) {
    named_list <- setNames(list(values), keys)
  } else {
    stopifnot(anyDuplicated(keys) == 0)

    list_values <- as.list(values)
    stopifnot(length(list_values) == length(keys))

    named_list <- setNames(list_values, keys)
  }

  list2env(named_list, e)
}

#' @title Retrieve values from environment
#' @param e Environment.
#' @param names Vector of names to retrieve.
#' @param default Default value if name is not defined in \code{e}.
#' @return Vector of values (some of which might be equal to \code{default}).
get_from_env <- function(e, names, default) {
  .Call(get_from_env_impl, e, names, default)
}

#' @title Items from environment
#' @description \strong{Item} is a \code{list(key = key, value = value)}. Returning
#' a list of such objects allows to iterate through them in a \code{for} loop and have access
#' to both the name and the value.
#' @param e Environment.
#' @param n Number of items to retrieve. If \code{-1L} (default), retrieves all.
#' @return List of items (see definition of item above).
get_items <- function(e, n = -1L) {
  .Call(get_items_impl, e, n)
}

#' @title Check if environment is empty
#' @description This is more efficient than \code{length(e) == 0}, because
#' \code{length()} does a full scan while \code{is_empty_env} returns early.
#' @param e Environment.
#' @return \code{TRUE} if \code{e} is empty, otherwise \code{FALSE}.
is_empty_env <- function(e) {
  .Call(is_empty_env_impl, e)
}

#' @title Check if an environment contains a key
#' @description This is more efficient than \code{key \%in\% names(e)}, because
#' it doesn't require to check all the names.
#' @param e Environment.
#' @param key A single string.
#' @return \code{TRUE} if \code{key} name exists in \code{e}, otherwise \code{FALSE}.
env_has_key <- function(e, key) {
  .Call(has_key_impl, e, key)
}
skubicius/dictionary documentation built on May 7, 2019, 7:17 p.m.