#' Lagged Best N Values
#'
#' Calculates a function (\code{.f}) of the top \code{best_n} values
#' from \code{x} over the previous \code{window} days. Assumes that \code{x}
#' and \code{index} are already in order according to \code{index}.
#'
#' @param x numeric vector of values
#' @param index dates, assumed to be character in YYYY-MM-DD format
#' @param best_n integer
#' @param window integer; previous number of days to examine
#' @param adj vector of adjustments for when there are fewer than \code{best_n}
#' values.
#' @export
lag_best_n <- function(x,index,best_n = 5,
window = 365,.f = mean,
adj = c(1.4,1.3,1.2,1.1)){
end <- as.integer(as.Date(index))
start <- end - window
out <- rep(NA,length(x))
for (i in seq_along(x)){
idx <- which(end <= end[i] & end >= start[i])
x_vals <- x[idx]
x_vals <- x_vals[!is.na(x_vals)]
n <- length(x_vals)
if (n <= 4) {
out[i] <- .f(x_vals) * adj[n]
} else{
out[i] <- .f(head(sort(x_vals),n = best_n))
}
}
return(out)
}
#' Lagged Average of Top Results
#'
#' FIS points are typically the average of the best 5 results over the prior
#' calendar year. This is a fast, Rcpp way to replicate this calculation.
#'
#' @param x numeric vector of values
#' @param dates dates, assumed to be character in YYYY-MM-DD format
#' @param n integer
#' @param window integer; previous number of days to examine
#' @param adj vector of adjustments for when there are fewer than \code{n}
#' values.
#' @export
lag_best_avg <- function(x,dates,n = 5L,window = 365L,adj = c(1.4,1.3,1.2,1.1,1)){
dates <- as.integer(as.Date(dates))
lagAvgTopN(values = x,endDates = dates,n = n,window = window,adj = adj)
}
#' FIS Point Threshold Necessary to Raise/Lower Athlete's Point
#'
#' Calculate the point threshold at any given point in time at which an athlete
#' would be able to lower thair carried FIS points.
#'
#' @param x numeric vector of FIS points
#' @param dates character vector of dates, must be in YYYY-MM-DD format
#' @param window integer number of days
#' @export
pts_thresh <- function(x,dates,window = 365L){
dates <- as.integer(as.Date(dates))
ptsThresh(values = x,endDates = dates,window = window)
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.