THIS IS A TEST INSTANCE ONLY! REPOSITORIES CAN BE DELETED AT ANY TIME!

Browse Source

Function map() has been renamed to mapping() [#37]

revdep/wynton
hb 3 years ago
parent
commit
ef27a4e86f
  1. 1
      NAMESPACE
  2. 6
      NEWS
  3. 4
      R/get_variable.R
  4. 57
      R/listenv.R
  5. 4
      R/parse_env_subset.R
  6. 2
      incl/listenv.R
  7. 2
      man/listenv.Rd
  8. 14
      man/mapping.Rd
  9. 16
      tests/get_variable.R

1
NAMESPACE

@ -35,5 +35,6 @@ export(get_variable)
export(lengths.listenv)
export(listenv)
export(map)
export(mapping)
export(parse_env_subset)
export(undim)

6
NEWS

@ -1,7 +1,7 @@
Package: listenv
================
Version: 0.6.0-9000 [2018-01-17]
Version: 0.6.0-9000 [2018-01-20]
NEW FEATURES:
@ -20,6 +20,10 @@ BUG FIXES:
DEPRECATED AND DEFUNCT:
o Function map() has been renamed to mapping() and same for the corresponding
replacement function. The map() and map<-() functions will soon be
deprecated and eventually defunct.
o x <- listenv(length = n) is defunct; use x <- listenv(); length(x) <- n.

4
R/get_variable.R

@ -50,7 +50,7 @@ get_variable.listenv <- function(x, name, mustExist = FALSE,
}
}
map <- map(x)
map <- mapping(x)
## Existing variable?
var <- map[name]
@ -82,7 +82,7 @@ get_variable.listenv <- function(x, name, mustExist = FALSE,
}
## Update map?
if (create) map(x) <- map
if (create) mapping(x) <- map
var
}

57
R/listenv.R

@ -159,16 +159,27 @@ print.listenv <- function(x, ...) {
#'
#' @param x A list environment.
#'
#' @return The a named character vector
#' @return A named character vector
#'
#' @details
#' \emph{Functions \code{map()} and \code{map<-()} have been renamed to
#' \code{mapping()} and \code{mapping<-()}. The former will soon become
#' deprecated and eventually defunct. Please update accordingly.}
#'
#' @aliases mapping.listenv
#' @aliases map.listenv
#' @export
#' @keywords internal
map <- function(x, ...) {
mapping <- function(x, ...) {
get(".listenv.map", envir = parent.env(x), inherits = FALSE)
}
`map<-` <- function(x, value) {
#' @rdname mapping
#' @export
#' @keywords internal
map <- mapping
`mapping<-` <- function(x, value) {
stopifnot(is.character(value))
assign(".listenv.map", value, envir = parent.env(x), inherits = FALSE)
invisible(x)
@ -182,7 +193,7 @@ map <- function(x, ...) {
#' @export
#' @keywords internal
length.listenv <- function(x) {
length(map(x))
length(mapping(x))
}
## BACKPORT / WORKAROUND:
@ -198,7 +209,7 @@ if (!exists("lengths", mode = "function")) {
#' @export
`length<-.listenv` <- function(x, value) {
map <- map(x)
map <- mapping(x)
n <- length(map)
value <- as.numeric(value)
@ -221,7 +232,7 @@ if (!exists("lengths", mode = "function")) {
if (length(var) > 0) remove(list = var, envir = x, inherits = FALSE)
map <- map[-drop]
}
map(x) <- map
mapping(x) <- map
invisible(x)
}
@ -235,12 +246,12 @@ if (!exists("lengths", mode = "function")) {
#' @export
#' @keywords internal
names.listenv <- function(x) {
names(map(x))
names(mapping(x))
}
#' @export
`names<-.listenv` <- function(x, value) {
map <- map(x)
map <- mapping(x)
if (is.null(value)) {
} else if (length(value) != length(map)) {
stopf("Number of names does not match the number of elements: %s != %s",
@ -250,7 +261,7 @@ names.listenv <- function(x) {
## stop("Environments cannot have duplicate names on elements")
## }
names(map) <- value
map(x) <- map
mapping(x) <- map
invisible(x)
}
@ -276,7 +287,7 @@ lengths.listenv <- function(x, use.names=TRUE) { #nolint
#' @export
#' @keywords internal
as.list.listenv <- function(x, all.names=TRUE, sorted=FALSE, ...) {
vars <- map(x)
vars <- mapping(x)
nvars <- length(vars)
names <- names(x)
@ -329,7 +340,7 @@ as.list.listenv <- function(x, all.names=TRUE, sorted=FALSE, ...) {
#' @keywords internal
`$.listenv` <- function(x, name) {
#' @keywords internal
map <- map(x)
map <- mapping(x)
var <- map[name]
# Non-existing variable?
@ -419,7 +430,7 @@ to_index <- function(x, idxs) {
#' @export
`[[.listenv` <- function(x, ...) {
map <- map(x)
map <- mapping(x)
n <- length(map)
idxs <- list(...)
@ -506,7 +517,7 @@ to_index <- function(x, idxs) {
i <- to_index(x, idxs)
}
map <- map(x)
map <- mapping(x)
nmap <- length(map)
names <- names(map)
@ -615,7 +626,7 @@ assign_by_name <- function(x, name, value) {
stop("Cannot assign value. Empty name specific: ", name, call. = FALSE)
}
map <- map(x)
map <- mapping(x)
names <- names(map)
## Map to an existing or a new element?
@ -626,7 +637,7 @@ assign_by_name <- function(x, name, value) {
if (is.na(var)) {
var <- name
map[name] <- name
map(x) <- map
mapping(x) <- map
}
} else {
var <- name
@ -636,7 +647,7 @@ assign_by_name <- function(x, name, value) {
if (is.null(names)) names <- rep("", times = length(map))
names[length(map)] <- var
names(map) <- names
map(x) <- map
mapping(x) <- map
}
## Assign value
@ -659,7 +670,7 @@ assign_by_index <- function(x, i, value) {
stop("Cannot assign value. Non-positive index: ", i, call. = FALSE)
}
map <- map(x)
map <- mapping(x)
n <- length(map)
## Variable name
@ -677,7 +688,7 @@ assign_by_index <- function(x, i, value) {
map[i] <- new_variable(x, value = value)
## Update map
map(x) <- map
mapping(x) <- map
} else {
assign(var, value, envir = x, inherits = FALSE)
}
@ -697,7 +708,7 @@ remove_by_name <- function(x, name) {
stop("Cannot remove element. Empty name specific: ", name, call. = FALSE)
}
map <- map(x)
map <- mapping(x)
## Position in names map?
idx <- match(name, names(map))
@ -710,7 +721,7 @@ remove_by_name <- function(x, name) {
if (!is.na(var)) remove(list = var, envir = x, inherits = FALSE)
map <- map[-idx]
map(x) <- map
mapping(x) <- map
## Remove dimensions
names <- names(x)
@ -734,7 +745,7 @@ remove_by_index <- function(x, i) {
stop("Cannot remove element. Non-positive index: ", i, call. = FALSE)
}
map <- map(x)
map <- mapping(x)
## Nothing to do?
if (i > length(map)) return(invisible(x))
@ -744,7 +755,7 @@ remove_by_index <- function(x, i) {
if (!is.na(var)) remove(list = var, envir = x, inherits = FALSE)
map <- map[-i]
map(x) <- map
mapping(x) <- map
## Remove dimensions
names <- names(x)
@ -777,7 +788,7 @@ remove_by_index <- function(x, i) {
#' @export
`[[<-.listenv` <- function(x, ..., value) {
map <- map(x)
map <- mapping(x)
idxs <- list(...)
nidxs <- length(idxs)

4
R/parse_env_subset.R

@ -148,7 +148,7 @@ parse_env_subset <- function(expr, envir=parent.frame(), substitute=TRUE) {
if (inherits(envir, "listenv")) {
names <- names(envir)
map <- map(envir)
map <- mapping(envir)
dim <- dim(envir)
op <- res$op
@ -253,7 +253,7 @@ parse_env_subset <- function(expr, envir=parent.frame(), substitute=TRUE) {
if (any(is.na(res$idx)) && nzchar(res$name)) {
res$idx <- match(res$name, names(envir))
}
res$exists <- !is.na(res$idx) & !is.na(map(envir)[res$idx])
res$exists <- !is.na(res$idx) & !is.na(mapping(envir)[res$idx])
}
## Validate

2
incl/listenv.R

@ -1,4 +1,4 @@
x <- listenv(c=2, a=3, d="hello")
x <- listenv(c = 2, a = 3, d = "hello")
print(names(x))
names(x)[2] <- "A"
x$b <- 5:8

2
man/listenv.Rd

@ -21,7 +21,7 @@ An environment of class `listenv`.
Create a list environment
}
\examples{
x <- listenv(c=2, a=3, d="hello")
x <- listenv(c = 2, a = 3, d = "hello")
print(names(x))
names(x)[2] <- "A"
x$b <- 5:8

14
man/map.Rd → man/mapping.Rd

@ -1,19 +1,27 @@
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/listenv.R
\name{map}
\name{mapping}
\alias{mapping}
\alias{mapping.listenv}
\alias{map}
\alias{map.listenv}
\title{Variable name map for elements of list environment}
\usage{
mapping(x, ...)
map(x, ...)
}
\arguments{
\item{x}{A list environment.}
}
\value{
The a named character vector
A named character vector
}
\description{
Variable name map for elements of list environment
}
\details{
\emph{Functions \code{map()} and \code{map<-()} have been renamed to
\code{mapping()} and \code{mapping<-()}. The former will soon become
deprecated and eventually defunct. Please update accordingly.}
}
\keyword{internal}

16
tests/get_variable.R

@ -8,43 +8,43 @@ x <- listenv()
length(x) <- 3L
names(x) <- c("a", "b", "c")
stopifnot(length(x) == 3L)
print(map(x))
print(mapping(x))
var <- get_variable(x, "a")
stopifnot(!is.na(var))
stopifnot(length(x) == 3L)
print(map(x))
print(mapping(x))
var <- get_variable(x, "b")
stopifnot(!is.na(var))
stopifnot(length(x) == 3L)
print(map(x))
print(mapping(x))
var <- get_variable(x, "c")
stopifnot(!is.na(var))
stopifnot(length(x) == 3L)
print(map(x))
print(mapping(x))
var <- get_variable(x, "d")
stopifnot(!is.na(var))
stopifnot(length(x) == 4L)
print(map(x))
print(mapping(x))
var <- get_variable(x, 4L)
stopifnot(!is.na(var))
stopifnot(length(x) == 4L)
print(map(x))
print(mapping(x))
x$b <- 2
var <- get_variable(x, "b")
stopifnot(!is.na(var))
stopifnot(length(x) == 4L)
print(map(x))
print(mapping(x))
var <- get_variable(x, length(x) + 1L)
stopifnot(length(x) == 5L)
print(names(x))
print(map(x))
print(mapping(x))
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
## Allocation

Loading…
Cancel
Save