R/stack.R

Defines functions StackList size.StackList last_element.StackList first_element.StackList shift.StackList clear.StackList pop.StackList push.StackList Stack print.StackList as.list.StackList print.Stack as.vector.Stack size.Stack last_element.Stack first_element.Stack shift.Stack clear.Stack pop.Stack push.Stack size.default last_element.default first_element.default shift.default clear.default pop.default push.default as.StackList.default as.StackList as.Stack.default as.Stack size last_element first_element shift clear pop push

Documented in as.Stack as.Stack.default as.StackList as.StackList.default clear clear.default first_element first_element.default last_element last_element.default pop pop.default push push.default shift shift.default size size.default Stack StackList

#-------------------------------------------------------------------------------
#
# Package tictoc
#
# Stack and StackList
#
# Sergei Izrailev, 2011, 2014, 2017-2023
#-------------------------------------------------------------------------------
# Copyright 2011-2014 Collective, Inc.
# Portions are Copyright (C) 2017-2023 Jabiru Ventures LLC
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#-------------------------------------------------------------------------------

# to satisfy R CMD check -- the .Data object is actually defined in S3 class.
.Data <- vector()

#-------------------------------------------------------------------------------
# STACK
#-------------------------------------------------------------------------------

#' Stack and StackList classes and methods
#'
#' \code{push} - Append an element.
#' @param x A Stack or StackList object.
#' @param value Value to append.
#' @param s A structure to be converted to a Stack or StackList.
#' @name Stack and StackList
#' @aliases Stack StackList push.default pop.default clear.default shift.default first_element.default last_element.default size.default as.Stack.default as.StackList.default
#' @rdname Stack
#' @export
push <- function(x, value) UseMethod("push")    # append an element

#-------------------------------------------------------------------------------

#' @description
#' \code{pop} - Remove and return the last element.
#' @rdname Stack
#' @export
pop  <- function(x) UseMethod("pop")            # pop the last element

#-------------------------------------------------------------------------------

#' @description
#' \code{clear} - Remove all elements.
#' @rdname Stack
#' @export
clear  <- function(x) UseMethod("clear")

#-------------------------------------------------------------------------------

#' @description
#' \code{shift} - Remove and return the first element.
#' @rdname Stack
#' @export
shift  <- function(x) UseMethod("shift")        # pop the first element

#-------------------------------------------------------------------------------

#' @description
#' \code{first_element} - Return the first element. We can't use \code{first} because
#' it's taken by the \code{dplyr} package and is not an S3 method.
#' @rdname Stack
#' @export
first_element  <- function(x) UseMethod("first_element")        # return the first element

#-------------------------------------------------------------------------------

#' @description
#' \code{last_element} - Return the last element. We can't use \code{last} because
#' it's taken by the \code{dplyr} package and is not an S3 method.
#' @rdname Stack
#' @export
last_element  <- function(x) UseMethod("last_element")        # return the last element

#-------------------------------------------------------------------------------

#' @description
#' \code{size} - Return the number of  elements.
#' @rdname Stack
#' @export
size  <- function(x) UseMethod("size")        # return the number of elements

#-------------------------------------------------------------------------------

#' @description
#' \code{as.Stack} - Creates a new Stack from (typically, vector) \code{s}.
#' @rdname Stack
#' @export
as.Stack <- function(s) UseMethod("as.Stack")

#' @export
as.Stack.default <- function(s)
{
   stack <- Stack()
   push(stack, s)
   stack
}

#' @description
#' \code{as.StackList} - Creates a new StackList from (typically, list) \code{s}.
#' @rdname Stack
#' @export
as.StackList <- function(s) UseMethod("as.StackList")

#' @export
as.StackList.default <- function(s)
{
   lst <- StackList()
   lst$.Data <- as.list(s)
   lst
}

#-------------------------------------------------------------------------------

#' @aliases push pop clear shift first_element last_element size
#' @export
push.default  <- function(x, value) stop(gettextf("Unknown class for '%s'.", deparse(substitute(x))))

#' @export
pop.default  <- function(x) stop(gettextf("Unknown class for '%s'.", deparse(substitute(x))))

#' @export
clear.default  <- function(x) stop(gettextf("Unknown class for '%s'.", deparse(substitute(x))))

#' @export
shift.default  <- function(x) stop(gettextf("Unknown class for '%s'.", deparse(substitute(x))))

#' @export
first_element.default  <- function(x) stop(gettextf("Unknown class for '%s'.", deparse(substitute(x))))

#' @export
last_element.default  <- function(x) stop(gettextf("Unknown class for '%s'.", deparse(substitute(x))))

#' @export
size.default  <- function(x) stop(gettextf("Unknown class for '%s'.", deparse(substitute(x))))

#' @export
push.Stack <- function(x, value) x$push(value)

#' @export
pop.Stack  <- function(x) x$pop()

#' @export
clear.Stack  <- function(x) x$clear()

#' @export
shift.Stack  <- function(x) x$shift()

#' @export
first_element.Stack  <- function(x) x$first()

#' @export
last_element.Stack  <- function(x) x$last()

#' @export
size.Stack  <- function(x) x$size()

#' @export
as.vector.Stack <- function(x, mode = "any") as.vector(x$.Data)

#' @export
print.Stack <- function(x, ...) print(x$.Data)

#' @export
as.list.StackList <- function(x, ...) as.list(x$.Data)

#' @export
print.StackList <- function(x, ...) print(x$.Data)

#-------------------------------------------------------------------------------

#' @description
#' \code{Stack()} - Creates and keeps a stack of items of the same type, implemented as an R vector.
#' The type is determined by the first \code{push} operation.
#' @rdname Stack
#' @export
Stack <- function()
{
   stack <- new.env()

   stack$.Data <- vector()

   stack$push <- function(x)
   {
      if (is.list(x)) stop("Can't push a list on a stack")
      .Data <<- c(.Data, x)
   }

   stack$pop  <- function()
   {
      tmp <- .Data[length(.Data)]
      .Data <<- .Data[-length(.Data)]
      return(tmp)
   }

   stack$clear <- function() .Data <<- vector()

   stack$shift  <- function()
   {
      tmp <- .Data[1]
      .Data <<- .Data[-1]
      return(tmp)
   }

   stack$first <- function()
   {
      if (length(.Data) == 0) {
         return(NA)
      }
      .Data[1]
   }

   stack$last <- function()
   {
      if (length(.Data) == 0) {
         return(NA)
      }
      .Data[length(.Data)]
   }

   stack$size <- function() length(.Data)

   environment(stack$push) <- as.environment(stack)
   environment(stack$pop) <- as.environment(stack)
   environment(stack$clear) <- as.environment(stack)
   environment(stack$shift) <- as.environment(stack)
   environment(stack$first) <- as.environment(stack)
   environment(stack$last) <- as.environment(stack)
   environment(stack$size) <- as.environment(stack)

   class(stack) <- "Stack"
   stack
}

#------------------------------------------------------------------------------

# LIST - keeps a list of items with append and clear operations
#' @export
push.StackList <- function(x, value, ...) x$push(value)

#' @export
pop.StackList  <- function(x) x$pop()

#' @export
clear.StackList  <- function(x) x$clear()

#' @export
shift.StackList  <- function(x) x$shift()

#' @export
first_element.StackList  <- function(x) x$first()

#' @export
last_element.StackList  <- function(x) x$last()

#' @export
size.StackList  <- function(x) x$size()

#' @description
#' \code{StackList()} - Creates and keeps a list of items of the same type, implemented as an R list.
#' The type is determined by the first \code{push} operation.
#' @rdname Stack
#' @export
StackList <- function()
{
   lst <- new.env()

   lst$.Data <- list()

   lst$push <- function(x)
   {
      .Data <<- c(.Data, 1)
      .Data[[length(.Data)]] <<- x
   }

   lst$pop  <- function()
   {
      tmp <- .Data[[length(.Data)]]
      .Data <<- .Data[-length(.Data)]
      return(tmp)
   }

   lst$clear <- function() .Data <<- list()

   lst$shift  <- function()
   {
      tmp <- .Data[[1]]
      .Data <<- .Data[-1]
      return(tmp)
   }

   lst$first <- function()
   {
      if (length(.Data) == 0) {
         return(NA)
      }
      .Data[[1]]
   }

   lst$last <- function()
   {
      if (length(.Data) == 0) {
         return(NA)
      }
      .Data[[length(.Data)]]
   }

   lst$size <- function() length(.Data)

   environment(lst$push) <- as.environment(lst)
   environment(lst$pop) <- as.environment(lst)
   environment(lst$clear) <- as.environment(lst)
   environment(lst$shift) <- as.environment(lst)
   environment(lst$first) <- as.environment(lst)
   environment(lst$last) <- as.environment(lst)
   environment(lst$size) <- as.environment(lst)

   class(lst) <- "StackList"
   lst
}

#------------------------------------------------------------------------------

Try the tictoc package in your browser

Any scripts or data that you put into this service are public.

tictoc documentation built on April 23, 2023, 9:20 a.m.