R/lolo.cv.R

In gregorywatson/lolo:

# library(randomForest)
# library(doParallel)

#' LOLO CV
#'
#' LOLO Cross-Validation
#'
#' This function performs leave-one-location-out cross-validation.
#' @param y n x 1 vector of outcomes.
#' @param x n x p matrix of covariates.
#' @param location.index n x 1 index of observation locations.
#' @param eta prediction rule with 3 arguments (training outcome, training covariates, test covariates)
#' @param Q loss function. Defaults to mse.
#' @param n.cores number of cores (defaults to 4).
#' @keywords cross-validation
#' @export
#' @examples
#' lolo.cv()
lolo.cv <- function(y, x, location.index, eta, Q = mse, n.cores = 4) {
  require(doParallel)
  #
  registerDoParallel(cores = n.cores)
  lolo.estimates <- foreach(location = unique(location.index), .combine = c) %dopar% {
    y.hat <- eta(y[location.index != location,], 
                 x[location.index != location,], 
                 x[location.index == location,])
    Q(y[location.index == location], 
      y.hat)  
  }
  return(lolo.estimates)
}

#' ETA LM
#'
#' Defines a linear prediction model.
#'
#' This function returns predictions produced by a linear model.
#' @param y n x 1 vector of outcomes.
#' @param x n x p matrix of covariates.
#' @param x.pred m x p matrix of covariates for which to predict the outcome.
#' @keywords prediction
#' @export
#' @examples
#' eta.lm()
eta.lm <- function(y, x, x.pred) {
    lm.fit <- lm(y ~ ., data = data.frame(y,x))
    return(predict(lm.fit, newdata = data.frame(x.pred)))
}

#' ETA Random Forest
#'
#' Defines a random forest prediction model.
#'
#' This function returns predictions produced by a random forest.
#' @param y n x 1 vector of outcomes.
#' @param x n x p matrix of covariates.
#' @param x.pred m x p matrix of covariates for which to predict the outcome.
#' @keywords prediction
#' @export
#' @examples
#' eta.randomForest()
eta.randomForest <- function(y, x, x.pred) {
    require(randomForest)
    #
    rf <- randomForest(y = y, x = x)
    return(predict(rf, newdata = x.pred))
}

#' Mean Squared Error
#'
#' Computes the mean squared error between two vectors.
#'
#' This function computes the mean squared error.
#' @param y n x 1 vector of outcomes.
#' @param yhat n x 1 vector of predictions.
#' @keywords mse
#' @export
#' @examples
#' mse()
mse <- function(y, yhat) {
    return(mean((yhat - y)^2))
}

#' Mean Absolute Error
#'
#' Computes the mean absolute error between two vectors.
#'
#' This function computes the mean absolute error.
#' @param y n x 1 vector of outcomes.
#' @param yhat n x 1 vector of predictions.
#' @keywords mae
#' @export
#' @examples
#' mae()
mae <- function(y, yhat) {
    return(mean(abs(yhat - y)))
}


#library(Rcpp)
#sourceCpp("/Users/gregorywatson/Documents/UCLA/Telesca/Downscaling/Code/r package/lolo/src/test.cpp")