Implement at, at2 and peek_at, peek_at2

NAMESPACE

@@ -50,6 +50,9 @@ S3method(as.dict.table,data.table)
 S3method(as.dict.table,default)
 S3method(as.list,Container)
 S3method(at,Container)
+S3method(at,dict.table)
+S3method(at2,Container)
+S3method(at2,dict.table)
 S3method(c,Container)
 S3method(c,Deque)
 S3method(c,Dict)
@@ -76,8 +79,6 @@ S3method(discard_,Container)
 S3method(discard_,Dict)
 S3method(discard_,dict.table)
 S3method(empty,Container)
-S3method(get_at,Dict)
-S3method(get_at,dict.table)
 S3method(get_label,Container)
 S3method(get_label,character)
 S3method(get_label,default)
@@ -148,6 +149,7 @@ export(as.dict)
 export(as.dict.table)
 export(as.set)
 export(at)
+export(at2)
 export(begin)
 export(clear)
 export(clear_)
@@ -165,7 +167,6 @@ export(dict.table)
 export(discard)
 export(discard_)
 export(empty)
-export(get_at)
 export(get_label)
 export(get_next)
 export(get_value)

R/0-ContainerR6.R

@@ -77,25 +77,40 @@ Container <- R6::R6Class("Container",
             self
         },
 
-        #' @description Access value at index. If index is invalid, an error is
-        #' signaled. If given as a string, the element matching the name is
-        #' returned. If the name is not found, again, an error is signalled.
-        #' If there are two or more identical names, the value of the first
-        #' match (i.e. *leftmost* element) is returned.
-        #' @param index `numeric` or `character` index to be accessed.
+        #' @description Same as `at2` (see below) but accepts a vector of
+        #' indices and always returns a `Container` object.
+        #' @param index vector of indices.
+        #' @return `Container` object with the extracted elements.
+        at = function(index) {
+
+            if (missing(index))
+                stop("'index' is missing", call. = FALSE)
+
+            lapply(index, .assert_index, x = self)
+
+            l = lapply(index, function(x) private$.subset(self, x))
+            if (!length(l))
+                return(methods::as(l, data.class(self)))
+
+            ul = unlist(l, recursive = FALSE)
+            methods::as(ul, data.class(self))
+        },
+
+        #' @description Extract value at index. If index is invalid or not
+        #' found, an error is signaled. If given as a string, the element
+        #' matching the name is returned. If there are two or more identical
+        #' names, the value of the first match (i.e. *leftmost* element) is
+        #' returned.
+        #' @param index Must be a single number > 0 or a string.
         #' @return If given as a number, the element at the corresponding
         #' position, and if given as a string, the element at the
         #' corresponding name matching the given string is returned.
-        at = function(index) {
-            private$verify_index(index)
+        at2 = function(index) {
 
-            if (is.numeric(index))
-                private$assert_position(index)
-            else
-                private$assert_name(index)
+            if (missing(index))
+                stop("'index' is missing", call. = FALSE)
 
-            #l = private$.subset(self, index)
-            #methods::as(l, data.class(self))
+            .assert_index(self, index)
             private$.subset2(self, index)
         },
 
@@ -172,22 +187,48 @@ Container <- R6::R6Class("Container",
         #' elements it contains.
         length = function() length(private$elems),
 
-        #' @description Peek at index. If not found, return `default` value.
+        #' @description Same as `peek_at2` (see below) but accepts a vector of
+        #' indices and always returns a `Container` object.
+        #' @param index vector of indices.
+        #' @param default the default value to return in case the value at
+        #' `index` is not found.
+        #' @return `Container` object with the extracted elements.
+        peek_at = function(index, default = NULL) {
+            if (missing(index))
+                return(self)
+
+            try_at = function(index)
+                as.list(tryCatch(self$at(index),
+                                 error = function(e) list(default)))
+
+            l = lapply(index, try_at)
+            if (identical(l, list()))
+                return(methods::as(l, data.class(self)))
+
+            # Determine positions where names need to be set
+            isChar = as.logical(sapply(index, is.character))
+            hasLen = as.logical(sapply(l, function(x) length(x) > 0))
+            pos = which(isChar & hasLen)
+
+            ul = unlist(l, recursive = FALSE)
+            names(ul)[pos] <- as.character(index[pos])
+            ul = Filter(ul, f = Negate(is.null))
+
+            methods::as(ul, data.class(self))
+        },
+
+        #' @description Peek at index and extract value. If index is invalid,
+        #' missing, or not not found, return `default` value.
         #' @param index `numeric` or `character` index to be accessed.
         #' @param default the default value to return in case the value at
         #' `index` is not found.
         #' @return the value at the given index or (if not found) the given
         #' default value.
-        peek = function(index, default = NULL) {
-            if (missing(index))
-                return(self$peek(self$length()))
-
-            if (self$is_empty())
+        peek_at2 = function(index, default = NULL) {
+            if (missing(index) || self$is_empty())
                 return(default)
 
-            private$verify_index(index)
-
-            tryCatch(self$at(index), error = function(e) default)
+            tryCatch(self$at2(index), error = function(e) default)
         },
 
         #' @description Print object representation
@@ -262,25 +303,8 @@ Container <- R6::R6Class("Container",
     ),
     private = list(
         compare_fun = NULL,
-
         elems = list(),
 
-        assert_position = function(index) {
-            if (index > self$length())
-                stop("index ", index, " exceeds length of ",
-                     data.class(self), " (", self$length(), ")", call. = FALSE)
-
-            invisible(TRUE)
-        },
-
-        assert_name = function(name) {
-            if (!(name %in% names(self)))
-                stop("index '", name, "' not found", call. = FALSE)
-
-            invisible(TRUE)
-        },
-
-
         create_iter = function() {
             Iterator$new(self, private$.subset)
         },
@@ -312,20 +336,6 @@ Container <- R6::R6Class("Container",
             private$compare_fun = f
         },
 
-        verify_index = function(index) {
-            if (!(is.numeric(index) || is.character(index)))
-                stop("invalid index type '", data.class(index), "'", call. = FALSE)
-
-            if (length(index) != 1)
-                stop("index must be of length 1", call. = FALSE)
-
-            if (is.na(index))
-                stop("index must not be 'NA'", call. = FALSE)
-
-            if (isTRUE(index < 1))
-                stop("index must be > 0", call. = FALSE)
-        },
-
         verify_same_class = function(x) {
             if (!inherits(x, data.class(self))) {
                 stop("arg must be a ", data.class(self), call. = FALSE)

R/0-DequeR6.R

@@ -5,8 +5,7 @@
 #' underlying data sequence. As such, the [Deque()] can also be used to mimic
 #' both stacks and queues.
 #' @details This class inherits from class [Container()] and extends it by
-#' `pop` and `peek` methods, element counting, and reverse and rotate
-#' functionality.
+#' `pop` and `peek` methods, and reverse and rotate functionality.
 #' @importFrom R6 R6Class
 #' @seealso [Container()], [deque()]
 #' @export
@@ -37,14 +36,14 @@ Deque <- R6::R6Class("Deque",
         #' @param default returned default value if `Deque` is empty.
         #' @return element 'peeked' on the right
         peek = function(default = NULL) {
-            super$peek(self$length(), default)
+            super$peek_at2(self$length(), default)
         },
 
         #' @description Peek at first element of the `Deque`.
         #' @param default returned default value if `Deque` is empty.
         #' @return element 'peeked' on the left
         peekleft = function(default = NULL) {
-            super$peek(1, default)
+            super$peek_at2(1, default)
         },
 
         #' @description

R/0-DictR6.R

@@ -25,8 +25,7 @@ Dict <- R6::R6Class("Dict",
                 stop("all elements must be named", call. = FALSE)
 
             if (any(duplicated(keys)))
-                stop("duplicated keys are not allowed for ",
-                     data.class(self), call. = FALSE)
+                stop("duplicated keys are not allowed", call. = FALSE)
 
             private$elems <- list2env(elems, parent = emptyenv(), hash = TRUE)
             self
@@ -44,16 +43,6 @@ Dict <- R6::R6Class("Dict",
             self$replace(key, value, add = TRUE)
         },
 
-        #' @description Access value at key.
-        #' @param key `character` name of key.
-        #' @return If `key` in `Dict`, return value at `key`, else throw error.
-        at = function(key) {
-            if (self$has(key))
-                self$peek(key)
-            else
-                stop("key '", key, "' not in ", data.class(self), call. = FALSE)
-        },
-
 
         #' @description If key in `Dict`, delete associated key-value pair.
         #' @param key `character` key of value to delete. If `key` does exist,
@@ -78,12 +67,12 @@ Dict <- R6::R6Class("Dict",
             self
         },
 
-        #' @description This function is deprecated. Use [at()] instead.
+        #' @description This function is deprecated. Use [at2()] instead.
         #' @param key `character` name of key.
         #' @return If `key` in `Dict`, return value at `key`, else throw error.
         get = function(key) {
             .Deprecated("at")
-            self$at(key)
+            self$at2(key)
         },
 
         #' @description Determine if `Dict` has a `key`.
@@ -104,20 +93,6 @@ Dict <- R6::R6Class("Dict",
             ls(envir = private$elems)
         },
 
-        #' @description Peek for value in `Dict`.
-        #' @param key `character` name of key.
-        #' @param default returned default value.
-        #' @return value for `key` if `key` is in the `Dict` else `default`.
-        peek = function(key, default = NULL) {
-            if (missing(key))
-                key = utils::tail(self$keys(), 1)
-
-            if (!self$has(key))
-                return(default)
-
-            get(key, envir = private$elems)
-        },
-
         #' @description Get value and delete key-value pair from `Dict`.
         #' If `key` not found, raise an error.
         #' @param key `character` name of key.
@@ -129,7 +104,7 @@ Dict <- R6::R6Class("Dict",
             if (missing(key))
                 key = utils::tail(self$keys(), 1)
 
-            elem <- self$peek(key)
+            elem <- self$at2(key)
             self$delete(key)
             elem
         },
@@ -159,7 +134,7 @@ Dict <- R6::R6Class("Dict",
             if (identical(old, new))
                 return(self)
 
-            self$add(key = new, value = self$at(old))
+            self$add(key = new, value = self$at2(old))
             self$delete(old)
             self
         },
@@ -210,7 +185,7 @@ Dict <- R6::R6Class("Dict",
                 stop("arg must be a ", data.class(self), call. = FALSE)
 
             for (key in other$keys())
-                self$replace(key, other$at(key), add = TRUE)
+                self$replace(key, other$at2(key), add = TRUE)
 
             self
         },

R/0-DictS3.R

@@ -50,7 +50,7 @@ as.dict <- function(x)
 }
 
 methods::setOldClass("Dict")
-methods::setAs("list", "Dict", function(from) as.deque(from))
+methods::setAs("list", "Dict", function(from) as.dict(from))
 
 #' @rdname DictS3
 #' @details * `is.dict(x)` returns `TRUE` if `x` is of class `Dict`

R/0-SetR6.R

@@ -53,15 +53,6 @@ Set <- R6::R6Class("Set",
             self
         },
 
-        #' @description peek last item
-        #' @param default returned default value if `Set` is empty.
-        #' @return last element (according to internal order) in the `Set`.
-        peek = function(default = NULL) {
-            if (self$is_empty())
-                return(default)
-
-            private$.subset2(self, self$length())
-        },
 
         #' @description Search for occurence of `elem` in the `Set` and
         #' replace it by `new`. If `elem` does not exist, an error is

R/0-SetS3.R

@@ -49,7 +49,7 @@ as.set <- function(x) {
 }
 
 methods::setOldClass("Set")
-methods::setAs("list", "Set", function(from) as.deque(from))
+methods::setAs("list", "Set", function(from) as.set(from))
 
 #' @rdname SetS3
 #' @details * `is.set(x)` returns `TRUE` if `x` is of class `Set` and `FALSE`

R/Ops-extract.R

@@ -16,9 +16,9 @@ NULL
 `[[.Dict` <- function(x, key, default = NULL)
 {
     if (missing(default))
-        x$at(key)
+        x$at2(key)
     else
-        x$peek(key, default)
+        x$peek_at2(key, default)
 }
 
 #' @rdname OpsExtract
@@ -29,13 +29,10 @@ NULL
 #' @export
 `[.Dict` <- function(x, key, default = NULL)
 {
-    d = dict()
-    for (k in unique(key)) {
-        value = if (missing(default)) x$at(k) else x$peek(k, default)
-
-        d$add(k, value)
-    }
-    d
+    if (missing(default))
+        x$at(key)
+    else
+        x$peek_at(key, default)
 }
 
 
@@ -48,9 +45,9 @@ NULL
 `[[.dict.table` <- function(x, j, default = NULL)
 {
     if (missing(default))
-        .subset2(get_at(x, j), 1)
+        at2(x, j)
     else
-        peek(x, j, default)
+        peek_at2(x, j, default)
 }
 
 
@@ -61,8 +58,9 @@ NULL
 `$.dict.table` <- function(x, key)
 {
     j = pmatch(key, names(x))
-    if (is.na(j)) j = key
+    if (is.na(j))
+        j = key
 
-    .subset2(get_at(x, j), 1)
+    at2(x, j)
 }