# -------------------------------------------------------------------------------------------------------------------------  #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #           File Name              :  shift.r                                                                                #
  #           Last Updated Funclist  :  08 Feb 2015,  5:12 AM (Sunday)                                                         #
  #                                                                                                                            #
  #           Author Name            :  Rick Saporta                                                                           #
  #           Author Email           :  RickSaporta@gmail.com                                                                  #
  #           Author URL             :  www.github.com/rsaporta                                                                #
  #                                                                                                                            #
  #           Packages Called        :  NA                                                                                     #
  #           Packages Used via NS   :  NA                                                                                     #
  #                                                                                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  #                                                                                                                            #
  #   shiftUp            ( x, n=1, roll=FALSE, fill.with=NA, up=TRUE, ... )                                                    #
  #   shiftDown          ( x, n=1, roll=FALSE, fill.with=NA, up=FALSE, ... )                                                   #
  #   shiftb             ( x, n=1, roll=FALSE, fill.with=NA, up=FALSE, ... )                                                   #
  #   shiftf             ( x, n=1, roll=FALSE, fill.with=NA, up=TRUE, ... )                                                    #
  #   shift              ( x, n=1, roll=FALSE, fill.with=NA, up=TRUE, showWarnings=FALSE )                                     #
  #                                                                                                                            #
  #                                                                                                                            #
  #                                                     <END FUNCS>                                                            #
  #  -----------------------------------------------------------------------------------------------------------------------   #
  # -------------------------------------------------------------------------------------------------------------------------  #

## shiftUp   / shiftf (forward) are identical
## shiftDown / shiftb (back)    are identical
## shift default settings is same as shiftUp

shiftUp <- function(x, n=1, roll=FALSE, fill.with=NA, up=TRUE, ...) {
  if (!missing(up))
    warning("argument 'up' is ignored in shiftUp().\nHINT:Call shift() directly (the function wrapped here) to control the 'up' argument.")
  shift(x, n=n, roll=roll, fill.with=fill.with, up=TRUE, ...)
}

shiftDown <- function(x, n=1, roll=FALSE, fill.with=NA, up=FALSE, ...) {
  if (!missing(up))
    warning("argument 'up' is ignored in shiftDown().\nHINT:Call shift() directly (the function wrapped here) to control the 'up' argument.")
  shift(x, n=n, roll=roll, fill.with=fill.with, up=FALSE, ...)
}

shiftb <- function(x, n=1, roll=FALSE, fill.with=NA, up=FALSE, ...) {
## OLD 20141009: the entire function was just
##             {  c(x[length(x)], x[-length(x)])  }
  if (!missing(up))
     warning("argument 'up' is ignored in shiftb().\nHINT:Call shift() directly (the function wrapped here) to control the 'up' argument.")
  shift(x, n=n, roll=roll, fill.with=fill.with, up=FALSE, ...)
}
shiftRight  <- shiftb

shiftf <- function(x, n=1, roll=FALSE, fill.with=NA, up=TRUE, ...) {
## "forard"  means BRING IT forward
## OLD 20141009: the entire function was just
##             {  c(x[length(x)], x[-length(x)])  }
  if (!missing(up))
     warning("argument 'up' is ignored in shiftb().\nHINT:Call shift() directly (the function wrapped here) to control the 'up' argument.")
  shift(x, n=n, roll=roll, fill.with=fill.with, up=TRUE, ...)
}
shiftLeft <- shiftf

shift <- function(x, n=1, roll=FALSE, fill.with=NA, up=TRUE, showWarnings=FALSE) {
## Pushes forward

  ## forward means the "next" value comes one closer to "now"
  ## backward means the "next" value moves one further away from "now"
  ## backward means the "current" value moves one back, further away from "now"

  if (!is.atomic(x) || !is.null(dim(x)))
    stop("x must be a single dimension atomic vector")

  if (!length(x))
    return(x)
  if (length(x) == 1)
    return(fill.with)

  if (n==0) {
    if (showWarnings)
      warning("n is 0, no shift performed")
    return(x)
  }

  if (n < 0) {
    n <- abs(n)
    up <- !up
  }

  l <- length(x)

  if (n >= l)
    stop ("length(x), ", l, ", must be strictly greater than n, ", n,".\nHINT: To use modulo or cyclcic shifting, use `n %% length(x)` in place of `n`")

  browser(expr=inDebugMode("shift"), text="in shift() before computing fill and ret")

  class(fill.with) <- class(x)

  fill <- if (roll) {if (up) x[seq(n)] else x[seq(n) + (l-n)]}  else (rep(fill.with, n))

  ret <- if (up)   c(x[ seq(l - n) + n ], fill) else
             c(fill, x[ seq(l - n) + 0 ])
  
  return(  ret  )
}
#_________________________________________#