R/RcppExports.R

In RcppDynProg: 'Rcpp' Dynamic Programming

# Generated by using Rcpp::compileAttributes() -> do not edit by hand
# Generator token: 10BE3573-1514-4C36-9D1C-5A225CD40393

#' const_cost
#' 
#' Calculate out of sample total square error cost of using mean of points to estimate other points in interval.
#' Zero indexed.
#' 
#' @param y NumericVector, values to group in order.
#' @param w NumericVector, weights.
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param i integer, first index (inclusive).
#' @param j integer, j>=i last index (inclusive);
#' @return scalar, const cost of [i,...,j] interval (inclusive).
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' const_cost(c(1, 1, 2, 2), c(1, 1, 1, 1), 1, 0, 3)
#' 
#' @export
const_cost <- function(y, w, min_seg, i, j) {
    .Call('_RcppDynProg_const_cost', PACKAGE = 'RcppDynProg', y, w, min_seg, i, j)
}

#' const_costs
#' 
#' Built matrix of total out of sample interval square error costs for held-out means.
#' One indexed.
#' 
#' @param y NumericVector, values to group in order.
#' @param w NumericVector, weights.
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param indices IntegerVector, order list of indices to pair.
#' @return xcosts NumericMatix, for j>=i xcosts(i,j) is the cost of partition element [i,...,j] (inclusive).
#' 
#' 
#' @examples
#' 
#' const_costs(c(1, 1, 2, 2), c(1, 1, 1, 1), 1, 1:4)
#' 
#' @export
const_costs <- function(y, w, min_seg, indices) {
    .Call('_RcppDynProg_const_costs', PACKAGE = 'RcppDynProg', y, w, min_seg, indices)
}

#' const_cost_logistic
#' 
#' Calculate logistic cost of using mean of points to estimate other points in interval.
#' Zero indexed.
#' 
#' @param y NumericVector, 0/1 values to group in order (should be in interval [0,1]).
#' @param w NumericVector, weights (should be positive).
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param i integer, first index (inclusive).
#' @param j integer, j>=i last index (inclusive);
#' @return scalar, const cost of [i,...,j] interval (inclusive).
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' const_cost_logistic(c(0.1, 0.1, 0.2, 0.2), c(1, 1, 1, 1), 1, 0, 3)
#' 
#' @export
const_cost_logistic <- function(y, w, min_seg, i, j) {
    .Call('_RcppDynProg_const_cost_logistic', PACKAGE = 'RcppDynProg', y, w, min_seg, i, j)
}

#' const_costs_logistic
#' 
#' Built matrix of interval logistic costs for held-out means.
#' One indexed.
#' 
#' @param y NumericVector, 0/1 values to group in order (should be in interval [0,1]).
#' @param w NumericVector, weights (should be positive).
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param indices IntegerVector, order list of indices to pair.
#' @return xcosts NumericMatix, for j>=i xcosts(i,j) is the cost of partition element [i,...,j] (inclusive).
#' 
#' 
#' @examples
#' 
#' const_costs_logistic(c(0.1, 0.1, 0.2, 0.2), c(1, 1, 1, 1), 1, 1:4)
#' 
#' @export
const_costs_logistic <- function(y, w, min_seg, indices) {
    .Call('_RcppDynProg_const_costs_logistic', PACKAGE = 'RcppDynProg', y, w, min_seg, indices)
}

#' Summarize data (for debugging).
#' 
#' @param x NumericVector, expanatory variable.
#' @param y NumericVector, 0/1 values to fit.
#' @param w NumericVector, weights (required, positive).
#' @param i integer, first index (inclusive).
#' @param j integer, last index (inclusive).
#' @param skip integer, index to skip (-1 to not skip).
#' @return summary list
#' 
#' @keywords internal
#' 
#' 
#' @examples
#' 
#' costs <- matrix(c(1.5, NA ,NA ,1 ,0 , NA, 5, -1, 1), nrow = 3)
#' solve_interval_partition(costs, nrow(costs))
#'
#' @export
summarize_input <- function(x, y, w, i, j, skip) {
    .Call('_RcppDynProg_summarize_input', PACKAGE = 'RcppDynProg', x, y, w, i, j, skip)
}

#' lin_cost
#' 
#' Calculate cost of using linear model fit on points to estimate other points in the interval.
#' Zero indexed.
#' 
#' @param x NumericVector, x-coords of values to group.
#' @param y NumericVector, values to group in order.
#' @param w NumericVector, weights.
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param i integer, first index (inclusive).
#' @param j integer, j>=i last index (inclusive);
#' @return scalar, linear cost of [i,...,j] interval (inclusive).
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' lin_cost(c(1, 2, 3, 4), c(1, 2, 2, 1), c(1, 1, 1, 1), 1, 0, 3)
#' 
#' @export
lin_cost <- function(x, y, w, min_seg, i, j) {
    .Call('_RcppDynProg_lin_cost', PACKAGE = 'RcppDynProg', x, y, w, min_seg, i, j)
}

#' lin_costs
#' 
#' Built matrix of interval costs for held-out linear models.
#' One indexed.
#' 
#' @param x NumericVector, x-coords of values to group.
#' @param y NumericVector, values to group in order.
#' @param w NumericVector, weights.
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param indices IntegerVector, ordered list of indices to pair.
#' @return xcosts NumericMatix, for j>=i xcosts(i,j) is the cost of partition element [i,...,j] (inclusive).
#' 
#' @examples
#' 
#' lin_costs(c(1, 2, 3, 4), c(1, 2, 2, 1), c(1, 1, 1, 1), 1, 1:4)
#' 
#' @export
lin_costs <- function(x, y, w, min_seg, indices) {
    .Call('_RcppDynProg_lin_costs', PACKAGE = 'RcppDynProg', x, y, w, min_seg, indices)
}

#' lin_cost_logistic logistic deviance pricing
#' 
#' Calculate deviance cost of using logistic model fit on points to estimate other points in the interval.
#' Fits are evaluated in-sample.
#' Zero indexed.
#' 
#' 
#' @param x NumericVector, x-coords of values to group.
#' @param y NumericVector, values to group in order (should be in interval [0,1]).
#' @param w NumericVector, weights (positive).
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param i integer, first index (inclusive).
#' @param j integer, j>=i last index (inclusive);
#' @return scalar, linear cost of [i,...,j] interval (inclusive).
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' lin_cost_logistic(c(1, 2, 3, 4, 5, 6, 7), c(0, 0, 1, 0, 1, 1, 0), c(1, 1, 1, 1, 1, 1, 1), 3, 0, 6)
#' 
#' @export
lin_cost_logistic <- function(x, y, w, min_seg, i, j) {
    .Call('_RcppDynProg_lin_cost_logistic', PACKAGE = 'RcppDynProg', x, y, w, min_seg, i, j)
}

#' lin_costs_logistic deviance costs.
#' 
#' Built matrix of interval deviance costs for held-out logistic models.
#' Fits are evaluated in-sample.
#' One indexed.
#' 
#' 
#' @param x NumericVector, x-coords of values to group.
#' @param y NumericVector, values to group in order (should be in interval [0,1]).
#' @param w NumericVector, weights (should be positive).
#' @param min_seg positive integer, minimum segment size (>=1).
#' @param indices IntegerVector, ordered list of indices to pair.
#' @return xcosts NumericMatix, for j>=i xcosts(i,j) is the cost of partition element [i,...,j] (inclusive).
#' 
#' @examples
#' 
#' lin_costs_logistic(c(1, 2, 3, 4, 5, 6, 7), c(0, 0, 1, 0, 1, 1, 0), c(1, 1, 1, 1, 1, 1, 1), 3, 1:7)
#' 
#' @export
lin_costs_logistic <- function(x, y, w, min_seg, indices) {
    .Call('_RcppDynProg_lin_costs_logistic', PACKAGE = 'RcppDynProg', x, y, w, min_seg, indices)
}

#' logistic_fit
#' 
#' Calculate y ~ sigmoid(a + b x) using iteratively re-weighted least squares.
#' Zero indexed.
#' 
#' @param x NumericVector, expanatory variable.
#' @param y NumericVector, 0/1 values to fit.
#' @param w NumericVector, weights (required, positive).
#' @param initial_link, initial link estimates (required, all zeroes is a good start).
#' @param i integer, first index (inclusive).
#' @param j integer, last index (inclusive).
#' @param skip integer, index to skip (-1 to not skip).
#' @return vector of a and b.
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' set.seed(5)
#' d <- data.frame(
#'   x =  rnorm(10),
#'   y = sample(c(0,1), 10, replace = TRUE)
#' )
#' weights <- runif(nrow(d))
#' m <- glm(y~x, data = d, family = binomial, weights = weights)
#' coef(m)
#' logistic_solve1(d$x, d$y, weights, rep(0.0, nrow(d)), 0, nrow(d)-1, -1)
#' 
#' @export
logistic_solve1 <- function(x, y, w, initial_link, i, j, skip) {
    .Call('_RcppDynProg_logistic_solve1', PACKAGE = 'RcppDynProg', x, y, w, initial_link, i, j, skip)
}

#' Out of sample logistic predictions (in link space).
#' 
#' 1-hold out logistic regression predections.
#' Zero indexed.
#' 
#' @param x NumericVector, expanatory variable.
#' @param y NumericVector, 0/1 values to fit.
#' @param w NumericVector, weights (required, positive).
#' @param i integer, first index (inclusive).
#' @param j integer, last index (inclusive).
#' @return vector of predictions for interval.
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' set.seed(5)
#' d <- data.frame(x = rnorm(10))
#' d$y <- d$x + rnorm(nrow(d))>0
#' weights <- runif(nrow(d))
#' m <- glm(y~x, data = d, family = binomial, weights = weights)
#' d$pred1 <- predict(m, newdata = d, type = "link")
#' d$pred2 <- xlogistic_fits(d$x, d$y, weights, 0, nrow(d)-1)
#' d <- d[order(d$x), , drop = FALSE]
#' print(d)
#' 
#' @export
xlogistic_fits <- function(x, y, w, i, j) {
    .Call('_RcppDynProg_xlogistic_fits', PACKAGE = 'RcppDynProg', x, y, w, i, j)
}

#' In sample logistic predictions (in link space).
#' 
#' logistic regression predictions.
#' Zero indexed.
#' 
#' @param x NumericVector, expanatory variable.
#' @param y NumericVector, 0/1 values to fit.
#' @param w NumericVector, weights (required, positive).
#' @param i integer, first index (inclusive).
#' @param j integer, last index (inclusive).
#' @return vector of predictions for interval.
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' set.seed(5)
#' d <- data.frame(x = rnorm(10))
#' d$y <- d$x + rnorm(nrow(d))>0
#' weights <- runif(nrow(d))
#' m <- glm(y~x, data = d, family = binomial, weights = weights)
#' d$pred1 <- predict(m, newdata = d, type = "link")
#' d$pred2 <- logistic_fits(d$x, d$y, weights, 0, nrow(d)-1)
#' d <- d[order(d$x), , drop = FALSE]
#' print(d)
#' 
#' @export
logistic_fits <- function(x, y, w, i, j) {
    .Call('_RcppDynProg_logistic_fits', PACKAGE = 'RcppDynProg', x, y, w, i, j)
}

#' solve_interval_partition interval partition problem with a bound on number of steps.
#' 
#' Solve a for a minimal cost partition of the integers [1,...,nrow(x)] problem where for j>=i x(i,j).
#' is the cost of choosing the partition element [i,...,j]. 
#' Returned solution is an ordered vector v of length k<=kmax where: v[1]==1, v[k]==nrow(x)+1, and the 
#' partition is of the form [v[i], v[i+1]) (intervals open on the right).
#' 
#' @param x square NumericMatix, for j>=i x(i,j) is the cost of partition element [i,...,j] (inclusive).
#' @param kmax int, maximum number of segments in solution. 
#' @return dynamic program solution.
#' 
#' @examples
#' 
#' costs <- matrix(c(1.5, NA ,NA ,1 ,0 , NA, 5, -1, 1), nrow = 3)
#' solve_interval_partition(costs, nrow(costs))
#'
#' @export
solve_interval_partition_k <- function(x, kmax) {
    .Call('_RcppDynProg_solve_interval_partition_k', PACKAGE = 'RcppDynProg', x, kmax)
}

#' solve_interval_partition interval partition problem, no boun on the number of steps.
#' 
#' Not working yet.
#' 
#' Solve a for a minimal cost partition of the integers [1,...,nrow(x)] problem where for j>=i x(i,j).
#' is the cost of choosing the partition element [i,...,j]. 
#' Returned solution is an ordered vector v of length k where: v[1]==1, v[k]==nrow(x)+1, and the 
#' partition is of the form [v[i], v[i+1]) (intervals open on the right).
#' 
#' @param x square NumericMatix, for j>=i x(i,j) is the cost of partition element [i,...,j] (inclusive).
#' @return dynamic program solution.
#' 
#' @examples
#' 
#' costs <- matrix(c(1.5, NA ,NA ,1 ,0 , NA, 5, -1, 1), nrow = 3)
#' solve_interval_partition(costs, nrow(costs))
#'
#' @export
solve_interval_partition_no_k <- function(x) {
    .Call('_RcppDynProg_solve_interval_partition_no_k', PACKAGE = 'RcppDynProg', x)
}

#' solve_interval_partition interval partition problem.
#' 
#' Solve a for a minimal cost partition of the integers [1,...,nrow(x)] problem where for j>=i x(i,j).
#' is the cost of choosing the partition element [i,...,j]. 
#' Returned solution is an ordered vector v of length k<=kmax where: v[1]==1, v[k]==nrow(x)+1, and the 
#' partition is of the form [v[i], v[i+1]) (intervals open on the right).
#' 
#' @param x square NumericMatix, for j>=i x(i,j) is the cost of partition element [i,...,j] (inclusive).
#' @param kmax int, maximum number of segments in solution. 
#' @return dynamic program solution.
#' 
#' @examples
#' 
#' costs <- matrix(c(1.5, NA ,NA ,1 ,0 , NA, 5, -1, 1), nrow = 3)
#' solve_interval_partition(costs, nrow(costs))
#'
#' @export
solve_interval_partition <- function(x, kmax) {
    .Call('_RcppDynProg_solve_interval_partition', PACKAGE = 'RcppDynProg', x, kmax)
}

#' xlin_fits
#' 
#' Calculate out of sample linear fit predictions using regularization.
#' Zero indexed.
#' 
#' @param x NumericVector, explanatory variable (length>=2).
#' @param y NumericVector, values fit.
#' @param w NumericVector, weights (positive).
#' @param i integer, first index (inclusive).
#' @param j integer, j>=i+2 last index (inclusive);
#' @return  vector of predictions.
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' xlin_fits(c(1, 2, 3, 4), c(1, 2, 2, 1), c(1, 1, 1, 1), 0, 3)
#' 
#' @export
xlin_fits <- function(x, y, w, i, j) {
    .Call('_RcppDynProg_xlin_fits', PACKAGE = 'RcppDynProg', x, y, w, i, j)
}

#' xlin_pfits
#' 
#' Calculate out of sample linear fit predictions using pseudo-inverse.
#' Please see: \url{https://win-vector.com/2019/01/08/a-beautiful-2-by-2-matrix-identity/}.
#' Zero indexed.
#' 
#' @param x NumericVector, explanatory variable (length>=2).
#' @param y NumericVector, values to fit.
#' @param w NumericVector, weights (positive).
#' @param i integer, first index (inclusive).
#' @param j integer, j>=i+2 last index (inclusive);
#' @return  vector of predictions.
#' 
#' @keywords internal
#' 
#' @examples
#' 
#' xlin_pfits(c(1, 2, 3, 4), c(1, 2, 2, 1), c(1, 1, 1, 1), 0, 3)
#' 
#' @export
xlin_pfits <- function(x, y, w, i, j) {
    .Call('_RcppDynProg_xlin_pfits', PACKAGE = 'RcppDynProg', x, y, w, i, j)
}