staque.R - Icon-oriented stack and queue operations

staque.R

# staque.R - Icon-oriented stack and queue operations
# - queue:
#   - sq_push/sq_pull to pass values thru vector left-to-right;
#   - sq_put/sq_pop to pass values thru vector right-to-left.
# - stack:
#   - sq_push/sq_get to left end of vector;
#     - this is an "upward-growing stack";
#     - in Icon, get is a synonym for pop; however base::get exists in R.
#   - sq_put/sq_pull to right end of vector;
#     - this is a "downward-growing stack".
# - sq_get and sq_pop are synoymous
# - Because R does not support failure, produce NA instead of failing.
# - I doubt that these execute quickly but have not tested that.
#   - Uh, I have not tested beyond seeing these do what I want them to.
# - "Permalink":
#   - https://gist.github.com/eschen42/917690355e53918b9e7ba7138a02d1f8
# - Adapted from:
#   - https://gist.github.com/mpettis/b7bfeff282e3b052684f
#   - https://gist.github.com/leeper/d6d085ac86d1e006167e

# sq_pull(v):x produces the rightmost element of v and removes it from v,
#   but produces NA if v is empty
sq_pull <- function(v){
  if (length(v) == 0) return(NA)
  assign(as.character(substitute(v)), v[-length(v)], parent.frame())
  # produce x
  return(v[length(v)])
}

# sq_pop(v):x produces the leftmost element of v and removes it from v,
#   but produces NA if v is empty
# sq_get(v):x is a synomnym for sq_pop(v):x
sq_get <- sq_pop <- function(v){
  if (length(v) == 0) return(NA)
  assign(as.character(substitute(v)), v[-1], parent.frame())
  # produce x
  return(v[1])
}

# sq_put(v,x1,...,xn):v puts x1, x2, ..., xn onto the
#   right end of v, producing v.
#   Values are pushed in order from left to right,
#   so xn becomes the last (rightmost) value on v.
#   put(v) with no second argument does nothing.
sq_put <- function(v, x = NA, ...) {
  pf <- parent.frame()
  if (is.null(x))
    return(pf$v)
  if (!(length(x) > 1) && !rlang::is_closure(x) && is.na(x))
    return(pf$v)
  assign(as.character(substitute(v)), c(v, x, ...), pf)
  # produce v
  pf[[as.character(substitute(v))]]
}

# sq_push(v,x1,...,xn):v puts x1, x2, ..., xn onto the
#   left end of v, producing v.
#   Values are pushed in order from left to right,
#   so xn becomes the first (leftmost) value on v.
#   put(v) with no second argument does nothing.
sq_push <- function(v, x = NA, ...) {
  pf <- parent.frame()
  if (is.null(x))
    return(pf$v)
  if (!(length(x) > 1) && !rlang::is_closure(x) && is.na(x))
    return(pf$v)
  assign(as.character(substitute(v)), c(c(x, ...)[length(x):1], v), pf)
  # produce v
  pf[[as.character(substitute(v))]]
}