Get the predictions of multiple models when applied to a new data set

The getPreds function, now inluded in the fuzzySim package (Barbosa, 2015), can be useful if you have a list of model objects (e.g. resulting from multGLM) and want to apply them to a new data set (e.g. with variables from another region or time period), with options to include the logit link (y) and/or Favourability, in just one step. If you want Favourability to be calculated, you need also the Fav function. There is now also the option of using a RasterStack as the data argument, for which you’ll need to have the raster packages intalled and loaded.

getPreds <- function (data, models, id.col = NULL, Y = FALSE, P = TRUE, 
  Favourability = TRUE, incl.input = FALSE) 
{
  if (!Y & !P & !Favourability) 
    stop("There are no predictions to get\nif all Y, P and Favourability are set to FALSE.")
  start.time <- Sys.time()
  if (class(data) == "RasterStack") {
    preds <- stack()
    mod.count <- 0
    for (m in 1:length(models)) {
      mod.count <- mod.count + 1
      mod <- models[[m]]
      mod.name <- names(models)[m]
      message("Predicting with model ", mod.count, " of ", 
        length(models), " (", mod.name, ")...")
      if (Y == TRUE) {
        preds <- raster::addLayer(preds, raster::predict(data, 
          mod))
        names(preds)[raster::nlayers(preds)] <- paste(mod.name, 
          "Y", sep = "_")
      }
      if (P == TRUE | Favourability == TRUE) {
        p <- raster::predict(data, mod, type = "response")
        if (P == TRUE) {
          preds <- raster::addLayer(preds, p)
          names(preds)[raster::nlayers(preds)] <- paste(mod.name, 
            "P", sep = "_")
        }
      }
      if (Favourability == TRUE) {
        n1 <- sum(mod$y == 1)
        n0 <- sum(mod$y == 0)
        preds <- raster::addLayer(preds, (p/(1 - p))/((n1/n0) + 
          (p/(1 - p))))
        names(preds)[raster::nlayers(preds)] <- paste(mod.name, 
          "F", sep = "_")
      }
    }
    return(preds)
  }
  stopifnot(is.data.frame(data), is.list(models), is.null(id.col) | 
    id.col %in% (1:ncol(data)), is.logical(Y), is.logical(P), 
    is.logical(Favourability), is.logical(incl.input))
  input.data <- data
  keeP <- P
  if (Favourability) 
    P <- TRUE
  n.nulls <- length(models[sapply(models, is.null)])
  if (n.nulls > 0) 
    warning(n.nulls, " model(s) were NULL and therefore\n          did not generate predictions")
  models <- models[!sapply(models, is.null)]
  n.models <- length(models)
  mod.count <- 0
  for (m in 1:n.models) {
    mod.count <- mod.count + 1
    mod.name <- names(models)[m]
    message("Predicting with model ", mod.count, " of ", 
      n.models, " (", mod.name, ")...")
    if (Y) {
      data[, ncol(data) + 1] <- predict(models[[mod.count]], 
        data)
      names(data)[ncol(data)] <- paste(mod.name, "Y", 
        sep = "_")
    }
    if (P) {
      data[, ncol(data) + 1] <- predict(models[[mod.count]], 
        data, type = "response")
      names(data)[ncol(data)] <- paste(mod.name, "P", 
        sep = "_")
    }
    if (Favourability) {
      data[, ncol(data) + 1] <- Fav(pred = data[, ncol(data)], 
        n1n0 = c(sum(models[[mod.count]]$y == 1), sum(models[[mod.count]]$y == 
          0)))
      names(data)[ncol(data)] <- paste(mod.name, "F", 
        sep = "_")
      if (!keeP) 
        data <- data[, -(ncol(data) - 1)]
    }
  }
  if (incl.input) {
    id.col <- NULL
  }
  else {
    data <- data[, -(1:ncol(input.data)), drop = FALSE]
    if (!is.null(id.col)) {
      data <- data.frame(input.data[, id.col, drop = FALSE], 
        data)
      names(data)[1] <- names(input.data)[id.col]
    }
  }
  message("Finished!")
  timer(start.time)
  return(data)
}

[presented with hilite.me]

REFERENCES:

Barbosa A.M. (2015) fuzzySim: applying fuzzy logic to binary similarity indices in ecology. Methods in Ecology and Evolution, 6: 853-858

Advertisements

One thought on “Get the predictions of multiple models when applied to a new data set

  1. Pingback: New features in fuzzySim functions | modTools

Comment

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

w

Connecting to %s