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