#' Find the average of the transformation of n previous elements.
#'
#' @param x input vector
#' @param length number of elements to look back (size of window)
#' @param rule an "adherance" function that transforms each element of the sequence
#' @param decay a function that describes how the importance of an observation should decrease with distance
#' @return numeric vector giving the average of the transformation of (length) previous elements
#' @examples
#' look_back(c(1,0,1,1,1,0,1,1,0,1,1))
#' look_back(c(1,2,3,4,5,6), rule = function(j){j>3}, decay = function(d){1/d})
#' @export
look_back <- function(x,length = 1,rule = function(j){j},decay = function(distance){rep(1,length(distance))}) {
if (length > length(x)) stop("length of x must be greater than length parameter")
summing <- mean
# lag accepts a vector x and an int n and returns a vector y which is x shifted by n with NA filling
lag <- function(x,n=1) {
c(rep(NA,n),x[-(length(x):(length(x)-n+1))])
}
# Apply the adherance rule to each element of x.
adherance <- lapply(x, rule)
adherance <- unlist(adherance)
# copy the adherance columns (length) times
adherance.matrix <- rep(adherance, length) # repeat
adherance.matrix <- matrix(adherance.matrix,length(x)) # form into matrix
split.adherance <- split(adherance.matrix,col(adherance.matrix)) # split a list of vectors
# Lag each adherance column
# A single row in x.windows shows the previous (length) elements for an element of x with the same index
lag.adherance <- mapply(function(x,n){as.double(lag(x,n))},
x = split.adherance,
n = 1:length,
SIMPLIFY = TRUE)
# Apply the rule to each element of each row, reducing each row to an average of the rules output.
apply(lag.adherance,MARGIN = 1, FUN = function(j){stats::weighted.mean(j,decay(1:length(j)))})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.