1#' Create a stack 2#' 3#' A `faststack` is backed by a list. The backing list will grow or shrink as 4#' the stack changes in size. 5#' 6#' `faststack` objects have the following methods: 7#' 8#' \describe{ 9#' \item{\code{push(x)}}{ 10#' Push an object onto the stack. 11#' } 12#' \item{\code{mpush(..., .list = NULL)}}{ 13#' Push objects onto the stack. `.list` can be a list of objects to add. 14#' } 15#' \item{\code{pop(missing = missing_default)}}{ 16#' Remove and return the top object on the stack. If the stack is empty, 17#' it will return `missing`, which defaults to the value of 18#' `missing_default` that `stack()` was created with (typically, `NULL`). 19#' } 20#' \item{\code{mpop(n, missing = missing_default)}}{ 21#' Remove and return the top `n` objects on the stack, in a list. The first 22#' element of the list is the top object in the stack. If `n` is greater 23#' than the number of objects in the stack, any requested items beyond 24#' those in the stack will be replaced with `missing` (typically, `NULL`). 25#' } 26#' \item{\code{peek(missing = missing_default)}}{ 27#' Return the top object on the stack, but do not remove it from the stack. 28#' If the stack is empty, this will return `missing`. 29#' } 30#' \item{\code{reset()}}{ 31#' Reset the stack, clearing all items. 32#' } 33#' \item{\code{size()}}{ 34#' Returns the number of items in the stack. 35#' } 36#' \item{\code{as_list()}}{ 37#' Return a list containing the objects in the stack, where the first 38#' element in the list is the object at the bottom of the stack, and the 39#' last element in the list is the object at the top of the stack. 40#' } 41#' } 42#' 43#' 44#' @param init Initial size of the list that backs the stack. This is also used 45#' as the minimum size of the list; it will not shrink any smaller. 46#' @param missing_default The value to return when `pop()` or `peek()` are 47#' called when the stack is empty. Default is `NULL`. 48#' @export 49faststack <- function(init = 20, missing_default = NULL) { 50 force(missing_default) 51 52 # A list that represents the stack 53 s <- vector("list", init) 54 # Current size of the stack 55 count <- 0L 56 57 push <- function(x) { 58 new_size <- count + 1L 59 60 # R 3.4.0 and up will automatically grow vectors in place, if possible, so 61 # we don't need to explicitly grow the list here. 62 if (is.null(x)) { 63 # Special case for NULL (in the normal case, we'll avoid creating a new 64 # list() and then unwrapping it.) 65 s[new_size] <<- list(NULL) 66 } else { 67 s[[new_size]] <<- x 68 } 69 count <<- new_size 70 71 invisible() 72 } 73 74 mpush <- function(..., .list = NULL) { 75 if (is.null(.list)) { 76 # Fast path for common case 77 args <- list(...) 78 } else { 79 args <- c(list(...), .list) 80 } 81 82 if (length(args) == 0) { 83 stop("`mpush`: No items provided to push on stack.") 84 } 85 86 new_size <- count + length(args) 87 88 # R 3.4.0 and up will automatically grow vectors in place, if possible, so 89 # we don't need to explicitly grow the list here. 90 s[count + seq_along(args)] <<- args 91 count <<- new_size 92 93 invisible() 94 } 95 96 pop <- function(missing = missing_default) { 97 if (count == 0L) { 98 return(missing) 99 } 100 101 value <- s[[count]] 102 s[count] <<- list(NULL) 103 count <<- count - 1L 104 105 # Shrink list if < 1/2 of the list is used, down to a minimum size of `init` 106 len <- length(s) 107 if (len > init && count < len/2) { 108 new_len <- max(init, count) 109 s[seq.int(new_len + 1L, len)] <<- list(NULL) 110 } 111 112 value 113 } 114 115 mpop <- function(n, missing = missing_default) { 116 n <- as.integer(n) 117 118 if (n < 1) { 119 stop("`n` must be at least 1.") 120 } 121 122 if (n > count) { 123 n_pop <- count 124 n_extra <- n - count 125 } else { 126 n_pop <- n 127 n_extra <- 0L 128 } 129 130 idx <- seq.int(count, count - n_pop + 1L) 131 if (n_extra != 0) { 132 values <- vector("list", n) 133 values[seq_len(n_pop)] <- s[idx] 134 if (!is.null(missing)) { 135 values[seq.int(n_pop + 1, n)] <- missing 136 } 137 138 } else { 139 values <- s[idx] 140 } 141 142 s[idx] <<- list(NULL) 143 count <<- count - n_pop 144 145 # Shrink list if < 1/2 of the list is used, down to a minimum size of `init` 146 len <- length(s) 147 if (len > init && count < len/2) { 148 new_len <- max(init, count) 149 # Assign in place; avoids making copies 150 s[seq.int(new_len + 1L, len)] <<- NULL 151 } 152 153 values 154 } 155 156 peek <- function(missing = missing_default) { 157 if (count == 0L) { 158 return(missing) 159 } 160 s[[count]] 161 } 162 163 reset <- function() { 164 s <<- vector("list", init) 165 count <<- 0L 166 invisible() 167 } 168 169 size <- function() { 170 count 171 } 172 173 # Return the entire stack as a list, where the first item in the list is the 174 # oldest item in the stack, and the last item is the most recently added. 175 as_list <- function() { 176 s[seq_len(count)] 177 } 178 179 180 list( 181 push = push, 182 mpush = mpush, 183 pop = pop, 184 mpop = mpop, 185 peek = peek, 186 reset = reset, 187 size = size, 188 as_list = as_list 189 ) 190} 191