R/utilities_krome.R

Defines functions err cvcompute huberReg error.bars

err <- function(n, maxit) {
  if (n == 0)
    msg <- ""
  if (n < 0) {
    msg <-
      paste(
        "convergence for ",-n, "th lambda value not reached after maxit=",
        maxit, " iterations; solutions for larger lambdas returned",
        sep = ""
      )
    n <- -1
    msg <- paste("From krome fortran code -", msg)
  }
  list(n = n, msg = msg)
}

cvcompute <- function(mat, foldid, nlams) {
  ###Computes the weighted mean and SD within folds, and
  #   hence
  #   the se of the mean
  nfolds <- max(foldid)
  outmat <- matrix(NA, nfolds, ncol(mat))
  good <- matrix(0, nfolds, ncol(mat))
  mat[is.infinite(mat)] <- NA
  for (i in seq(nfolds)) {
    mati <- mat[foldid == i,]
    outmat[i,] <- apply(mati, 2, mean, na.rm = TRUE)
    good[i, seq(nlams[i])] <- 1
  }
  N <- apply(good, 2, sum)
  list(cvraw = outmat, N = N)
}


huberReg <- function(r, delta) {
  0.5 * r^2 * (abs(r) <= delta) + delta * (abs(r) - delta/2) * (abs(r) > delta)
} 

error.bars <- function(x, upper, lower, width = 0.02,
                       ...) {
  xlim <- range(x)
  barw <- diff(xlim) * width
  segments(x, upper, x, lower, ...)
  segments(x - barw, upper, x + barw, upper, ...)
  segments(x - barw, lower, x + barw, lower, ...)
  range(upper, lower)
}
emeryyi/rome documentation built on May 6, 2019, 9:53 a.m.