listenv/0000755000176200001440000000000012640067456011750 5ustar liggesuserslistenv/inst/0000755000176200001440000000000012640067035012716 5ustar liggesuserslistenv/inst/doc/0000755000176200001440000000000012640067035013463 5ustar liggesuserslistenv/inst/doc/listenv.html0000644000176200001440000006602612640067035016047 0ustar liggesusers List Environments

List Environments

List environments are environments that have list-like properties. They are implemented by the listenv package. The main features of a list environment are summarized in the below table:

Property list environments lists environments
Number of elements, e.g. length() yes yes yes
Named elements, e.g. names(), x$a and x[["a"]] yes yes yes
Duplicated names yes yes
Indexed elements, e.g. x[[4]] yes yes
Dimensions, e.g. dim(x) yes yes
Names of dimensions, e.g. dimnames(x) yes yes
Indexing by dimensions, e.g. x[[2,4]] and x[[2,"D"]] yes yes
Multi-element subsetting, e.g. x[c("a", "c")], x[-1], [2:1,,3] yes yes
Multi-element subsetting preserves element names yes
Removing element by assigning NULL, e.g. x$c <- NULL yes yes
Mutable, e.g. y <- x; y$a <- 3; identical(y, x) yes yes
Compatible* with assign(), delayedAssign(), get() and exists() yes yes

For example,

> x <- listenv(a = 1, b = 2, c = "hello")
> x
A 'listenv' vector with 3 elements ('a', 'b', 'c').
> length(x)
[1] 3
> names(x)
[1] "a" "b" "c"
> x$a
[1] 1
> x[[3]] <- toupper(x[[3]])
> x$c
[1] "HELLO"
> y <- x
> y$d <- y$a + y[["b"]]
> names(y)[2] <- "a"
> y$a
[1] 1
> y
A 'listenv' vector with 4 elements ('a', 'a', 'c', 'd').
> identical(y, x)
[1] TRUE
> for (ii in seq_along(x)) {
+     cat(sprintf("Element %d (%s): %s\n", ii, sQuote(names(x)[ii]), 
+         x[[ii]]))
+ }
Element 1 ('a'): 1
Element 2 ('a'): 2
Element 3 ('c'): HELLO
Element 4 ('d'): 3
> x[c(1, 3)] <- list(2, "Hello world!")
> x
A 'listenv' vector with 4 elements ('a', 'a', 'c', 'd').
> y <- as.list(x)
> str(y)
List of 4
 $ a: num 2
 $ a: num 2
 $ c: chr "Hello world!"
 $ d: num 3
> z <- as.listenv(y)
> z
A 'listenv' vector with 4 elements ('a', 'a', 'c', 'd').
> identical(z, x)
[1] FALSE
> all.equal(z, x)
[1] TRUE

Creating list environments

List environments are created similarly to lists but also similarly to environments. To create an empty list environment, use

> x <- listenv()
> x
A 'listenv' vector with 0 elements.

This can later can be populated using named assignments,

> x$a <- 1
> x
A 'listenv' vector with 1 element ('a').

comparable to how both lists and environments work. Similarly to lists, they can also be populated using indices, e.g.

> x[[2]] <- 2
> x$c <- 3
> x
A 'listenv' vector with 3 elements ('a', '', 'c').

Just as for lists, a list environment is expanded with NULL elements whenever a new element is added that is beyond the current length plus one, e.g.

> x[[5]] <- 5
> x
A 'listenv' vector with 5 elements ('a', '', 'c', '', '').
> x[[4]]
NULL

As with lists, the above list environment can also be created from the start, e.g.

> x <- listenv(a = 1, 3, c = 4, NULL, 5)
> x
A 'listenv' vector with 5 elements ('a', '', 'c', '', '').

As for lists, the length of a list environment can at any time be increased or decreased by assigning it a new length. If decreased, elements are dropped, e.g.

> x
A 'listenv' vector with 5 elements ('a', '', 'c', '', '').
> length(x) <- 2
> x
A 'listenv' vector with 2 elements ('a', '').
> x[[1]]
[1] 1
> x[[2]]
[1] 3

If increased, new elements are populated with unnamed elements of NULL, e.g.

> length(x) <- 4
> x
A 'listenv' vector with 4 elements ('a', '', '', '').
> x[[3]]
NULL
> x[[4]]
NULL

To allocate an “empty” list environment (with all NULL:s) of a given length, do

> x <- listenv()
> length(x) <- 4
> x
A 'listenv' vector with 4 unnamed elements.

Note: Unfortunately, it is not possible to use x <- vector("listenv", length=4); that construct is only supported for the basic data types.

Iterating over elements

Iterating over elements by names

Analogously to lists and plain environments, it is possible to iterate over elements of list environments by the element names. For example,

> x <- listenv(a = 1, b = 2, c = 3)
> for (name in names(x)) {
+     cat(sprintf("Element %s: %s\n", sQuote(name), x[[name]]))
+ }
Element 'a': 1
Element 'b': 2
Element 'c': 3

Iterating over elements by indices

Analogously to lists, but contrary to plain environments, it is also possible to iterate over elements by their indices. For example,

> x <- listenv(a = 1, b = 2, c = 3)
> for (ii in seq_along(x)) {
+     cat(sprintf("Element %d: %s\n", ii, x[[ii]]))
+ }
Element 1: 1
Element 2: 2
Element 3: 3

Coercion to and from list environments

Coercing to lists and vectors

Coercing a list environment to a list:

> x <- listenv(a = 2, b = 3, c = "hello")
> x
A 'listenv' vector with 3 elements ('a', 'b', 'c').
> y <- as.list(x)
> str(y)
List of 3
 $ a: num 2
 $ b: num 3
 $ c: chr "hello"

Coercing a list to a list environment:

> z <- as.listenv(y)
> z
A 'listenv' vector with 3 elements ('a', 'b', 'c').
> identical(z, x)
[1] FALSE
> all.equal(z, x)
[1] TRUE

Unlisting:

> unlist(x)
      a       b       c 
    "2"     "3" "hello" 
> unlist(x[-3])
a b 
2 3 
> unlist(x[1:2], use.names = FALSE)
[1] 2 3

Multi-dimensional list environments

Analogously to lists, and contrary to plain environments, list environments can have dimensions with corresponding names. For example,

> x <- as.listenv(1:6)
> dim(x) <- c(2, 3)
> dimnames(x) <- list(c("a", "b"), c("A", "B", "C"))
> x
A 'listenv' matrix with 6 unnamed elements arranged in 2x3 rows ('a', 'b') and columns ('A', 'B', 'C').

An easy way to quickly get an overview is to coerce to a list, e.g.

> as.list(x)
  A B C
a 1 3 5
b 2 4 6

Individual elements of a list environment can be accessed using standard subsetting syntax, e.g.

> x[["a", "B"]]
[1] 3
> x[[1, 2]]
[1] 3
> x[[1, "B"]]
[1] 3

We can assign individual elements similarly, e.g.

> x[["b", "B"]] <- -x[["b", "B"]]
> as.list(x)
  A B  C
a 1 3  5
b 2 -4 6

We can also assign multiple elements through dimensional subsetting, e.g.

> x[2, -1] <- 98:99
> as.list(x)
  A B  C 
a 1 3  5 
b 2 98 99
> x["a", c(1, 3)] <- list(97, "foo")
> as.list(x)
  A  B  C    
a 97 3  "foo"
b 2  98 99   
> x[] <- 1:6
> as.list(x)
  A B C
a 1 3 5
b 2 4 6

Concurrently with dimensional names it is possible to have names of the invidual elements just as for list environments without dimensions. For example,

> names(x) <- letters[seq_along(x)]
> x
A 'listenv' matrix with 6 elements ('a', 'b', 'c', ..., 'f') arranged in 2x3 rows ('a', 'b') and columns ('A', 'B', 'C').
> x[["a"]]
[1] 1
> x[["f"]]
[1] 6
> x[c("a", "f")]
A 'listenv' vector with 2 elements ('a', 'f').
> unlist(x)
a b c d e f 
1 2 3 4 5 6

Contrary to lists, element names are preserved also with multi-dimensional subsetting, e.g.

> x[1, 2]
A 'listenv' vector with 1 element ('c').
> x[1, 2, drop = FALSE]
A 'listenv' matrix with 1 element ('c') arranged in 1x1 rows ('a') and columns ('B').
> x[1:2, 2:1]
A 'listenv' matrix with 4 elements ('c', 'd', 'a', 'b') arranged in 2x2 rows ('a', 'b') and columns ('B', 'A').
> x[2, ]
A 'listenv' vector with 3 elements ('b', 'd', 'f').
> x[2, , drop = FALSE]
A 'listenv' matrix with 3 elements ('b', 'd', 'f') arranged in 1x3 rows ('b') and columns ('A', 'B', 'C').
> x["b", -2, drop = FALSE]
A 'listenv' matrix with 2 elements ('b', 'f') arranged in 1x2 rows ('b') and columns ('A', 'C').

Note, whenever dimensions are set using dim(x) <- dims both the dimensional names and the element names are removed, e.g.

> dim(x) <- NULL
> names(x)
NULL

This behavior is by design, cf. help("dim", package="base").

Limitations

The current implementation does not support dimensional subsetting of more than one element. For instance, x[1,] is not supported by this version.

Important about environments

List environments are as their name suggests environments. Whenever working with environments in R, it is important to understand that environments are mutable whereas all other of the basic data types in R are immutable. For example, consider the following function that assigns zero to element a of object x:

> setA <- function(x) {
+     x$a <- 0
+     x
+ }

If we pass a regular list to this function,

> x <- list(a = 1)
> y <- setA(x)
> x$a
[1] 1
> y$a
[1] 0

we see that x is unaffected by the assignment. This is because lists are immutable in R. However, if we pass an environment instead,

> x <- new.env()
> x$a <- 1
> y <- setA(x)
> x$a
[1] 0
> y$a
[1] 0

we find that x was affected by the assignment. This is because environments are mutable in R. Since list environments inherits from environments, this also goes for them, e.g.

> x <- listenv(a = 1)
> y <- setA(x)
> x$a
[1] 0
> y$a
[1] 0

What is also important to understand is that it is not just the content of an environment that is mutable but also its attributes. For example,

> x <- listenv(a = 1)
> y <- x
> attr(y, "foo") <- "Hello!"
> attr(x, "foo")
[1] "Hello!"

Copyright Henrik Bengtsson, 2015

listenv/inst/doc/listenv.md.rsp0000644000176200001440000002150712640067035016301 0ustar liggesusers<%@meta language="R-vignette" content="-------------------------------- %\VignetteIndexEntry{List Environments} %\VignetteAuthor{Henrik Bengtsson} %\VignetteKeyword{R} %\VignetteKeyword{package} %\VignetteKeyword{vignette} %\VignetteKeyword{listenv} %\VignetteEngine{R.rsp::rsp} %\VignetteTangle{FALSE} --------------------------------------------------------------------"%> <% R.utils::use("R.utils") use("listenv") options("withCapture/newline"=FALSE) %> # <%@meta name="title"%> _List environments_ are environments that have list-like properties. They are implemented by the [listenv] package. The main features of a list environment are summarized in the below table: | Property | list environments | lists | environments | |------------------------------------------------------------------------|:-----------------:|:------:|:------------:| | Number of elements, e.g. `length()` | yes | yes | yes | | Named elements, e.g. `names()`, `x$a` and `x[["a"]]` | yes | yes | yes | | Duplicated names | yes | yes | | | Indexed elements, e.g. `x[[4]]` | yes | yes | | | Dimensions, e.g. `dim(x)` | yes | yes | | | Names of dimensions, e.g. `dimnames(x)` | yes | yes | | | Indexing by dimensions, e.g. `x[[2,4]]` and `x[[2,"D"]]` | yes | yes | | | Multi-element subsetting, e.g. `x[c("a", "c")]`, `x[-1]`, `[2:1,,3]` | yes | yes | | | Multi-element subsetting preserves element names | yes | | | | Removing element by assigning NULL, e.g. `x$c <- NULL` | yes | yes | | | Mutable, e.g. `y <- x; y$a <- 3; identical(y, x)` | yes | | yes | | Compatible* with `assign()`, `delayedAssign()`, `get()` and `exists()` | yes | | yes | For example, ```r <%=withCapture({ x <- listenv(a=1, b=2, c="hello") x length(x) names(x) x$a x[[3]] <- toupper(x[[3]]) x$c y <- x y$d <- y$a + y[["b"]] names(y)[2] <- "a" y$a y identical(y, x) for (ii in seq_along(x)) { cat(sprintf("Element %d (%s): %s\n", ii, sQuote(names(x)[ii]), x[[ii]])) } <%--- get(map(x)["b"], envir=x) assign(map(x)["b"], 3, envir=x) ---%> x[c(1,3)] <- list(2, "Hello world!") x y <- as.list(x) str(y) z <- as.listenv(y) z identical(z, x) all.equal(z, x) })%> ``` ## Creating list environments List environments are created similarly to lists but also similarly to environments. To create an empty list environment, use ```r <%=withCapture({ x <- listenv() x })%> ``` This can later can be populated using named assignments, ```r <%=withCapture({ x$a <- 1 x })%> ``` comparable to how both lists and environments work. Similarly to lists, they can also be populated using indices, e.g. ```r <%=withCapture({ x[[2]] <- 2 x$c <- 3 x })%> ``` Just as for lists, a list environment is expanded with `NULL` elements whenever a new element is added that is beyond the current length plus one, e.g. ```r <%=withCapture({ x[[5]] <- 5 x x[[4]] })%> ``` As with lists, the above list environment can also be created from the start, e.g. ```r <%=withCapture({ x <- listenv(a=1, 3, c=4, NULL, 5) x })%> ``` As for lists, the length of a list environment can at any time be increased or decreased by assigning it a new length. If decreased, elements are dropped, e.g. ```r <%=withCapture({ x length(x) <- 2 x x[[1]] x[[2]] })%> ``` If increased, new elements are populated with unnamed elements of `NULL`, e.g. ```r <%=withCapture({ length(x) <- 4 x x[[3]] x[[4]] })%> ``` To allocate an "empty" list environment (with all `NULL`:s) of a given length, do ```r <%=withCapture({ x <- listenv() length(x) <- 4 x })%> ``` _Note_: Unfortunately, it is _not_ possible to use `x <- vector("listenv", length=4)`; that construct is only supported for the basic data types. ## Iterating over elements ### Iterating over elements by names Analogously to lists and plain environments, it is possible to iterate over elements of list environments by the element names. For example, ```r <%=withCapture({ x <- listenv(a=1, b=2, c=3) for (name in names(x)) { cat(sprintf("Element %s: %s\n", sQuote(name), x[[name]])) } })%> ``` ### Iterating over elements by indices Analogously to lists, but contrary to plain environments, it is also possible to iterate over elements by their indices. For example, ```r <%=withCapture({ x <- listenv(a=1, b=2, c=3) for (ii in seq_along(x)) { cat(sprintf("Element %d: %s\n", ii, x[[ii]])) } })%> ``` ## Coercion to and from list environments ### Coercing to lists and vectors Coercing a list environment to a list: ```r <%=withCapture({ x <- listenv(a=2, b=3, c="hello") x y <- as.list(x) str(y) })%> ``` Coercing a list to a list environment: ```r <%=withCapture({ z <- as.listenv(y) z identical(z, x) all.equal(z, x) })%> ``` Unlisting: ```r <%=withCapture({ unlist(x) unlist(x[-3]) unlist(x[1:2], use.names=FALSE) })%> ``` ## Multi-dimensional list environments Analogously to lists, and contrary to plain environments, list environments can have dimensions with corresponding names. For example, ```r <%=withCapture({ x <- as.listenv(1:6) dim(x) <- c(2,3) dimnames(x) <- list(c("a", "b"), c("A", "B","C")) x })%> ``` An easy way to quickly get an overview is to coerce to a list, e.g. ```r <%=withCapture({ as.list(x) })%> ``` Individual elements of a list environment can be accessed using standard subsetting syntax, e.g. ```r <%=withCapture({ x[["a", "B"]] x[[1, 2]] x[[1, "B"]] })%> ``` We can assign individual elements similarly, e.g. ```r <%=withCapture({ x[["b", "B"]] <- -x[["b", "B"]] as.list(x) })%> ``` We can also assign multiple elements through dimensional subsetting, e.g. ```r <%=withCapture({ x[2,-1] <- 98:99 as.list(x) x["a",c(1,3)] <- list(97, "foo") as.list(x) x[] <- 1:6 as.list(x) })%> ``` Concurrently with dimensional names it is possible to have names of the invidual elements just as for list environments without dimensions. For example, ```r <%=withCapture({ names(x) <- letters[seq_along(x)] x x[["a"]] x[["f"]] x[c("a", "f")] unlist(x) })%> ``` Contrary to lists, element names are preserved also with multi-dimensional subsetting, e.g. ```r <%=withCapture({ x[1,2] x[1,2,drop=FALSE] x[1:2,2:1] x[2,] x[2,,drop=FALSE] x["b",-2,drop=FALSE] })%> ``` Note, whenever dimensions are set using `dim(x) <- dims` both the dimensional names and the element names are removed, e.g. ```r > dim(x) <- NULL > names(x) NULL ``` This behavior is by design, cf. `help("dim", package="base")`. <%--- Because of this, the listenv package provides the `undim()` function, which removes the dimensions but preserves the names, e.g. ```r <%=withCapture({ x <- undim(x) names(x) })%> ``` _Warning_: Since list environments _and their attributes_ are mutable, calling ```r undim(x) ``` will have the same effect as ```r x <- undim(x) ``` That is, the dimension attributes of `x` will be changed. The reason for this is explained in Section 'Important about environments' above. ---%> ### Limitations The current implementation does _not_ support _dimensional subsetting_ of more than one element. For instance, `x[1,]` is not supported by this version. ## Important about environments List environments are as their name suggests _environments_. Whenever working with environments in R, it is important to understand that _environments are mutable_ whereas all other of the basic data types in R are immutable. For example, consider the following function that assigns zero to element `a` of object `x`: ```r <%=withCapture({ setA <- function(x) { x$a <- 0 x } })%> ``` If we pass a regular list to this function, ```r <%=withCapture({ x <- list(a=1) y <- setA(x) x$a y$a })%> ``` we see that `x` is unaffected by the assignment. This is because _lists are immutable_ in R. However, if we pass an environment instead, ```r <%=withCapture({ x <- new.env() x$a <- 1 y <- setA(x) x$a y$a })%> ``` we find that `x` was affected by the assignment. This is because _environments are mutable_ in R. Since list environments inherits from environments, this also goes for them, e.g. ```r <%=withCapture({ x <- listenv(a=1) y <- setA(x) x$a y$a })%> ``` What is also important to understand is that it is not just the _content_ of an environment that is mutable but also its _attributes_. For example, ```r <%=withCapture({ x <- listenv(a=1) y <- x attr(y, "foo") <- "Hello!" attr(x, "foo") })%> ``` [listenv]: http://cran.r-project.org/package=listenv --- Copyright Henrik Bengtsson, 2015 listenv/tests/0000755000176200001440000000000012640067030013076 5ustar liggesuserslistenv/tests/undim.R0000644000176200001440000000117712640067030014343 0ustar liggesuserslibrary("listenv") message("*** undim() ...") ## General x <- c(a=1, b=2, A=3, B=4) names <- names(x) dim <- c(2,2) dimnames <- list(c("a", "b"), c("A", "B")) ## Basic arrays y <- array(x, dim=dim, dimnames=dimnames) names(y) <- names z <- undim(y) stopifnot(identical(names(z), names)) ## Lists y <- as.list(x) dim(y) <- dim dimnames(y) <- dimnames names(y) <- names z <- undim(y) stopifnot(identical(names(z), names)) ## List environments y <- as.listenv(x) dim(y) <- dim dimnames(y) <- dimnames names(y) <- names z <- undim(y) stopifnot(identical(names(z), names)) message("*** undim() ... DONE") listenv/tests/utils.R0000644000176200001440000000222412640067030014361 0ustar liggesusersprintf <- function(...) cat(sprintf(...)) hpaste <- listenv:::hpaste # Some vectors x <- 1:6 y <- 10:1 z <- LETTERS[x] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Abbreviation of output vector # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - printf("x = %s.\n", hpaste(x)) ## x = 1, 2, 3, ..., 6. printf("x = %s.\n", hpaste(x, maxHead=2)) ## x = 1, 2, ..., 6. printf("x = %s.\n", hpaste(x), maxHead=3) # Default ## x = 1, 2, 3, ..., 6. # It will never output 1, 2, 3, 4, ..., 6 printf("x = %s.\n", hpaste(x, maxHead=4)) ## x = 1, 2, 3, 4, 5 and 6. # Showing the tail printf("x = %s.\n", hpaste(x, maxHead=1, maxTail=2)) ## x = 1, ..., 5, 6. # Turning off abbreviation printf("y = %s.\n", hpaste(y, maxHead=Inf)) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ## ...or simply printf("y = %s.\n", paste(y, collapse=", ")) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Adding a special separator before the last element # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Change last separator printf("x = %s.\n", hpaste(x, lastCollapse=" and ")) ## x = 1, 2, 3, 4, 5 and 6. listenv/tests/parse_env_subset.R0000644000176200001440000001534112640067030016574 0ustar liggesuserslibrary("listenv") ovars <- ls(envir=globalenv()) if (exists("x")) rm(list="x") if (exists("y")) rm(list="y") ## - - - - - - - - - - - - - - - - - - - - - - - - - - ## Variable in global/parent environment ## - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** parse_env_subset() on parent environment ...") target <- parse_env_subset(x, substitute=TRUE) str(target) stopifnot(identical(target$envir, environment()), target$name == "x", is.na(target$idx), !target$exists) target <- parse_env_subset("x", substitute=TRUE) str(target) stopifnot(identical(target$envir, environment()), target$name == "x", is.na(target$idx), !target$exists) x <- NULL target <- parse_env_subset(x, substitute=TRUE) str(target) stopifnot(identical(target$envir, environment()), target$name == "x", is.na(target$idx), target$exists) target <- parse_env_subset(y, substitute=TRUE) str(target) stopifnot(identical(target$envir, environment()), target$name == "y", is.na(target$idx), !target$exists) message("*** parse_env_subset() on parent environment ... DONE") ## - - - - - - - - - - - - - - - - - - - - - - - - - - ## Environment ## - - - - - - - - - - - - - - - - - - - - - - - - - - message("parse_env_subset() on environment ...") x <- new.env() target <- parse_env_subset(x, substitute=TRUE) str(target) stopifnot(identical(target$envir, environment()), target$name == "x", is.na(target$idx), target$exists) target <- parse_env_subset(x$a, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), !target$exists) target <- parse_env_subset("a", envir=x, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), !target$exists) target <- parse_env_subset(x[["a"]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), !target$exists) target <- parse_env_subset("a", envir=x, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), !target$exists) res <- try(target <- parse_env_subset(1, substitute=FALSE), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(target <- parse_env_subset(x[[1]], substitute=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) x$a <- 1 target <- parse_env_subset(x$a, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), target$exists) message("parse_env_subset() on environment ... DONE") ## - - - - - - - - - - - - - - - - - - - - - - - - - - ## List environment ## - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** parse_env_subset() on listenv ...") x <- listenv() target <- parse_env_subset(x, substitute=TRUE) str(target) stopifnot(identical(target$envir, environment()), target$name == "x", is.na(target$idx), target$exists) target <- parse_env_subset(x$a, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), !target$exists) target <- parse_env_subset(x[["a"]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), !target$exists) target <- parse_env_subset("a", envir=x, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", is.na(target$idx), !target$exists) target <- parse_env_subset(x[[1]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "", target$idx == 1, !target$exists) target <- parse_env_subset(x[[2]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "", target$idx == 2, !target$exists) x$a <- 1 target <- parse_env_subset(x$a, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", target$idx == 1, target$exists) target <- parse_env_subset("a", envir=x, substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", target$idx == 1, target$exists) stopifnot(x$a == 1) stopifnot(x[[1]] == 1) target <- parse_env_subset(x[[1]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", target$idx == 1, target$exists) x[[3]] <- 3 target <- parse_env_subset(x[[3]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "", target$idx == 3, target$exists) stopifnot(x[[3]] == 3) print(names(x)) stopifnot(identical(names(x), c("a", "", ""))) b <- 1 target <- parse_env_subset(x[[b]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$name == "a", target$idx == 1, target$exists) x <- listenv() length(x) <- 2 target <- parse_env_subset(x[[1]], substitute=TRUE) str(target) stopifnot(!target$exists) target <- parse_env_subset(x[[2]], substitute=TRUE) str(target) stopifnot(!target$exists) target <- parse_env_subset(x[[3]], substitute=TRUE) str(target) stopifnot(!target$exists) stopifnot(length(x) == 2) x[[2]] <- 2 target <- parse_env_subset(x[[2]], substitute=TRUE) str(target) stopifnot(target$exists) x[[4]] <- 4 stopifnot(length(x) == 4) target <- parse_env_subset(x[[3]], substitute=TRUE) str(target) stopifnot(!target$exists) target <- parse_env_subset(x[1:5], substitute=TRUE) stopifnot(length(target$idx) == 5, all(target$idx == 1:5)) str(target) target <- parse_env_subset(x[integer(0L)], substitute=TRUE) stopifnot(length(target$idx) == 0) str(target) target <- parse_env_subset(x[[integer(0L)]], substitute=TRUE) stopifnot(length(target$idx) == 0) str(target) target <- parse_env_subset(x[0], substitute=TRUE) stopifnot(length(target$idx) == 0) str(target) target <- parse_env_subset(x[-1], substitute=TRUE) stopifnot(length(target$idx) == length(x)-1) str(target) ## Odds and ends target <- parse_env_subset(x[[""]], substitute=TRUE) stopifnot(length(target$idx) == 1L, !target$exists) message("*** parse_env_subset() on listenv ... DONE") ## - - - - - - - - - - - - - - - - - - - - - - - - - - ## Exception handling ## - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** parse_env_subset() - exceptions ...") x <- listenv() res <- try(target <- parse_env_subset(x[[0]], substitute=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(target <- parse_env_subset("_a", substitute=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(target <- parse_env_subset(1:10, envir=x, substitute=FALSE), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(target <- parse_env_subset(c("a", "b"), envir=x, substitute=FALSE), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(target <- parse_env_subset(x@a, substitute=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) message("*** parse_env_subset() - exceptions ... DONE") ## Cleanup rm(list=setdiff(ls(envir=globalenv()), ovars), envir=globalenv()) listenv/tests/get_variable,dimensions.R0000644000176200001440000000161112640067030020011 0ustar liggesuserslibrary("listenv") ovars <- ls(envir=globalenv()) oopts <- options(warn=1) map <- listenv:::map message("* get_variable() - multi-dimensional list environments ...") x <- listenv() length(x) <- 6 dim(x) <- c(2,3) for (ii in seq_along(x)) { stopifnot(is.null(x[[ii]])) idx <- arrayInd(ii, .dim=dim(x)) stopifnot(is.null(x[[idx[1],idx[2]]])) varV <- get_variable(x, ii, create=FALSE) varA <- get_variable(x, idx, create=FALSE) stopifnot(identical(varA, varV)) } x[1:6] <- 1:6 for (ii in seq_along(x)) { stopifnot(identical(x[[ii]], ii)) idx <- arrayInd(ii, .dim=dim(x)) stopifnot(identical(x[[idx[1],idx[2]]], ii)) varV <- get_variable(x, ii) varA <- get_variable(x, idx) stopifnot(identical(varA, varV)) } message("* get_variable() - multi-dimensional list environments ... DONE") ## Cleanup options(oopts) rm(list=setdiff(ls(envir=globalenv()), ovars), envir=globalenv()) listenv/tests/get_variable.R0000644000176200001440000000444512640067030015654 0ustar liggesuserslibrary("listenv") ovars <- ls(envir=globalenv()) oopts <- options(warn=1) map <- listenv:::map x <- listenv() length(x) <- 3L names(x) <- c("a", "b", "c") stopifnot(length(x) == 3L) print(map(x)) var <- get_variable(x, "a") stopifnot(!is.na(var)) stopifnot(length(x) == 3L) print(map(x)) var <- get_variable(x, "b") stopifnot(!is.na(var)) stopifnot(length(x) == 3L) print(map(x)) var <- get_variable(x, "c") stopifnot(!is.na(var)) stopifnot(length(x) == 3L) print(map(x)) var <- get_variable(x, "d") stopifnot(!is.na(var)) stopifnot(length(x) == 4L) print(map(x)) var <- get_variable(x, 4L) stopifnot(!is.na(var)) stopifnot(length(x) == 4L) print(map(x)) x$b <- 2 var <- get_variable(x, "b") stopifnot(!is.na(var)) stopifnot(length(x) == 4L) print(map(x)) var <- get_variable(x, length(x) + 1L) stopifnot(length(x) == 5L) print(names(x)) print(map(x)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Allocation ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() length(x) <- 3L print(x[[1]]) print(x[[2]]) print(x[[3]]) ## Out-of-bound subsetting res <- try(x[[0]], silent=TRUE) stopifnot(inherits(res, "try-error")) ## Out-of-bound subsetting res <- try(x[[4]], silent=TRUE) stopifnot(inherits(res, "try-error")) print(get_variable(x, 1L, mustExist=FALSE)) print(get_variable(x, 2L, mustExist=FALSE)) print(get_variable(x, 3L, mustExist=FALSE)) ## Out-of-bound element res <- try(var <- get_variable(x, 0L, mustExist=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) ## Out-of-bound element res <- try(var <- get_variable(x, length(x) + 1L, mustExist=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Exception handling ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() length(x) <- 3L names(x) <- c("a", "b", "c") ## Non-existing element res <- try(var <- get_variable(x, "z", mustExist=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(var <- get_variable(x, c("a", "b")), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(var <- get_variable(x, 1+2i), silent=TRUE) stopifnot(inherits(res, "try-error")) ## Cleanup options(oopts) rm(list=setdiff(ls(envir=globalenv()), ovars), envir=globalenv()) listenv/tests/listenv,dimensions.R0000644000176200001440000001530712640067030017060 0ustar liggesuserslibrary("listenv") ovars <- ls(envir=globalenv()) oopts <- options(warn=1) message("* List environment and multiple dimensions ...") x <- listenv() dim(x) <- c(0,0) print(x) stopifnot(length(x) == 0) x <- listenv(a=1) stopifnot(identical(names(x), "a")) dim(x) <- c(1,1) print(x) stopifnot(length(x) == 1) stopifnot(is.null(dimnames(x))) stopifnot(is.null(names(x))) x0 <- as.list(1:6) x <- as.listenv(x0) print(x) stopifnot(is.null(dim(x))) stopifnot(is.null(dimnames(x))) y <- as.list(x) stopifnot(identical(y, x0)) z <- as.listenv(y) stopifnot(all.equal(z, x)) message("* dim(x) and dimnames(x) ...") dims <- list(2:3, 2:4) for (kk in seq_along(dims)) { dim <- dims[[kk]] dimnames <- lapply(dim, FUN=function(n) letters[seq_len(n)]) names <- letters[seq_len(prod(dim))] str(list(dim=dim, dimnames=dimnames, names=names)) n <- prod(dim) values <- seq_len(n) x0 <- as.list(values) x <- as.listenv(values) print(x) stopifnot(identical(dim(x), dim(x0))) y <- as.list(x) stopifnot(identical(y, x0)) z <- as.listenv(y) stopifnot(all.equal(z, x)) dim(x0) <- dim dim(x) <- dim print(x) stopifnot(identical(dim(x), dim(x0))) stopifnot(is.null(dimnames(x))) stopifnot(is.null(names(x))) names(x0) <- names names(x) <- names y <- as.list(x) stopifnot(identical(y, x0)) z <- as.listenv(y) stopifnot(all.equal(z, x)) excls <- c(list(NULL), as.list(seq_along(dimnames)), list(seq_along(dimnames))) for (ll in seq_along(excls)) { excl <- excls[[ll]] dimnamesT <- dimnames dimnamesT[excl] <- list(NULL) dimnames(x0) <- dimnamesT dimnames(x) <- dimnamesT print(x) stopifnot(identical(dim(x), dim(x0))) stopifnot(identical(dimnames(x), dimnames(x0))) stopifnot(identical(names(x), names)) y <- as.list(x) stopifnot(identical(y, x0)) z <- as.listenv(y) stopifnot(all.equal(z, x)) } ## for (ll ...) } ## for (kk ...) # Assign names x <- as.listenv(1:6) dim(x) <- c(2,3) dimnames(x) <- lapply(dim(x), FUN=function(n) letters[seq_len(n)]) names(x) <- letters[seq_along(x)] print(x) stopifnot(!is.null(dim(x))) stopifnot(!is.null(dimnames(x))) stopifnot(!is.null(names(x))) stopifnot(x[["b"]] == 2L) stopifnot(x[["a", "b"]] == 3L) ## Extract single element message("* y <- x[[i,j]] and z <- x[i,j] ...") dim(x) <- c(2,3) dimnames(x) <- list(c("a", "b"), NULL) y <- x[[3]] stopifnot(identical(y, 3L)) z <- x[3] stopifnot(identical(z[[1]], y)) y <- x[[1,1]] stopifnot(identical(y, x[[1]])) z <- x[1,1] stopifnot(identical(z[[1]], y)) y <- x[[2,3]] stopifnot(identical(y, x[[6]])) z <- x[2,3] stopifnot(identical(z[[1]], y)) y <- x[["a",3]] stopifnot(identical(y, x[[1,3]])) stopifnot(identical(y, x[[5]])) z <- x["a",3] stopifnot(identical(z[[1]], y)) y <- x[[1,c(FALSE,FALSE,TRUE)]] stopifnot(identical(y, x[[1,3]])) stopifnot(identical(y, x[[5]])) z <- x[1,c(FALSE,FALSE,TRUE)] stopifnot(identical(z[[1]], y)) message("* x[[i,j]] <- value ...") ## Assign single element x[[3]] <- -x[[3]] stopifnot(identical(x[[3]], -3L)) x[[1,1]] <- -x[[1,1]] stopifnot(identical(x[[1]], -1L)) x[[2,3]] <- -x[[2,3]] stopifnot(identical(x[[6]], -6L)) x[["a",3]] <- -x[["a",3]] stopifnot(identical(x[[1,3]], -5L)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Multi-element subsetting ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("* x[i], x[i,j] ...") x <- as.listenv(1:24) dim(x) <- c(2,3,4) names(x) <- letters[seq_along(x)] x[2] <- list(NULL) print(x) y <- x[] print(y) stopifnot(length(y) == length(x)) stopifnot(all.equal(y, x)) stopifnot(!identical(y, x)) stopifnot(all.equal(as.list(y), as.list(x)[])) y <- x[1] print(y) stopifnot(all.equal(as.list(y), as.list(x)[1])) y <- x[2:3] print(y) stopifnot(all.equal(as.list(y), as.list(x)[2:3])) y <- x[-1] print(y) stopifnot(all.equal(as.list(y), as.list(x)[-1])) y <- x[1:2,1:3,1:4] print(y) stopifnot(all.equal(dim(y), dim(x))) stopifnot(all.equal(y, x)) stopifnot(all.equal(unlist(y), unlist(x))) stopifnot(all.equal(as.list(y), as.list(x)[1:2,1:3,1:4], check.attributes=FALSE)) y <- x[0,0,0] print(y) stopifnot(length(y) == 0) stopifnot(all.equal(dim(y), c(0,0,0))) stopifnot(all.equal(y, as.list(x)[0,0,0])) y <- x[0,,] print(y) stopifnot(length(y) == 0) stopifnot(all.equal(dim(y), c(0,dim(x)[-1]))) stopifnot(all.equal(y, as.list(x)[0,,])) y <- x[2,1,,drop=FALSE] print(y) stopifnot(all.equal(dim(y), c(1,1,dim(x)[3]))) stopifnot(all.equal(as.list(y), as.list(x)[2,1,,drop=FALSE], check.attributes=FALSE)) y <- x[2,1,,drop=TRUE] print(y) stopifnot(is.null(dim(y))) stopifnot(all.equal(as.list(y), as.list(x)[2,1,,drop=TRUE], check.attributes=FALSE)) y <- x[2,1,] print(y) stopifnot(is.null(dim(y))) stopifnot(all.equal(as.list(y), as.list(x)[2,1,], check.attributes=FALSE)) y <- x[-1,,c(3,3,1)] print(y) stopifnot(all.equal(as.list(y), as.list(x)[-1,,c(3,3,1)], check.attributes=FALSE)) message("* x[i], x[i,j] ... DONE") message("* x[i] <- value, x[i,j] <- value ...") dim <- c(2,3) n <- prod(dim) names <- letters[seq_len(n)] x0 <- as.list(1:n) dim(x0) <- dim names(x0) <- names x <- as.listenv(1:n) dim(x) <- dim names(x) <- names x0[] <- 6:1 x[] <- 6:1 stopifnot(all(unlist(x) == unlist(x0))) x0[1,] <- 1:3 x[1,] <- 1:3 stopifnot(all(unlist(x) == unlist(x0))) x0[,-2] <- 1:2 x[,-2] <- 1:2 stopifnot(all(unlist(x) == unlist(x0))) message("* x[i] <- value, x[i,j] <- value ... DONE") message("* Exceptions ...") x <- listenv() res <- try(dim(x) <- c(2,3), silent=TRUE) stopifnot(inherits(res, "try-error")) length(x) <- 6 dim(x) <- c(2,3) res <- try(x[[3,3]], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[3,3], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[c(-1,1),3], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[c(TRUE, TRUE, TRUE),], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(dimnames(x) <- NA, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(dimnames(x) <- list("a", "b", "c"), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(dimnames(x) <- list("a", NULL), silent=TRUE) stopifnot(inherits(res, "try-error")) dimnames(x) <- list(c("a", "b"), NULL) message("* Changing dim(x) and dimnames(x) ...") x <- listenv() x[1:12] <- 1:12 dim(x) <- c(2,2,3) dimnames(x) <- list(c("a", "b"), NULL, NULL) print(x) stopifnot(identical(dim(x), c(2L,2L,3L))) stopifnot(identical(dimnames(x), list(c("a", "b"), NULL, NULL))) x[[2,1,2]] <- -x[[2,1,2]] y <- unlist(x) print(y) dim(x) <- c(4,3) print(x) stopifnot(identical(dim(x), c(4L,3L))) stopifnot(is.null(dimnames(x))) x[[2,2]] <- -x[[2,2]] y <- unlist(x) print(y) stopifnot(identical(y, 1:12)) message("* List environment and multiple dimensions ... DONE") ## Cleanup options(oopts) rm(list=setdiff(ls(envir=globalenv()), ovars), envir=globalenv()) listenv/tests/parse_env_subset,dimensions.R0000644000176200001440000000654312640067030020745 0ustar liggesuserslibrary("listenv") ovars <- ls(envir=globalenv()) if (exists("x")) rm(list="x") if (exists("y")) rm(list="y") ## - - - - - - - - - - - - - - - - - - - - - - - - - - ## Multi-dimensional subsetting ## - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** parse_env_subset() on multi-dimensional listenv ...") x <- listenv() length(x) <- 6 dim(x) <- c(2,3) target <- parse_env_subset(x[[2]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$idx == 2, !target$exists) target <- parse_env_subset(x[[1,2]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$idx == 3, !target$exists) x[[1,2]] <- 1.2 target <- parse_env_subset(x[[1,2]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$idx == 3, target$exists) target <- parse_env_subset(x[[1,4]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), is.na(target$idx), !target$exists) ## Assert that x[[1,4]] is not the same as x[[c(1,4)]] target <- parse_env_subset(x[[1,4]], substitute=TRUE) str(target) target2 <- parse_env_subset(x[[c(1,4)]], substitute=TRUE) str(target2) target$code <- target2$code <- NULL stopifnot(!isTRUE(all.equal(target2, target))) dimnames(x) <- list(c("a", "b"), c("A", "B", "C")) print(x) target <- parse_env_subset(x[["a",2]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$idx == 3, target$exists) target <- parse_env_subset(x[["a","B"]], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$idx == 3, target$exists) target <- parse_env_subset(x["a","B"], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), target$idx == 3, target$exists) target <- parse_env_subset(x["a",1:3], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), length(target$idx) == 3, all(target$idx == c(1,3,5))) target <- parse_env_subset(x["a",], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), length(target$idx) == 3, all(target$idx == c(1,3,5))) target <- parse_env_subset(x["a",-1], substitute=TRUE) str(target) stopifnot(identical(target$envir, x), length(target$idx) == 2, all(target$idx == c(3,5))) message("*** parse_env_subset() on multi-dimensional listenv ... DONE") ## - - - - - - - - - - - - - - - - - - - - - - - - - - ## Exception handling ## - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** parse_env_subset() on multi-dimensional listenv - exceptions ...") x <- listenv() ## Multidimensional subsetting on 'x' without dimensions res <- try(target <- parse_env_subset(x[[1,2]], substitute=TRUE), silent=TRUE) stopifnot(inherits(res, "try-error")) ## Multi-dimensional subsetting x <- listenv() length(x) <- 6 dim(x) <- c(2,3) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - ## FIXME: Should zero indices give parse errors or not? ## - - - - - - - - - - - - - - - - - - - - - - - - - - - res <- try(target <- parse_env_subset(x[[0]], substitute=TRUE), silent=TRUE) ## stopifnot(inherits(res, "try-error")) res <- try(target <- parse_env_subset(x[[1,0]], substitute=TRUE), silent=TRUE) ## stopifnot(inherits(res, "try-error")) res <- try(target <- parse_env_subset(x[[1,2,3]], substitute=TRUE), silent=TRUE) ## stopifnot(inherits(res, "try-error")) message("*** parse_env_subset() on multi-dimensional listenv - exceptions ... DONE") ## Cleanup rm(list=setdiff(ls(envir=globalenv()), ovars), envir=globalenv()) listenv/tests/listenv.R0000644000176200001440000003560712640067030014720 0ustar liggesuserslibrary("listenv") ovars <- ls(envir=globalenv()) oopts <- options(warn=1) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Allocation ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() print(x) stopifnot(length(x) == 0) stopifnot(is.null(names(x))) x <- listenv(a=1) print(x) stopifnot(length(x) == 1) stopifnot(identical(names(x), c("a"))) stopifnot(identical(x$a, 1)) x <- listenv(a=1, b=2:3) print(x) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$a, 1), identical(x$b, 2:3)) x <- listenv(b=2:3, .a=1) print(x) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("b", ".a"))) stopifnot(identical(x$.a, 1), identical(x$b, 2:3)) x <- listenv(length=3, a=1) print(x) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("length", "a"))) stopifnot(identical(x$length, 3), identical(x$a, 1)) withCallingHandlers({ x <- listenv(length=3) }, warning = function(warn) { cat("WARNING:", warn$message) invokeRestart("muffleWarning") }) print(x) stopifnot(length(x) == 3) stopifnot(is.null(names(x))) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Single-element assignments and subsetting ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 0) x$a <- 1 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 1) stopifnot(identical(names(x), c("a"))) stopifnot(identical(x$a, 1), is.null(x$b)) x$b <- 2 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$b, 2)) x$a <- 0 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x[["a"]], 0)) x$"a" <- 1 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$a, 1)) x[["a"]] <- 0 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) key <- "b" x[[key]] <- 3 print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(x$b, 3), identical(x[["b"]], 3), identical(x[[key]], 3)) x[[3]] <- 3.14 print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", ""))) stopifnot(identical(x[[3]], 3.14)) names(x) <- c("a", "b", "c") stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(x[[3]], 3.14), identical(x[["c"]], 3.14), identical(x$c, 3.14)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Multi-element subsetting ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Assert than no false names are introduced x <- listenv() x[1:3] <- list(1, NULL, 3) print(x) stopifnot(is.null(names(x))) y <- x[] print(y) stopifnot(length(y) == length(x)) stopifnot(all.equal(y, x)) stopifnot(!identical(y, x)) stopifnot(is.null(names(y))) y <- x[1] print(y) stopifnot(is.null(names(y))) y <- x[2:3] print(y) stopifnot(is.null(names(y))) y <- x[-1] print(y) stopifnot(is.null(names(y))) x[c('c', '.a', 'b')] <- list(NULL, 3, 1) print(x) stopifnot(identical(names(x), c("", "", "", "c", ".a", "b"))) y <- as.list(x) str(y) stopifnot(identical(names(y), c("", "", "", "c", ".a", "b"))) y <- as.list(x, all.names=FALSE) str(y) stopifnot(identical(names(y), c("", "", "", "c", "b"))) y <- as.list(x, sorted=TRUE) str(y) stopifnot(identical(names(y), c("", "", "", ".a", "b", "c"))) y <- as.list(x, all.names=FALSE, sorted=TRUE) str(y) stopifnot(identical(names(y), c("", "", "", "b", "c"))) x <- listenv() x[c('a', 'b', 'c')] <- list(1, NULL, 3) y <- x[NULL] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list())) y <- x[integer(0L)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list())) y <- x["a"] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a=1))) y <- x[c("a","c")] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a=1, c=3))) y <- x[c("c","a")] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(c=3, a=1))) y <- x[c(1,3)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a=1, c=3))) y <- x[-2] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a=1, c=3))) y <- x[-c(1,3)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(b=NULL))) y <- x[rep(1L, times=6L)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, rep(list(a=1), times=6L))) y <- x[1:10] print(y) z <- as.list(y) print(z) stopifnot(identical(z, c(as.list(x), rep(list(NULL), times=7L)))) y <- x[c(TRUE, FALSE, TRUE)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a=1, c=3))) y <- x[c(TRUE, FALSE)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list(a=1, c=3))) y <- x[TRUE] print(y) z <- as.list(y) print(z) stopifnot(identical(z, as.list(x))) y <- x[FALSE] print(y) z <- as.list(y) print(z) stopifnot(identical(z, list())) y <- x[rep(TRUE, times=5L)] print(y) z <- as.list(y) print(z) stopifnot(identical(z, c(as.list(x), list(NULL), list(NULL)))) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Local access ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv(a=1, b=2, c=3.14) y <- local({ x[[3]] }) stopifnot(identical(y, 3.14)) y <- local({ x[3] }) stopifnot(identical(y[[1]], 3.14)) y <- local({ ii <- 3 x[[ii]] }) stopifnot(identical(y, 3.14)) y <- local({ ii <- 3 x[ii] }) stopifnot(identical(y[[1]], 3.14)) local({ x[[3]] <- 42L }) y <- x[[3]] stopifnot(identical(y, 42L)) local({ x[3] <- 3.14 }) y <- x[[3]] stopifnot(identical(y, 3.14)) local({ ii <- 3 x[ii] <- 42L }) y <- x[[3]] stopifnot(identical(y, 42L)) local({ ii <- 3 x[[ii]] <- 3.14 }) y <- x[[3]] stopifnot(identical(y, 3.14)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Removing elements ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x[["a"]] <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("b", "c"))) x[[3L]] <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("b", "c"))) x[[2L]] <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 1) stopifnot(identical(names(x), c("b"))) x$b <- NULL print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 0) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Assigning NULL ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x[2L] <- list(NULL) print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("", ""))) x['c'] <- list(NULL) print(x) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("", "", "c"))) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Assigning multiple elements at once ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() x[c('a', 'b', 'c')] <- 1:3 print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a=1L, b=2L, c=3L))) stopifnot(identical(unlist(x), c(a=1L, b=2L, c=3L))) x[] <- 3:1 stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a=3L, b=2L, c=1L))) x[c('c', 'b')] <- 2:3 print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a=3L, b=3L, c=2L))) x[c('a', 'c')] <- 1L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", "c"))) stopifnot(identical(as.list(x), list(a=1L, b=3L, c=1L))) x[c('d', 'e')] <- 4:5 print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 5) stopifnot(identical(names(x), c("a", "b", "c", "d", "e"))) stopifnot(identical(as.list(x), list(a=1L, b=3L, c=1L, d=4L, e=5L))) x <- listenv() x[c('a', 'b')] <- 1:2 x[c(TRUE,FALSE)] <- 2L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(as.list(x), list(a=2L, b=2L))) x[c(TRUE)] <- 1L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 2) stopifnot(identical(names(x), c("a", "b"))) stopifnot(identical(as.list(x), list(a=1L, b=1L))) x[c(TRUE,FALSE,TRUE,FALSE)] <- 3L print(x) str(as.list(x)) print(length(x)) print(names(x)) stopifnot(length(x) == 3) stopifnot(identical(names(x), c("a", "b", ""))) stopifnot(identical(as.list(x), list(a=3L, b=1L, 3L))) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Expanding ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() for (ii in 1:3) { x[[ii]] <- letters[ii] print(x[[ii]]) } print(x) names(x) <- sprintf("item%d", seq_along(x)) print(x) y <- as.list(x) str(y) stopifnot(identical(names(y), c("item1", "item2", "item3"))) stopifnot(identical(y[[1]], "a"), identical(y[[2]], "b"), identical(y[[3]], "c")) x[[2]] <- "B" stopifnot(identical(x$item2, "B")) x <- listenv() x[[1]] <- { 1 } x[[3]] <- { "Hello world!" } stopifnot(length(x) == 3) stopifnot(identical(seq_along(x), seq_len(length(x)))) print(x) names(x) <- c("a", "b", "c") print(x) x$b <- TRUE stopifnot(identical(x[[1]], 1)) stopifnot(identical(x[[2]], TRUE)) stopifnot(identical(x$b, TRUE)) stopifnot(identical(x[["b"]], TRUE)) y <- as.list(x) str(y) stopifnot(length(y) == 3) ## Mixed names and indices x <- listenv() x$a <- 1 x[[3]] <- 3 print(names(x)) stopifnot(identical(names(x), c("a", "", ""))) # First element (should be named 'a') var <- get_variable(x, "a") stopifnot(var == "a") var <- get_variable(x, 1) stopifnot(var == "a") # Third element (should be a temporary name) var <- get_variable(x, 3) stopifnot(var != "c") names(x) <- c("a", "b", "c") var <- get_variable(x, 3) stopifnot(var != "c") var <- get_variable(x, "c") stopifnot(var != "c") ## Second element (should become 'b', because it was never used # before it was "named" 'b') x$b <- 2 var <- get_variable(x, 2) stopifnot(var == "b") var <- get_variable(x, "b") stopifnot(var == "b") ## Names where as.integer(names(x)) are integers x <- listenv() x[["1"]] <- 1 x[["3"]] <- 3 print(names(x)) stopifnot(identical(names(x), c("1", "3"))) ## Expand and shrink x <- listenv() stopifnot(length(x) == 0L) length(x) <- 3L stopifnot(length(x) == 3L) stopifnot(is.null(names(x))) names(x) <- c("a", "b", "c") x$a <- 2 stopifnot(identical(x$a, 2)) x[c("a", "c")] <- c(2,1) stopifnot(identical(x$a, 2), identical(x$c, 1)) length(x) <- 4L stopifnot(length(x) == 4L) stopifnot(identical(names(x), c("a", "b", "c", ""))) length(x) <- 1L stopifnot(length(x) == 1L) stopifnot(identical(names(x), c("a"))) stopifnot(identical(x$a, 2)) length(x) <- 0L stopifnot(length(x) == 0L) stopifnot(length(names(x)) == 0) ## Actually, character(0), cf. lists ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Flatten ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - for (recursive in c(FALSE, TRUE)) { x <- list(); x$a <- list(B=1:3); x$b <- list(C=1:3, D=4:5) y1 <- unlist(x, recursive=recursive) x <- listenv(); x$a <- list(B=1:3); x$b <- list(C=1:3, D=4:5) y2 <- unlist(x, recursive=recursive) stopifnot(identical(y2, y1)) } # for (recursive ...) x <- listenv(); x$a <- list(B=1:3); x$b <- as.listenv(list(C=1:3, D=4:5)) y3 <- unlist(x, recursive=TRUE) stopifnot(identical(y3, y1)) x <- listenv() y <- unlist(x) stopifnot(length(y) == 0) stopifnot(is.null(y)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Comparisons ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv(c=NULL, .a=3, b=1) print(x) ## A list environment is always equal to itself stopifnot(all.equal(x, x)) ## List environments emulate lists stopifnot(all.equal(x, list(c=NULL, .a=3, b=1))) stopifnot(all.equal(x, list(c=NULL, .a=3, b=1), sorted=TRUE)) stopifnot(all.equal(x, list(.a=3, b=1, c=NULL), sorted=TRUE)) stopifnot(all.equal(x, list(c=NULL, b=1), all.names=FALSE)) stopifnot(all.equal(x, list(.a=3, c=NULL, b=1), all.names=FALSE)) stopifnot(all.equal(x, list(b=1, c=NULL), all.names=FALSE, sorted=TRUE)) res <- all.equal(x, list(b=1, c=NULL), sorted=FALSE) stopifnot(!isTRUE(res)) res <- all.equal(x, list(b=1, c=NULL), all.names=FALSE) stopifnot(!isTRUE(res)) ## Assert listenv() -> as.list() -> as.listenv() equality y <- as.list(x) stopifnot(identical(names(y), names(x))) z <- as.listenv(y) stopifnot(identical(names(z), names(y))) stopifnot(all.equal(x, y)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Warnings ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() x[1:3] <- 1:3 res <- tryCatch(x[1:2] <- 1:4, warning=function(w) { class(w) <- "try-warning" w }) stopifnot(inherits(res, "try-warning")) res <- tryCatch(x[1:3] <- 1:2, warning=function(w) { class(w) <- "try-warning" w }) stopifnot(inherits(res, "try-warning")) res <- tryCatch(x[integer(0L)] <- 1, warning=function(w) { class(w) <- "try-warning" w }) stopifnot(!inherits(res, "try-warning")) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Exception handling ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- listenv() length(x) <- 3L names(x) <- c("a", "b", "c") res <- try(names(x) <- c("a", "b"), silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1:2]], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[0]], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[length(x)+1]], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1+2i]], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[1+2i], silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1+2i]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[1+2i] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[integer(0L)]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[1:2]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[Inf]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[0]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[-1]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[character(0L)]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[c("a", "b")]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) res <- try(x[[""]] <- 1, silent=TRUE) stopifnot(inherits(res, "try-error")) ## Cleanup options(oopts) rm(list=setdiff(ls(envir=globalenv()), ovars), envir=globalenv()) listenv/tests/as.listenv.R0000644000176200001440000000133212640067030015306 0ustar liggesuserslibrary("listenv") ovars <- ls(envir=globalenv()) oopts <- options(warn=1) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Single-element assignments and subsetting ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - x <- list(a=1, b=2, c=3) str(x) y <- as.listenv(x) print(y) stopifnot(identical(as.list(y), x)) z <- as.listenv(y) stopifnot(identical(as.list(y), as.list(z))) e <- new.env() e$a <- 1 e$b <- 2 e$c <- 3 y <- as.listenv(e) print(y) stopifnot(identical(as.list(y), as.list(e))) x <- c(a=1, b=2, c=3) y <- as.listenv(x) print(y) stopifnot(identical(as.list(y), as.list(x))) ## Cleanup options(oopts) rm(list=setdiff(ls(envir=globalenv()), ovars), envir=globalenv()) listenv/NAMESPACE0000644000176200001440000000150512640067030013154 0ustar liggesusers# Generated by roxygen2: do not edit by hand S3method("$",listenv) S3method("$<-",listenv) S3method("[",listenv) S3method("[<-",listenv) S3method("[[",listenv) S3method("[[<-",listenv) S3method("dim<-",listenv) S3method("dimnames<-",listenv) S3method("length<-",listenv) S3method("names<-",listenv) S3method(all.equal,listenv) S3method(as.list,listenv) S3method(as.listenv,default) S3method(as.listenv,environment) S3method(as.listenv,list) S3method(as.listenv,listenv) S3method(dim,listenv) S3method(dimnames,listenv) S3method(get_variable,listenv) S3method(length,listenv) S3method(names,listenv) S3method(print,listenv) S3method(undim,default) S3method(undim,listenv) S3method(unlist,listenv) export(as.listenv) export(get_variable) export(listenv) export(map) export(parse_env_subset) export(undim) listenv/NEWS0000644000176200001440000000371412640067030012440 0ustar liggesusersPackage: listenv ================ Version: 0.6.0 [2015-12-27] o Added support for multi-dimensional subsetting of list environments just as for list. o BUG FIX: parse_env_subset(x[[idx]]) for list environment 'x' and index 'idx' claimed x[[idx]] exists as long as idx in [1,length(x)] but it forgot to check if element really existed, which may not be true if 'x' has been expanded. Version: 0.5.0 [2015-10-30] o Add support for assigning elements when creating list environment similarly how to lists work, e.g. x <- listenv(a=1, b=2). o length(x) <- n now expand/truncate a list environment. o Added unlist() and all.equal() for list environments. o DEPRECATED: Deprecated x <- listenv(length=n). Instead use x <- listenv(); length(x) <- n. o BUG FIX: as.listenv(x) would drop NULL elements in 'x'. o BUG FIX: x[idxs], x[name] <- y and x$ <- y would introduce NA names for non-named list environments. Version: 0.4.0 [2015-08-08] o Added as.listenv(). o CONSISTENCY: Assigning NULL now removes element just as lists, e.g. x$a <- NULL. To assign value NULL, do x['a'] <- list(NULL). o Added support for subsetting with [(), which returns another list environment, e.g. x[2:3], x[-1] and x[c(TRUE, FALSE)]. o Added [<- assignment, e.g. x['a'] <- 1 and x[2:3] <- c(3,8). o CLEANUP: Dropped stray debug code. Version: 0.3.0 [2015-05-23] o Package no longer depends on other packages. Version: 0.2.4 [2015-05-22] o Added helper function parse_env_subset(). Version: 0.2.3 [2015-05-21] o print() on listenv() handles empty and no-named listenv:s better. Version: 0.2.2 [2015-05-20] o Now listenv(length=...) always allocates internal variables. Version: 0.2.1 [2015-05-19] o get_variable() gained argument 'mustExist'. Version: 0.2.0 [2015-05-19] o Moved list environments from an in-house package to its own package. Version: 0.1.4 [2015-05-02] o Added print() for listenv:s. o CLEANUP: Using tempvar() of R.utils. Version: 0.1.0 [2015-02-07] o Created. listenv/R/0000755000176200001440000000000012640067030012135 5ustar liggesuserslistenv/R/undim.R0000644000176200001440000000164412640067030013401 0ustar liggesusers#' Removes the dimension of an object #' #' @param x An object with or without dimensions #' @param ... Not used. #' #' @return The object with the dimension attribute removed. #' #' @details #' This function does \code{attr(x, "dim") <- NULL}, which #' automatically also does \code{attr(x, "dimnames") <- NULL}. #' However, other attributes such as names attributes are preserved, #' which is not the case if one do \code{dim(x) <- NULL}. #' #' @export #' @aliases undim.default #' @aliases undim.listenv undim <- function(x, ...) UseMethod("undim") #' @export undim.default <- function(x, ...) { if (is.null(dim(x))) return(x) attr(x, "dim") <- NULL ## Dimnames seems to be unset above, but in case it changes ... attr(x, "dimnames") <- NULL x } #' @export undim.listenv <- function(x, ...) { x <- NextMethod("undim") attr(x, "dim.") <- NULL attr(x, "dimnames.") <- NULL x } listenv/R/utils.R0000644000176200001440000000162012640067030013417 0ustar liggesusers## From R.utils 2.0.2 (2015-05-23) hpaste <- function(..., sep="", collapse=", ", lastCollapse=NULL, maxHead=if (missing(lastCollapse)) 3 else Inf, maxTail=if (is.finite(maxHead)) 1 else Inf, abbreviate="...") { maxHead <- as.double(maxHead) maxTail <- as.double(maxTail) if (is.null(lastCollapse)) lastCollapse <- collapse # Build vector 'x' x <- paste(..., sep=sep) n <- length(x) # Nothing todo? if (n == 0) return(x) if (is.null(collapse)) return(x) # Abbreviate? if (n > maxHead + maxTail + 1) { head <- x[seq(length=maxHead)] tail <- rev(rev(x)[seq(length=maxTail)]) x <- c(head, abbreviate, tail) n <- length(x) } if (!is.null(collapse) && n > 1) { if (lastCollapse == collapse) { x <- paste(x, collapse=collapse) } else { xT <- paste(x[1:(n-1)], collapse=collapse) x <- paste(xT, x[n], sep=lastCollapse) } } x } # hpaste() listenv/R/parse_env_subset.R0000644000176200001440000002151412640067030015632 0ustar liggesusers#' Helper function to infer target from expression and environment #' #' @param expr An expression. #' @param envir An environment. #' @param substitute If TRUE, then the expression is #' \code{substitute()}:ed, otherwise not. #' #' @return A named list. #' #' @export #' @keywords internal parse_env_subset <- function(expr, envir=parent.frame(), substitute=TRUE) { if (substitute) expr <- substitute(expr) code <- paste(deparse(expr), collapse="") res <- list(envir=envir, name="", op=NULL, subset=NULL, idx=NA_integer_, exists=NA, code=code) if (is.symbol(expr)) { ## Variable specified as a symbol res$name <- deparse(expr) } else if (is.character(expr)) { ## Variable specified as a name if (length(expr) > 1L) { stop(sprintf("Does not specify a single variable, but %d: %s", length(expr), hpaste(sQuote(expr), collapse=", ")), call.=FALSE) } res$name <- expr } else if (is.numeric(expr)) { ## Variable specified as a subset of envir if (length(expr) > 1L) { stop(sprintf("Does not specify a single index, but %d: %s", length(expr), hpaste(sQuote(expr), collapse=", ")), call.=FALSE) } res$subset <- list(expr) } else { n <- length(expr) stopifnot(n >= 2L) if (n >= 3L) { ## Assignment to enviroment via $ and [[ op <- as.character(expr[[1]]) res$op <- op if (op == "$" && n > 3L) { stop("Invalid syntax: ", sQuote(code), call.=FALSE) } else if (!is.element(op, c("$", "[[", "["))) { stop("Invalid syntax: ", sQuote(code), call.=FALSE) } ## Target objname <- deparse(expr[[2]]) if (!exists(objname, envir=envir, inherits=TRUE)) { stop(sprintf("Object %s not found: %s", sQuote(objname), sQuote(code)), call.=FALSE) } obj <- get(objname, envir=envir, inherits=TRUE) if (!is.environment(obj)) { stop(sprintf("Subsetting can not be done on a %s; only to an environment: %s", sQuote(mode(obj)), sQuote(code)), call.=FALSE) } res$envir <- obj ## Subset subset <- list() for (kk in 3:n) { missing <- (length(expr[[kk]]) == 1L) && (expr[[kk]] == "") if (missing) { subsetKK <- NULL } else { subsetKK <- expr[[kk]] } if (is.symbol(subsetKK)) { subsetKK <- deparse(subsetKK) if (op == "[[") { if (!exists(subsetKK, envir=envir, inherits=TRUE)) { stop(sprintf("Object %s not found: %s", sQuote(subsetKK), sQuote(code)), call.=FALSE) } subsetKK <- get(subsetKK, envir=envir, inherits=TRUE) } } else if (is.language(subsetKK)) { subsetKK <- eval(subsetKK, envir=envir) } if (is.null(subsetKK)) { subset[kk-2L] <- list(NULL) } else { subset[[kk-2L]] <- subsetKK } } res$subset <- subset } # if (n >= 3) } # if (is.symbol(expr)) ## Validat name, iff any name <- res$name if (nzchar(name) && !grepl("^[.a-zA-Z]+", name)) stop("Not a valid variable name: ", sQuote(name), call.=FALSE) ## Validate subsetting, e.g. x[[1]], x[["a"]], and x$a, iff any subset <- res$subset if (!is.null(subset)) { if (!is.list(subset)) { stop(sprintf("INTERNAL ERROR (expected 'subset' to be a list): %s", sQuote(code)), call.=FALSE) } if (length(subset) == 0L) { stop(sprintf("Subsetting of at least on element is required: %s", sQuote(code)), call.=FALSE) } for (kk in seq_along(subset)) { subsetKK <- subset[[kk]] if (is.null(subsetKK)) { } else if (any(is.na(subsetKK))) { stop(sprintf("Invalid subsetting. Subset must not contain missing values: %s", sQuote(code)), call.=FALSE) } else if (is.character(subsetKK)) { if (!all(nzchar(subsetKK))) { stop(sprintf("Invalid subset. Subset must not contain empty names: %s", sQuote(code)), call.=FALSE) } } else if (is.numeric(subsetKK)) { } else { stop(sprintf("Invalid subset of type %s: %s", sQuote(typeof(subsetKK)), sQuote(code)), call.=FALSE) } } # for (kk ...) ## Special: listenv:s envir <- res$envir stopifnot(is.environment(envir)) if (inherits(envir, "listenv")) { names <- names(envir) map <- map(envir) dim <- dim(envir) op <- res$op if (is.null(op)) op <- "[[" ## Multi-dimensional subsetting? if (length(subset) > 1L) { if (is.null(dim)) { stop("Multi-dimensional subsetting on list environment without dimensions: ", sQuote(code), call.=TRUE) } dimnames <- dimnames(envir) exists <- TRUE for (kk in seq_along(subset)) { subsetKK <- subset[[kk]] if (is.null(subsetKK)) { subset[[kk]] <- seq_len(dim[kk]) } else if (is.numeric(subsetKK)) { exists <- exists && (subsetKK >= 1 && subsetKK <= dim[kk]) } else if (is.character(subsetKK)) { subsetKK <- match(subsetKK, dimnames[[kk]]) exists <- exists && !is.na(subsetKK) subset[[kk]] <- subsetKK } } ## Indexing scale factor per dimension ndim <- length(dim) scale <- c(1L, cumprod(dim[-ndim])) idx <- 1 for (kk in seq_along(subset)) { i <- subset[[kk]] stopifnot(is.numeric(i)) d <- dim[kk] if (any(i < 0)) { if (op == "[[") { stop("Invalid (negative) indices: ", hpaste(i)) } else if (any(i > 0)) { stop("only 0's may be mixed with negative subscripts") } ## Drop elements i <- setdiff(seq_len(d), -i) } if (any(i > d)) i[i > d] <- NA_integer_ ## Drop zeros i <- i[i != 0] i <- scale[kk]*(i - 1) if (kk == 1) { idx <- idx + i } else { idx <- outer(idx, i, FUN=`+`) } } # for (kk ...) res$idx <- idx res$name <- names[res$idx] if (length(res$name) == 0L) res$name <- "" if (exists) { exists <- !is.na(map[idx]) } res$exists <- exists } else { subset <- subset[[1L]] if (is.numeric(subset)) { i <- subset n <- length(envir) if (any(i < 0)) { if (op == "[[") { stop("Invalid (negative) indices: ", hpaste(i)) } else if (any(i > 0)) { stop("only 0's may be mixed with negative subscripts") } ## Drop elements i <- setdiff(seq_len(n), -i) } ## Drop zeros? keep <- which(i != 0) if (length(keep) != length(i)) { if (op == "[[") { ## BACKWARD COMPATIBILITY: ## In order not to break two `R CMD check` package tests ## for future 0.9.0 on CRAN, we tweak the result here in ## order for those two tests not to fail. /HB 2015-12-26 ## FIX ME: Remove when future (> 0.9.0) is on CRAN. if (identical(i, 0) && identical(code, "x[[0]]") && is.element("package:future", search()) && utils::packageVersion("future") <= "0.9.0") { res$idx <- i res$exists <- FALSE return(res) } stop("Invalid (zero) indices: ", hpaste(i)) } i <- i[keep] } res$idx <- i res$exists <- !is.na(map[res$idx]) & (res$idx >= 1 & res$idx <= n) res$name <- names[i] if (length(res$name) == 0L) res$name <- "" } else if (is.character(subset)) { res$idx <- match(subset, names) res$exists <- !is.na(res$idx) && !is.na(map[res$idx]) } } } else { if (length(subset) > 1L) { stop("Invalid subset: ", sQuote(code), call.=TRUE) } subset <- subset[[1L]] } if (is.character(subset)) res$name <- subset } ## Identify index? if (inherits(res$envir, "listenv")) { envir <- res$envir 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]) } ## Validate if (is.null(dim) && length(res$subset) == 1 && identical(res$op, "[")) { if (any(is.na(res$idx)) && !nzchar(res$name)) { stop("Invalid subset: ", sQuote(code), call.=TRUE) } } unknown <- which(is.na(res$exists)) if (length(unknown) > 0) { res$exists[unknown] <- sapply(unknown, FUN=function(idx) { exists(res$name[idx], envir=res$envir, inherits=TRUE) }) } ## Sanity check stopifnot(is.environment(res$envir)) stopifnot(is.character(res$name)) stopifnot(is.null(res$idx) || all(is.numeric(res$idx))) stopifnot(is.logical(res$exists), !anyNA(res$exists)) stopifnot(length(res$exists) == length(res$idx)) res } listenv/R/get_variable.R0000644000176200001440000000447712640067030014720 0ustar liggesusers#' Get name of variable for a specific element of list environment #' #' @param x A list environment. #' @param name The name or index of element of interest. #' @param mustExist If TRUE, an error is generated if \code{name} #' does not exist. #' @param create If TRUE, element \code{name} is created if missing. #' #' @return The name of the underlying variable #' #' @aliases get_variable.listenv #' @export #' @keywords internal get_variable <- function(...) UseMethod("get_variable") #' @export get_variable.listenv <- function(x, name, mustExist=FALSE, create=!mustExist, ...) { if (is.character(name)) { } else if (is.numeric(name)) { } else { stop("Subscript must be a name or an index: ", mode(name), call.=FALSE) } dim <- dim(x) if (is.null(dim)) { if (length(name) != 1L) { stop("Subscript must be a scalar: ", length(name), call.=FALSE) } } else { ndim <- length(dim) if (length(name) != 1L && length(name) != ndim) { stop(sprintf("Subscript must be a scalar or of equal length as the number of dimension (%d): %d", ndim, length(name)), call.=FALSE) } ## Map multi-dimensional index to scalar index if (length(name) > 1L) { stopifnot(is.numeric(name)) idxs <- name if (anyNA(idxs)) stop("Unknown index detected") for (kk in seq_len(ndim)) { if (idxs[kk] < 1 || idxs[kk] > dim[kk]) { stop(sprintf("Index #%d out of range [1,%d]: %s", kk, dim[kk], idxs[kk])) } } bases <- rev(c(cumprod(dim[-ndim]), 1)) idx <- sum(bases * (idxs-1)) + 1 name <- idx } } map <- map(x) ## Existing variable? var <- map[name] if (length(var) == 1L && !is.na(var)) return(var) if (mustExist) { stop(sprintf("No such %s element: %s", sQuote(class(x)[1]), name)) } ## Create new variable if (is.character(name)) { var <- name ## Non-existing name? if (!is.element(name, names(map))) { map <- c(map, var) names(map)[length(map)] <- var } } else if (is.numeric(name)) { i <- name ## Expand map? if (i > length(map)) { extra <- rep(NA_character_, times=i-length(map)) map <- c(map, extra) } ## Create internal variable var <- new_variable(x, value=NULL, create=create) map[i] <- var } ## Update map? if (create) map(x) <- map var } listenv/R/listenv.R0000644000176200001440000005377512640067030013765 0ustar liggesusers#' Create a list environment #' #' @param \dots (optional) Named and/or unnamed objects to be #' assigned to the list environment. #' #' @return An environment of class `listenv`. #' #' @example incl/listenv.R #' #' @aliases as.listenv #' @export listenv <- function(...) { args <- list(...) nargs <- length(args) names <- names(args) ## Allocate empty list environment metaenv <- new.env(parent=parent.frame()) env <- new.env(parent=metaenv) ## Add elements? if (nargs > 0L) { ## Backward compatibility if (nargs == 1L && identical(names[1L], "length")) { .Deprecated(msg="Use of x <- listenv(length=n) to allocate a list environment of length n is deprecated. Use x <- listenv(); length(x) <- n instead.") length <- args$length stopifnot(length >= 0L) args <- vector("list", length=length) nargs <- length names <- NULL } } ## Allocate internal variables maps <- sprintf(".listenv_var_%d", seq_len(nargs)) names(maps) <- names for (kk in seq_len(nargs)) { assign(maps[kk], value=args[[kk]], envir=env, inherits=FALSE) } metaenv$.listenv.map <- maps assign(".listenv_var_count", nargs, envir=env, inherits=FALSE) class(env) <- c("listenv", class(env)) env } #' @export #' @rdname listenv as.listenv <- function(...) UseMethod("as.listenv") #' @export as.listenv.listenv <- function(x, ...) { x } #' @export as.listenv.list <- function(x, ...) { nx <- length(x) res <- listenv() length(res) <- nx names(res) <- names <- names(x) for (kk in seq_len(nx)) { value <- x[[kk]] if (is.null(value)) value <- list(NULL) res[[kk]] <- value } ## Set dimensions? dim <- dim(x) if (!is.null(dim)) { dim(res) <- dim dimnames(res) <- dimnames(x) names(res) <- names } res } #' @export as.listenv.environment <- function(x, ...) { as.listenv(as.list(x, ...)) } #' @export as.listenv.default <- function(x, ...) { as.listenv(as.list(x, ...)) } #' @export print.listenv <- function(x, ...) { n <- length(x) dim <- dim(x) ndim <- length(dim) names <- names(x) dimnames <- dimnames(x) class <- class(x)[1L] if (ndim <= 1) { what <- "vector" } else if (ndim == 2) { what <- "matrix" } else { what <- "array" } s <- sprintf("A %s %s with %d", sQuote(class), what, n) if (is.null(names) && n > 0) { s <- sprintf("%s unnamed", s) } if (n == 1) { s <- sprintf("%s element", s) } else { s <- sprintf("%s elements", s) } if (!is.null(names)) { s <- sprintf("%s (%s)", s, hpaste(sQuote(names))) } if (ndim > 1) { dimstr <- paste(dim, collapse="x") hasDimnames <- !sapply(dimnames, FUN=is.null) dimnamesT <- sapply(dimnames, FUN=function(x) hpaste(sQuote(x))) s <- sprintf("%s arranged in %s", s, dimstr) if (ndim == 2) { if (is.null(dimnames)) { s <- sprintf("%s unnamed rows and columns", s, dimstr) } else { if (all(hasDimnames)) { s <- sprintf("%s rows (%s) and columns (%s)", s, dimnamesT[1L], dimnamesT[2L]) } else if (hasDimnames[1]) { s <- sprintf("%s rows (%s) and unnamed columns", s, dimnamesT[1L]) } else if (hasDimnames[2]) { s <- sprintf("%s unnamed rows and columns (%s)", s, dimnamesT[2L]) } else { s <- sprintf("%s unnamed rows and columns", s, dimstr) } } } else { if (is.null(dimnames)) { s <- sprintf("%s unnamed dimensions", s) } else { dimnamesT[!hasDimnames] <- "NULL" dimnamesT <- sprintf("#%d: %s", seq_along(dimnamesT), dimnamesT) dimnamesT <- paste(dimnamesT, collapse="; ") if (all(hasDimnames)) { s <- sprintf("%s dimensions (%s)", s, dimnamesT) } else if (!any(hasDimnames)) { s <- sprintf("%s unnamed dimensions", s) } else { s <- sprintf("%s partially named dimensions (%s)", s, dimnamesT) } } } } s <- sprintf("%s.\n", s) cat(s) } #' Variable name map for elements of list environment #' #' @param x A list environment. #' #' @return The a named character vector #' #' @aliases map.listenv #' @export #' @keywords internal map <- function(x, ...) { get(".listenv.map", envir=parent.env(x), inherits=FALSE) } `map<-` <- function(x, value) { stopifnot(is.character(value)) assign(".listenv.map", value, envir=parent.env(x), inherits=FALSE) invisible(x) } #' Number of elements in list environment #' #' @param x A list environment. #' #' @export #' @keywords internal length.listenv <- function(x) { length(map(x)) } #' @export `length<-.listenv` <- function(x, value) { map <- map(x) n <- length(map) value <- as.numeric(value) if (value < 0) stop("invalid value") ## Nothing to do? if (value == n) return(invisible(x)) ## Expand or shrink? if (value > n) { ## Add place holders for added elements extra <- rep(NA_character_, times=value-n) map <- c(map, extra) } else { ## Drop existing variables drop <- (value+1):n var <- map[drop] ## Some may be internal place holders var <- var[!is.na(var)] if (length(var) > 0) remove(list=var, envir=x, inherits=FALSE) map <- map[-drop] } map(x) <- map invisible(x) } #' Names of elements in list environment #' #' @param x A list environment. #' #' @aliases names<-.listenv #' @export #' @keywords internal names.listenv <- function(x) { names(map(x)) } #' @export `names<-.listenv` <- function(x, value) { map <- map(x) if (is.null(value)) { } else if (length(value) != length(map)) { stop(sprintf("Number of names does not match the number of elements: %s != %s", length(value), length(map))) } ## if (any(duplicated(value))) { ## stop("Environments cannot have duplicate names on elements") ## } names(map) <- value map(x) <- map invisible(x) } #' List representation of a list environment #' #' @param x A list environment. #' @param all.names If \code{TRUE}, variable names starting with #' a period are included, otherwise not. #' @param sorted If \code{TRUE}, elements are ordered by their names #' before being compared, otherwise not. #' @param ... Not used. #' #' @return A list. #' #' @export #' @keywords internal as.list.listenv <- function(x, all.names=TRUE, sorted=FALSE, ...) { vars <- map(x) nvars <- length(vars) names <- names(x) ## Drop names starting with a period if (!all.names && nvars > 0) { keep <- !grepl("^[.]", names) vars <- vars[keep] names <- names[keep] nvars <- length(vars) } ## Sort by names? if (sorted && nvars > 0) { o <- order(names) vars <- vars[o] names <- names[o] } ## Collect as a named list res <- vector("list", length=nvars) names(res) <- names if (nvars > 0) { ok <- !is.na(vars) res[ok] <- mget(vars[ok], envir=x, inherits=FALSE) } ## Set dimensions? dim <- dim(x) if (!is.null(dim)) { dim(res) <- dim dimnames(res) <- dimnames(x) names(res) <- names } res } #' Get elements of list environment #' #' @param x A list environment. #' @param name The name or index of the element to retrieve. #' #' @return The value of an element or NULL if the element does not exist #' #' @aliases [[.listenv #' @aliases [.listenv #' @export #' @keywords internal `$.listenv` <- function(x, name) { #' @keywords internal map <- map(x) var <- map[name] ## Non-existing variable? if (is.na(var)) return(NULL) get(var, envir=x, inherits=FALSE) } ## [[i,j,...]] -> [[idx]] toIndex <- function(x, idxs) { nidxs <- length(idxs) dim <- dim(x) if (is.null(dim)) dim <- length(x) ndim <- length(dim) if (ndim != nidxs) { stop("incorrect number of dimensions") } dimnames <- dimnames(x) idxDimnames <- dimnames ## Indexing scale factor per dimension scale <- c(1L, cumprod(dim[-ndim])) ## Subset idx <- 1 for (kk in 1:nidxs) { i <- idxs[[kk]] ni <- length(i) if (is.character(i)) { name <- i i <- match(name, table=dimnames[[kk]]) if (anyNA(i)) stop("subscript out of bounds") } else if (is.logical(i)) { d <- dim[kk] ni <- length(i) if (ni > d) stop("(subscript) logical subscript too long") if (ni < d) i <- rep(i, length.out=d) i <- which(i) } else if (is.numeric(i)) { d <- dim[kk] if (any(i > d)) stop("subscript out of bounds") if (any(i < 0)) { if (any(i > 0)) { stop("only 0's may be mixed with negative subscripts") } ## Drop elements i <- setdiff(seq_len(d), -i) } ## Drop zeros i <- i[i != 0] } else { stop("invalid subscript type", sQuote(typeof(i))) } ## Subset dimnames? if (!is.null(idxDimnames)) { dn <- idxDimnames[[kk]] if (!is.null(dn)) idxDimnames[[kk]] <- dn[i] } i <- scale[kk]*(i - 1) if (kk == 1) { idx <- idx + i } else { idx <- outer(idx, i, FUN=`+`) } } # for (kk ...) ## Sanity check dim <- dim(idx) ndim <- length(dim) if (ndim != nidxs) { stop(sprintf("INTERNAL ERROR: Incompatible dimensions: %d != %d", ndim, nidxs)) } ## Preserve names(dim) names(dim(idx)) <- names(dim(x)) ## Preserve dimnames dimnames(idx) <- idxDimnames idx } # toIndex() #' @export `[[.listenv` <- function(x, ...) { map <- map(x) n <- length(map) idxs <- list(...) nidxs <- length(idxs) ## Subsetting by multiple dimensions? if (nidxs > 1L) { i <- toIndex(x, idxs) } else { i <- idxs[[1L]] if (is.character(i)) { name <- i i <- match(name, table=names(map)) if (is.na(i)) return(NULL) } else if (!is.numeric(i)) { return(NextMethod("[[")) } if (length(i) != 1L) { stop("Subsetting of more than one element at the time is not allowed for listenv's: ", length(i)) } if (i < 1L || i > n) { stop(sprintf("Subscript out of bounds [%d,%d]: %d", min(1,n), n, i), call.=FALSE) } } var <- map[i] ## Return default (NULL)? if (is.na(var) || !exists(var, envir=x, inherits=FALSE)) return(NULL) get(var, envir=x, inherits=FALSE) } #' @export `[.listenv` <- function(x, ..., drop=TRUE) { ## Need to allow for implicit indices, e.g. x[1,,2] idxs <- as.list(sys.call())[-(1:2)] idxs$drop <- NULL nidxs <- length(idxs) ## Assert that subsetting has correct shape dim <- dim(x) ndim <- length(dim) if (nidxs > 1 && nidxs != ndim) { stop(sprintf("Incorrect subsetting. Expected %d dimensions but got %d", ndim, nidxs)) } ## Implicitly specified dimensions missing <- sapply(idxs, FUN=function(x) is.symbol(x) && identical("", deparse(x))) if (any(missing)) { if (nidxs == ndim) { envir <- parent.frame() for (kk in seq_len(ndim)) { if (missing[kk]) { idxs[[kk]] <- seq_len(dim[kk]) } else { idxs[[kk]] <- eval(idxs[[kk]], envir=envir) } } } else if (nidxs == 1) { if (ndim == 0) { idxs <- list(seq_len(length(x))) } else { ## Special case: Preserve dimensions when x[] idxs <- lapply(dim, FUN=function(n) seq_len(n)) nidxs <- length(idxs) } } } else { envir <- parent.frame() idxs <- lapply(idxs, FUN=eval, envir=envir) } if (nidxs <= 1L) { i <- idxs[[1L]] } else { i <- toIndex(x, idxs) } map <- map(x) nmap <- length(map) names <- names(map) if (is.null(i)) { i <- integer(0L) } else if (is.character(i)) { name <- i i <- match(name, table=names) } else if (is.numeric(i)) { ## Exclude elements with negative indices? if (any(i < 0)) { stopifnot(is.null(dim(i))) if (any(i > 0)) { stop("only 0's may be mixed with negative subscripts") } ## Drop elements i <- setdiff(seq_len(nmap), -i) } ## Drop zeros? if (is.null(dim(i))) { i <- i[i != 0] } } else if (is.logical(i)) { if (length(i) < nmap) i <- rep(i, length.out=nmap) i <- which(i) } else { return(NextMethod("[")) } ## Nothing to do? ni <- length(i) ## Allocate result res <- listenv() length(res) <- ni res <- structure(res, class=class(x)) if (ni > 0L) { ## Add names? if (!is.null(names)) { names2 <- names[i] names2[i > nmap] <- "" names(res) <- names2 } ## Ignore out-of-range indices j <- i[i <= nmap] for (kk in seq_along(j)) { value <- x[[j[kk]]] if (!is.null(value)) res[[kk]] <- value } } ## Preserve dimensions? dim <- dim(i) ndim <- length(dim) if (ndim > 1) { dimnames <- dimnames(i) ## Drop singleton dimensions? if (drop) { keep <- (dim != 1) dim <- dim[keep] dimnames <- dimnames[keep] ndim <- length(dim) } if (ndim > 1) { names <- names(res) dim(res) <- dim dimnames(res) <- dimnames names(res) <- names } } res } new_variable <- function(envir, value, create=TRUE) { count <- get(".listenv_var_count", envir=envir, inherits=FALSE) count <- count + 1L name <- sprintf(".listenv_var_%f", count) if (!missing(value)) { assign(name, value, envir=envir, inherits=FALSE) } if (create) { assign(".listenv_var_count", count, envir=envir, inherits=FALSE) } name } # new_variable() assign_by_name <- function(x, name, value) { ## Argument 'name': if (length(name) == 0L) { stop("Cannot assign value. Zero-length name.", call.=FALSE) } else if (length(name) > 1L) { stop("Cannot assign value. More than one name specified: ", hpaste(name), call.=FALSE) } else if (nchar(name) == 0L) { stop("Cannot assign value. Empty name specific: ", name, call.=FALSE) } map <- map(x) names <- names(map) ## Map to an existing or a new element? if (is.element(name, names)) { var <- map[name] ## A new variable? if (is.na(var)) { var <- name map[name] <- name map(x) <- map } } else { var <- name ## Append to map map <- c(map, var) if (is.null(names)) names <- rep("", times=length(map)) names[length(map)] <- var names(map) <- names map(x) <- map } ## Assign value assign(var, value, envir=x, inherits=FALSE) invisible(x) } # assign_by_name() assign_by_index <- function(x, i, value) { ## Argument 'i': if (length(i) == 0L) { stop("Cannot assign value. Zero-length index.", call.=FALSE) } else if (length(i) > 1L) { stop("Cannot assign value. More than one index specified: ", hpaste(i), call.=FALSE) } else if (!is.finite(i)) { stop("Cannot assign value. Non-finite index: ", i, call.=FALSE) } else if (i < 1L) { stop("Cannot assign value. Non-positive index: ", i, call.=FALSE) } map <- map(x) n <- length(map) ## Variable name var <- map[i] ## Non-existing variable? if (is.na(var)) { ## Expand map? if (i > n) { extra <- rep(NA_character_, times=i-n) map <- c(map, extra) } ## Create internal variable map[i] <- new_variable(x, value=value) ## Update map map(x) <- map } else { assign(var, value, envir=x, inherits=FALSE) } invisible(x) } # assign_by_index() remove_by_name <- function(x, name) { ## Argument 'name': if (length(name) == 0L) { stop("Cannot remove element. Zero-length name.", call.=FALSE) } else if (length(name) > 1L) { stop("Cannot remove element. More than one name specified: ", hpaste(name), call.=FALSE) } else if (nchar(name) == 0L) { stop("Cannot remove element. Empty name specific: ", name, call.=FALSE) } map <- map(x) ## Position in names map? idx <- match(name, names(map)) ## Nothing to do? if (is.na(idx)) return(invisible(x)) ## Drop internal variable, unless place holder var <- map[idx] if (!is.na(var)) remove(list=var, envir=x, inherits=FALSE) map <- map[-idx] map(x) <- map invisible(x) } # remove_by_name() remove_by_index <- function(x, i) { ## Argument 'i': if (length(i) == 0L) { stop("Cannot remove element. Zero-length index.", call.=FALSE) } else if (length(i) > 1L) { stop("Cannot remove element. More than one index specified: ", hpaste(i), call.=FALSE) } else if (!is.finite(i)) { stop("Cannot remove element. Non-finite index: ", i, call.=FALSE) } else if (i < 1L) { stop("Cannot remove element. Non-positive index: ", i, call.=FALSE) } map <- map(x) ## Nothing to do? if (i > length(map)) return(invisible(x)) ## Drop internal variable, unless place holder var <- map[i] if (!is.na(var)) remove(list=var, envir=x, inherits=FALSE) map <- map[-i] map(x) <- map invisible(x) } # remove_by_index() #' Set an element of list environment #' #' @param x A list environment. #' @param name Name or index of element #' @param value The value to assign to the element #' #' @aliases [[<-.listenv #' @aliases [<-.listenv #' @export #' @keywords internal `$<-.listenv` <- function(x, name, value) { if (is.null(value)) { remove_by_name(x, name=name) } else { assign_by_name(x, name=name, value=value) } } #' @export `[[<-.listenv` <- function(x, ..., value) { map <- map(x) n <- length(map) idxs <- list(...) nidxs <- length(idxs) ## Subsetting by multiple dimensions? if (nidxs > 1L) { i <- toIndex(x, idxs) } else { i <- idxs[[1L]] if (is.character(i)) { if (is.null(value)) { x <- remove_by_name(x, name=i) } else { x <- assign_by_name(x, name=i, value=value) } return(invisible(x)) } } if (is.numeric(i)) { if (is.null(value)) { x <- remove_by_index(x, i=i) } else { x <- assign_by_index(x, i=i, value=value) } } else { stop(sprintf("Subsetted [[<- assignment to listenv's is only supported for names and indices, not %s", mode(i)), call.=FALSE) } return(invisible(x)) } #' @export `[<-.listenv` <- function(x, ..., value) { ## Need to allow for implicit indices, e.g. x[1,,2] idxs <- as.list(sys.call())[-(1:2)] idxs$value <- NULL nidxs <- length(idxs) ## Assert that subsetting has correct shape dim <- dim(x) ndim <- length(dim) if (nidxs > 1 && nidxs != ndim) { stop(sprintf("Incorrect subsetting. Expected %d dimensions but got %d", ndim, nidxs)) } ## Implicitly specified dimensions missing <- sapply(idxs, FUN=function(x) is.symbol(x) && identical("", deparse(x))) if (any(missing)) { if (nidxs == ndim) { envir <- parent.frame() for (kk in seq_len(ndim)) { if (missing[kk]) { idxs[[kk]] <- seq_len(dim[kk]) } else { idxs[[kk]] <- eval(idxs[[kk]], envir=envir) } } } else if (nidxs == 1) { if (ndim == 0) { idxs <- list(seq_len(length(x))) } else { ## Special case: Preserve dimensions when x[] idxs <- lapply(dim, FUN=function(n) seq_len(n)) nidxs <- length(idxs) } } } else { envir <- parent.frame() idxs <- lapply(idxs, FUN=eval, envir=envir) } if (nidxs <= 1L) { i <- idxs[[1L]] } else { i <- toIndex(x, idxs) } ni <- length(i) if (is.logical(i)) { n <- length(x) if (ni < n) i <- rep(i, length.out=n) i <- which(i) ni <- length(i) } # Nothing to do? if (ni == 0L) return(invisible(x)) nvalue <- length(value) if (nvalue == 0L) stop("Replacement has zero length", call.=FALSE) if (ni != nvalue) { if (ni < nvalue || ni %% nvalue != 0) { warning(sprintf("Number of items to replace is not a multiple of replacement length: %d != %d", ni, nvalue), call.=FALSE) } value <- rep(value, length.out=ni) nvalue <- length(value) } if (is.character(i)) { for (kk in seq_len(ni)) { x <- assign_by_name(x, name=i[kk], value=value[[kk]]) } } else if (is.numeric(i)) { for (kk in seq_len(ni)) { x <- assign_by_index(x, i=i[kk], value=value[[kk]]) } } else { stop(sprintf("Subsetted [<- assignment to listenv's is only supported for names and indices, not %s", mode(i)), call.=FALSE) } return(invisible(x)) } #' @export #' @method unlist listenv unlist.listenv <- function(x, recursive=TRUE, use.names=TRUE) { names <- names(x) x <- as.list(x) names(x) <- names if (recursive) { repeat { x <- unlist(x, recursive=TRUE, use.names=use.names) idxs <- unlist(lapply(x, FUN=inherits, "listenv"), use.names=FALSE) if (length(idxs) == 0L) break idxs <- which(idxs) if (length(idxs) == 0L) break for (ii in idxs) { x[[ii]] <- unlist(x[[ii]], recursive=TRUE, use.names=use.names) } } x } else { unlist(x, recursive=FALSE, use.names=use.names) } } #' @export dim.listenv <- function(x) attr(x, "dim.") #' @export `dim<-.listenv` <- function(x, value) { n <- length(x) if (!is.null(value)) { names <- names(value) value <- as.integer(value) p <- prod(as.double(value)) if (p != n) { stop(sprintf("dims [product %d] do not match the length of object [%d]", p, n)) } names(value) <- names } ## Always remove "dimnames" and "names" attributes, cf. help("dim") dimnames(x) <- NULL names(x) <- NULL attr(x, "dim.") <- value x } #' @export dimnames.listenv <- function(x) attr(x, "dimnames.") #' @export `dimnames<-.listenv` <- function(x, value) { dim <- dim(x) if (is.null(dim) && !is.null(value)) { stop("'dimnames' applied to non-array") } for (kk in seq_along(dim)) { names <- value[[kk]] if (is.null(names)) next n <- length(names) if (n != dim[kk]) { stop(sprintf("length of 'dimnames' [%d] not equal to array extent", kk)) } } attr(x, "dimnames.") <- value x } #' @export #' @method all.equal listenv all.equal.listenv <- function(target, current, all.names=TRUE, sorted=FALSE, ...) { if (identical(target, current)) return(TRUE) ## Coerce to lists target <- as.list(target, all.names=all.names, sorted=sorted) current <- as.list(current, all.names=all.names, sorted=sorted) ## Not all as.list() methods support 'all.names' if (!all.names) { keep <- target <- target[!grepl("^[.]", names(target))] current <- current[!grepl("^[.]", names(current))] } ## Not all as.list() methods support 'sorted' if (sorted) { target <- target[order(names(target))] current <- current[order(names(current))] } all.equal(target=target, current=current, ...) } listenv/vignettes/0000755000176200001440000000000012640067035013751 5ustar liggesuserslistenv/vignettes/listenv.md.rsp0000644000176200001440000002150712640067030016562 0ustar liggesusers<%@meta language="R-vignette" content="-------------------------------- %\VignetteIndexEntry{List Environments} %\VignetteAuthor{Henrik Bengtsson} %\VignetteKeyword{R} %\VignetteKeyword{package} %\VignetteKeyword{vignette} %\VignetteKeyword{listenv} %\VignetteEngine{R.rsp::rsp} %\VignetteTangle{FALSE} --------------------------------------------------------------------"%> <% R.utils::use("R.utils") use("listenv") options("withCapture/newline"=FALSE) %> # <%@meta name="title"%> _List environments_ are environments that have list-like properties. They are implemented by the [listenv] package. The main features of a list environment are summarized in the below table: | Property | list environments | lists | environments | |------------------------------------------------------------------------|:-----------------:|:------:|:------------:| | Number of elements, e.g. `length()` | yes | yes | yes | | Named elements, e.g. `names()`, `x$a` and `x[["a"]]` | yes | yes | yes | | Duplicated names | yes | yes | | | Indexed elements, e.g. `x[[4]]` | yes | yes | | | Dimensions, e.g. `dim(x)` | yes | yes | | | Names of dimensions, e.g. `dimnames(x)` | yes | yes | | | Indexing by dimensions, e.g. `x[[2,4]]` and `x[[2,"D"]]` | yes | yes | | | Multi-element subsetting, e.g. `x[c("a", "c")]`, `x[-1]`, `[2:1,,3]` | yes | yes | | | Multi-element subsetting preserves element names | yes | | | | Removing element by assigning NULL, e.g. `x$c <- NULL` | yes | yes | | | Mutable, e.g. `y <- x; y$a <- 3; identical(y, x)` | yes | | yes | | Compatible* with `assign()`, `delayedAssign()`, `get()` and `exists()` | yes | | yes | For example, ```r <%=withCapture({ x <- listenv(a=1, b=2, c="hello") x length(x) names(x) x$a x[[3]] <- toupper(x[[3]]) x$c y <- x y$d <- y$a + y[["b"]] names(y)[2] <- "a" y$a y identical(y, x) for (ii in seq_along(x)) { cat(sprintf("Element %d (%s): %s\n", ii, sQuote(names(x)[ii]), x[[ii]])) } <%--- get(map(x)["b"], envir=x) assign(map(x)["b"], 3, envir=x) ---%> x[c(1,3)] <- list(2, "Hello world!") x y <- as.list(x) str(y) z <- as.listenv(y) z identical(z, x) all.equal(z, x) })%> ``` ## Creating list environments List environments are created similarly to lists but also similarly to environments. To create an empty list environment, use ```r <%=withCapture({ x <- listenv() x })%> ``` This can later can be populated using named assignments, ```r <%=withCapture({ x$a <- 1 x })%> ``` comparable to how both lists and environments work. Similarly to lists, they can also be populated using indices, e.g. ```r <%=withCapture({ x[[2]] <- 2 x$c <- 3 x })%> ``` Just as for lists, a list environment is expanded with `NULL` elements whenever a new element is added that is beyond the current length plus one, e.g. ```r <%=withCapture({ x[[5]] <- 5 x x[[4]] })%> ``` As with lists, the above list environment can also be created from the start, e.g. ```r <%=withCapture({ x <- listenv(a=1, 3, c=4, NULL, 5) x })%> ``` As for lists, the length of a list environment can at any time be increased or decreased by assigning it a new length. If decreased, elements are dropped, e.g. ```r <%=withCapture({ x length(x) <- 2 x x[[1]] x[[2]] })%> ``` If increased, new elements are populated with unnamed elements of `NULL`, e.g. ```r <%=withCapture({ length(x) <- 4 x x[[3]] x[[4]] })%> ``` To allocate an "empty" list environment (with all `NULL`:s) of a given length, do ```r <%=withCapture({ x <- listenv() length(x) <- 4 x })%> ``` _Note_: Unfortunately, it is _not_ possible to use `x <- vector("listenv", length=4)`; that construct is only supported for the basic data types. ## Iterating over elements ### Iterating over elements by names Analogously to lists and plain environments, it is possible to iterate over elements of list environments by the element names. For example, ```r <%=withCapture({ x <- listenv(a=1, b=2, c=3) for (name in names(x)) { cat(sprintf("Element %s: %s\n", sQuote(name), x[[name]])) } })%> ``` ### Iterating over elements by indices Analogously to lists, but contrary to plain environments, it is also possible to iterate over elements by their indices. For example, ```r <%=withCapture({ x <- listenv(a=1, b=2, c=3) for (ii in seq_along(x)) { cat(sprintf("Element %d: %s\n", ii, x[[ii]])) } })%> ``` ## Coercion to and from list environments ### Coercing to lists and vectors Coercing a list environment to a list: ```r <%=withCapture({ x <- listenv(a=2, b=3, c="hello") x y <- as.list(x) str(y) })%> ``` Coercing a list to a list environment: ```r <%=withCapture({ z <- as.listenv(y) z identical(z, x) all.equal(z, x) })%> ``` Unlisting: ```r <%=withCapture({ unlist(x) unlist(x[-3]) unlist(x[1:2], use.names=FALSE) })%> ``` ## Multi-dimensional list environments Analogously to lists, and contrary to plain environments, list environments can have dimensions with corresponding names. For example, ```r <%=withCapture({ x <- as.listenv(1:6) dim(x) <- c(2,3) dimnames(x) <- list(c("a", "b"), c("A", "B","C")) x })%> ``` An easy way to quickly get an overview is to coerce to a list, e.g. ```r <%=withCapture({ as.list(x) })%> ``` Individual elements of a list environment can be accessed using standard subsetting syntax, e.g. ```r <%=withCapture({ x[["a", "B"]] x[[1, 2]] x[[1, "B"]] })%> ``` We can assign individual elements similarly, e.g. ```r <%=withCapture({ x[["b", "B"]] <- -x[["b", "B"]] as.list(x) })%> ``` We can also assign multiple elements through dimensional subsetting, e.g. ```r <%=withCapture({ x[2,-1] <- 98:99 as.list(x) x["a",c(1,3)] <- list(97, "foo") as.list(x) x[] <- 1:6 as.list(x) })%> ``` Concurrently with dimensional names it is possible to have names of the invidual elements just as for list environments without dimensions. For example, ```r <%=withCapture({ names(x) <- letters[seq_along(x)] x x[["a"]] x[["f"]] x[c("a", "f")] unlist(x) })%> ``` Contrary to lists, element names are preserved also with multi-dimensional subsetting, e.g. ```r <%=withCapture({ x[1,2] x[1,2,drop=FALSE] x[1:2,2:1] x[2,] x[2,,drop=FALSE] x["b",-2,drop=FALSE] })%> ``` Note, whenever dimensions are set using `dim(x) <- dims` both the dimensional names and the element names are removed, e.g. ```r > dim(x) <- NULL > names(x) NULL ``` This behavior is by design, cf. `help("dim", package="base")`. <%--- Because of this, the listenv package provides the `undim()` function, which removes the dimensions but preserves the names, e.g. ```r <%=withCapture({ x <- undim(x) names(x) })%> ``` _Warning_: Since list environments _and their attributes_ are mutable, calling ```r undim(x) ``` will have the same effect as ```r x <- undim(x) ``` That is, the dimension attributes of `x` will be changed. The reason for this is explained in Section 'Important about environments' above. ---%> ### Limitations The current implementation does _not_ support _dimensional subsetting_ of more than one element. For instance, `x[1,]` is not supported by this version. ## Important about environments List environments are as their name suggests _environments_. Whenever working with environments in R, it is important to understand that _environments are mutable_ whereas all other of the basic data types in R are immutable. For example, consider the following function that assigns zero to element `a` of object `x`: ```r <%=withCapture({ setA <- function(x) { x$a <- 0 x } })%> ``` If we pass a regular list to this function, ```r <%=withCapture({ x <- list(a=1) y <- setA(x) x$a y$a })%> ``` we see that `x` is unaffected by the assignment. This is because _lists are immutable_ in R. However, if we pass an environment instead, ```r <%=withCapture({ x <- new.env() x$a <- 1 y <- setA(x) x$a y$a })%> ``` we find that `x` was affected by the assignment. This is because _environments are mutable_ in R. Since list environments inherits from environments, this also goes for them, e.g. ```r <%=withCapture({ x <- listenv(a=1) y <- setA(x) x$a y$a })%> ``` What is also important to understand is that it is not just the _content_ of an environment that is mutable but also its _attributes_. For example, ```r <%=withCapture({ x <- listenv(a=1) y <- x attr(y, "foo") <- "Hello!" attr(x, "foo") })%> ``` [listenv]: http://cran.r-project.org/package=listenv --- Copyright Henrik Bengtsson, 2015 listenv/MD50000644000176200001440000000315012640067456012257 0ustar liggesuserse745d634585a29c2e525cfb3d39d59e8 *DESCRIPTION 89e15c945dcfb605128c7abdc0f68f80 *NAMESPACE c9f8fda1ddd2984c19a67b0ce7a20210 *NEWS f06dc34d2a1839d07cd98d30600e3c26 *R/get_variable.R 7a9462d34a31c2577bdd583fec4d052a *R/listenv.R 5fa2a45fdd2adb019d52f36b466cd268 *R/parse_env_subset.R fe8db3909366f82cc1d31603046f0e92 *R/undim.R 0b750b7626b75191087db81e86f7e731 *R/utils.R 950222ec3362beed946618f55d5254dd *build/vignette.rds 56d74cee9b8f35a17dd7a98ab0c16e8c *inst/doc/listenv.html 43ebcd44126cb94d23ac395145ba2444 *inst/doc/listenv.md.rsp db64844e07ab14c995f6116fcfe170df *man/as.list.listenv.Rd aeff557461299c3b2e5bcd5968991af1 *man/cash-.listenv.Rd 3764c89fb96ace37631c81fd22a3e638 *man/cash-set-.listenv.Rd dcd80183ea3e1c1b87b6785b59536880 *man/get_variable.Rd 90ca995bbbc8ac59ad49c3202eeed63e *man/length.listenv.Rd 957163178691b32d4a5987d96abd430c *man/listenv.Rd f7a3e638c5ddc9075772ccc2c1604838 *man/map.Rd 563213dc5b6d707bcc0367a0321c1396 *man/names.listenv.Rd d6870fe0e2c4089f7d483db848ab3a74 *man/parse_env_subset.Rd cbdcda4780136f1f2a35ed42b39d8f31 *man/undim.Rd 06b8c0ea74d231f933dd0ccda150594f *tests/as.listenv.R 384d4562acfd09d1a0e8b0970d01f745 *tests/get_variable,dimensions.R 13f5f5c5c2cb4965c35f27d628463776 *tests/get_variable.R 8e40808adef445b921d0edd5b17d8ffa *tests/listenv,dimensions.R 6a67a4b0a46b2be6452fc02b33956828 *tests/listenv.R d256b53faf4e45c2765fc8707dcdc589 *tests/parse_env_subset,dimensions.R b76a7090fb365a74664dbb2b1ed63597 *tests/parse_env_subset.R 07e4d80d68932de4faf92db1e9058d0f *tests/undim.R 3ff218c62aa9169c129c7d4e5b6c0ec6 *tests/utils.R 43ebcd44126cb94d23ac395145ba2444 *vignettes/listenv.md.rsp listenv/build/0000755000176200001440000000000012640067035013040 5ustar liggesuserslistenv/build/vignette.rds0000644000176200001440000000034612640067035015402 0ustar liggesusers‹ePK‚0~ò‰ ðœÙèÂn©Ø…”âΓ‹S¥Fë¤3ÍÌ{ó=F`ƒc;€À‰ÑLP¨¸â?/Y+)ï’*ODÛèr‹èjÍ;&j^Q.[ƒ0ÕéY•¦ºÇ/ÿGqí/Ü㤢fA?¥ å¹ ?Œ|w¤X{ÍmÈéJ :ºAÇ N¥Ô¾?Îönk F§`Co}-t«Îdä¸+u9ïÀäÇqviö7Žý¯þÏÚ¡¨ûD¯>SGº£PÌûœJÒš÷‰r"Ir˜¯æ~^\oÙälistenv/DESCRIPTION0000644000176200001440000000170012640067456013454 0ustar liggesusersPackage: listenv Version: 0.6.0 Depends: R (>= 3.1.2) Suggests: R.utils, R.rsp VignetteBuilder: R.rsp Title: Environments Behaving (Almost) as Lists Authors@R: c(person("Henrik", "Bengtsson", role=c("aut", "cre", "cph"), email = "henrikb@braju.com")) Description: List environments are environments that have list-like properties. For instance, the elements of a list environment are ordered and can be accessed and iterated over using index subsetting, e.g. 'x <- listenv(a=1, b=2); for (i in seq_along(x)) x[[i]] <- x[[i]]^2; y <- as.list(x)'. License: LGPL (>= 2.1) LazyLoad: TRUE URL: https://github.com/HenrikBengtsson/listenv BugReports: https://github.com/HenrikBengtsson/listenv/issues RoxygenNote: 5.0.1 NeedsCompilation: no Packaged: 2015-12-27 23:02:54 UTC; hb Author: Henrik Bengtsson [aut, cre, cph] Maintainer: Henrik Bengtsson Repository: CRAN Date/Publication: 2015-12-28 00:07:26 listenv/man/0000755000176200001440000000000012640067030012507 5ustar liggesuserslistenv/man/as.list.listenv.Rd0000644000176200001440000000122512640067030016036 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/listenv.R \name{as.list.listenv} \alias{as.list.listenv} \title{List representation of a list environment} \usage{ \method{as.list}{listenv}(x, all.names = TRUE, sorted = FALSE, ...) } \arguments{ \item{x}{A list environment.} \item{all.names}{If \code{TRUE}, variable names starting with a period are included, otherwise not.} \item{sorted}{If \code{TRUE}, elements are ordered by their names before being compared, otherwise not.} \item{...}{Not used.} } \value{ A list. } \description{ List representation of a list environment } \keyword{internal} listenv/man/map.Rd0000644000176200001440000000062212640067030013553 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/listenv.R \name{map} \alias{map} \alias{map.listenv} \title{Variable name map for elements of list environment} \usage{ map(x, ...) } \arguments{ \item{x}{A list environment.} } \value{ The a named character vector } \description{ Variable name map for elements of list environment } \keyword{internal} listenv/man/listenv.Rd0000644000176200001440000000110212640067030014454 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/listenv.R \name{listenv} \alias{as.listenv} \alias{listenv} \title{Create a list environment} \usage{ listenv(...) as.listenv(...) } \arguments{ \item{\dots}{(optional) Named and/or unnamed objects to be assigned to the list environment.} } \value{ An environment of class `listenv`. } \description{ Create a list environment } \examples{ x <- listenv(c=2, a=3, d="hello") print(names(x)) names(x)[2] <- "A" x$b <- 5:8 y <- as.list(x) str(y) z <- as.listenv(y) } listenv/man/names.listenv.Rd0000644000176200001440000000056512640067030015572 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/listenv.R \name{names.listenv} \alias{names.listenv} \alias{names<-.listenv} \title{Names of elements in list environment} \usage{ \method{names}{listenv}(x) } \arguments{ \item{x}{A list environment.} } \description{ Names of elements in list environment } \keyword{internal} listenv/man/parse_env_subset.Rd0000644000176200001440000000113612640067030016346 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/parse_env_subset.R \name{parse_env_subset} \alias{parse_env_subset} \title{Helper function to infer target from expression and environment} \usage{ parse_env_subset(expr, envir = parent.frame(), substitute = TRUE) } \arguments{ \item{expr}{An expression.} \item{envir}{An environment.} \item{substitute}{If TRUE, then the expression is \code{substitute()}:ed, otherwise not.} } \value{ A named list. } \description{ Helper function to infer target from expression and environment } \keyword{internal} listenv/man/get_variable.Rd0000644000176200001440000000125512640067030015425 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/get_variable.R \name{get_variable} \alias{get_variable} \alias{get_variable.listenv} \title{Get name of variable for a specific element of list environment} \usage{ get_variable(...) } \arguments{ \item{x}{A list environment.} \item{name}{The name or index of element of interest.} \item{mustExist}{If TRUE, an error is generated if \code{name} does not exist.} \item{create}{If TRUE, element \code{name} is created if missing.} } \value{ The name of the underlying variable } \description{ Get name of variable for a specific element of list environment } \keyword{internal} listenv/man/undim.Rd0000644000176200001440000000124112640067030014110 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/undim.R \name{undim} \alias{undim} \alias{undim.default} \title{Removes the dimension of an object} \usage{ undim(x, ...) } \arguments{ \item{x}{An object with or without dimensions} \item{...}{Not used.} } \value{ The object with the dimension attribute removed. } \description{ Removes the dimension of an object } \details{ This function does \code{attr(x, "dim") <- NULL}, which automatically also does \code{attr(x, "dimnames") <- NULL}. However, other attributes such as names attributes are preserved, which is not the case if one do \code{dim(x) <- NULL}. } listenv/man/cash-set-.listenv.Rd0000644000176200001440000000072012640067030016244 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/listenv.R \name{$<-.listenv} \alias{$<-.listenv} \alias{[[<-.listenv} \title{Set an element of list environment} \usage{ \method{$}{listenv}(x, name) <- value } \arguments{ \item{x}{A list environment.} \item{name}{Name or index of element} \item{value}{The value to assign to the element} } \description{ Set an element of list environment } \keyword{internal} listenv/man/cash-.listenv.Rd0000644000176200001440000000075112640067030015457 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/listenv.R \name{$.listenv} \alias{$.listenv} \alias{[[.listenv} \title{Get elements of list environment} \usage{ \method{$}{listenv}(x, name) } \arguments{ \item{x}{A list environment.} \item{name}{The name or index of the element to retrieve.} } \value{ The value of an element or NULL if the element does not exist } \description{ Get elements of list environment } \keyword{internal} listenv/man/length.listenv.Rd0000644000176200001440000000054112640067030015742 0ustar liggesusers% Generated by roxygen2: do not edit by hand % Please edit documentation in R/listenv.R \name{length.listenv} \alias{length.listenv} \title{Number of elements in list environment} \usage{ \method{length}{listenv}(x) } \arguments{ \item{x}{A list environment.} } \description{ Number of elements in list environment } \keyword{internal}