Adding data= option for explicit data passing; better handling of mlm…

… matrix Y

R/setupF.R

@@ -1,5 +1,8 @@
-setupF <- function(fit, xvar, call.env) {
-  if (isS4(fit)) {
+setupF <- function(fit, xvar, call.env, data) {
+  if (!is.null(data)) {
+    Data <- data
+    CALL <- if (isS4(fit)) fit@call else fit$call
+  } else if (isS4(fit)) {
     CALL <- fit@call
     FRAME <- try(fit@frame, silent=TRUE)
     DATA <- try(fit@data, silent=TRUE)
@@ -8,7 +11,7 @@ setupF <- function(fit, xvar, call.env) {
     } else if (class(FRAME) != 'try-error') {
       Data <- FRAME
     } else {
-      stop("visreg cannot find the data set used to fit your model; try attaching it to the fit with fit@data <- myData")
+      stop("visreg cannot find the data set used to fit your model; supply it using the 'data=' option")
     }
   } else {
     CALL <- fit$call
@@ -23,24 +26,20 @@ setupF <- function(fit, xvar, call.env) {
       env <- call.env
       Data <- eval(CALL$data, envir=env)
     } else if (exists(as.character(CALL$data), ENV)) {
+      env <- ENV
       Data <- eval(CALL$data, envir=ENV)
     } else {
-      stop("visreg cannot find the data set used to fit your model; try attaching it to the fit with fit$data <- myData")
+      stop("visreg cannot find the data set used to fit your model; supply it using the 'data=' option")
     }
   }
   form <- formula(fit)
   if (!is.null(Data)) names(Data) <- gsub('offset\\((.*)\\)', '\\1', names(Data))
-  av <- get_all_vars(form, Data)    # https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=14905
-  #av <- av[,!is.na(names(av))]     # Breaks mlm if dimnames(Y) not set
-  if ("mlm" %in% class(fit) && is.null(colnames(coef(fit)))) {
-    lhs <- fit$terms[[2L]]
-    ny <- ncol(coef(fit))
-    if (mode(lhs) == "call" && lhs[[1L]] == "cbind") {
-      ynames <- as.character(lhs)[-1L]
-    } else {
-      ynames <- paste0("Y", seq_len(ny))
-    }
-    names(av) <- c(ynames, utils::head(names(av)[-1], n=ncol(av) - length(ynames)))
+  if (inherits(fit, 'mlm') && fit$terms[[2L]] != 'call') {
+    ff <- form
+    ff[[2]] <- NULL
+    av <- get_all_vars(ff, Data)      # If mlm with matrix as Y, outside of data frame framework
+  } else {
+    av <- get_all_vars(form, Data)    # https://bugs.r-project.org/bugzilla3/show_bug.cgi?id=14905
   }
   f <- as.data.frame(av)
 
@@ -56,7 +55,7 @@ setupF <- function(fit, xvar, call.env) {
   }
   suppressWarnings(f <- f[!apply(is.na(f), 1, any),,drop=FALSE])
 
-  ## Handle some variable type issues
+  # Handle some variable type issues
   needsUpdate <- FALSE
   f <- droplevels(f)
   frameClasses <- sapply(f, class)

R/visreg.R

@@ -1,4 +1,4 @@
-visreg <- function(fit, xvar, by, breaks=3, type=c("conditional", "contrast"), trans=I,
+visreg <- function(fit, xvar, by, breaks=3, type=c("conditional", "contrast"), data=NULL, trans=I,
                    scale=c("linear","response"), xtrans, alpha=.05, nn=101, cond=list(), jitter=FALSE, collapse=FALSE,
                    plot=TRUE, ...) {
   # Setup
@@ -18,7 +18,7 @@ visreg <- function(fit, xvar, by, breaks=3, type=c("conditional", "contrast"), t
     }
   }
 
-  Data <- setupF(fit, xvar, parent.frame())
+  Data <- setupF(fit, xvar, parent.frame(), data)
   xvar <- attr(Data, "xvar")
   if (attr(Data, "needsUpdate")) {
     if (inherits(fit, 'coxph')) {

R/visreg2d.R

@@ -1,4 +1,4 @@
-visreg2d <- function(fit, xvar, yvar, type=c("conditional", "contrast"), trans=I, scale=c("linear","response"),
+visreg2d <- function(fit, xvar, yvar, type=c("conditional", "contrast"), data=NULL, trans=I, scale=c("linear","response"),
                      nn=99, cond=list(), plot=TRUE, ...) {
   # Setup
   if (type[1]=="effect") {
@@ -11,7 +11,7 @@ visreg2d <- function(fit, xvar, yvar, type=c("conditional", "contrast"), trans=I
   if (missing(xvar) | missing(yvar)) stop("Must specify and x and y variable")
 
   # Set up f
-  f <- setupF(fit, c(xvar, yvar), parent.frame())
+  f <- setupF(fit, c(xvar, yvar), parent.frame(), data)
   if (attr(f, "needsUpdate")) fit <- update(fit, data=f)
   cond <- setupCond(cond, f)[[1]]
 

inst/tests/missing-data.R

@@ -1,4 +1,4 @@
-## Tests missing / subsetted data in various / mixed locations
+# Tests missing / subsetted data in various / mixed locations
 ozone <- airquality
 
 fit <- lm(Ozone ~ Solar.R,data=ozone)
@@ -22,7 +22,7 @@ x[c(10,20)] <- NA
 fit <- lm(y~x)
 visreg(fit,"x")
 
-## Subset
+# Subset
 fit <- lm(Ozone ~ Wind, data=airquality)
 visreg(fit, ylim=c(-50, 200))
 fit <- lm(Ozone ~ Wind, data=airquality, subset=(Ozone < 150))
@@ -32,15 +32,15 @@ visreg(fit, ylim=c(-50, 200), type="contrast")
 fit <- lm(Ozone ~ Wind, data=airquality, subset=(Ozone < 150))
 visreg(fit, ylim=c(-50, 200), type="contrast")
 
-## A bunch of mixed types in various locations
+# A bunch of mixed types in various locations
 a <- rep(LETTERS[1:4],25)
 b <- rep(c(TRUE, FALSE), 50)
 df <- data.frame(c=rnorm(100), d=factor(rep(1:10,10)), y=rnorm(100))
 fit <- lm(y~a+b+c+d, df)
 par(mfrow=c(2,2))
 visreg(fit)
 
-## Data not in global scope
+# Data not in global scope
 myFun <- function(form) {
   Data <- data.frame(x=rnorm(100), y=rnorm(100), z=rnorm(100))
   fit <- lm(form, data=Data)
@@ -51,10 +51,18 @@ myFun <- function(form) {
 }
 myFun(z~x+y)
 
-## Missing factor levels
+# Missing factor levels
 x <- factor(rep(LETTERS[1:5],rep(5,5)))
 y <- rnorm(length(x))
 y[11:15] <- NA
 fit <- lm(y~x)
 visreg(fit)
 visreg(fit, type='contrast')
+
+# data option
+data("birthwt", package="MASS")
+TMP <- birthwt
+fit <- lm(bwt ~ age + race, TMP)
+rm(TMP)
+visreg(fit, 'age', data=birthwt)
+visreg2d(fit, 'age', 'race', data=birthwt)

inst/tests/visreg-lm.R

@@ -59,18 +59,18 @@ fit <- lm(Ozone ~ Solar.R + Wind + Heat, data=airquality)
 visreg(fit, "Wind", cex.axis=2)
 visreg(fit, "Heat", cex.axis=2)
 
-## Specifying by and cond at the same time
+# Specifying by and cond at the same time
 fit <- lm(Ozone ~ Solar.R + Wind*Heat, data=airquality)
 visreg(fit,"Heat", by="Wind", cond=list(Solar.R=0))
 visreg(fit,"Heat", by="Wind", cond=list(Solar.R=500))
 
-## Extrapolation
+# Extrapolation
 fit <- lm(Ozone ~ Solar.R + Wind + Temp, data=airquality)
 par(mfrow=c(1,1))
 visreg(fit, "Temp", xlim=c(50,150))
 visreg(fit, "Temp", type="contrast", xlim=c(50,150))
 
-## Rug
+# Rug
 airquality$Heat <- cut(airquality$Temp,3,labels=c("Cool","Mild","Hot"))
 fit <- lm(Ozone ~ Solar.R + Wind + Heat, data=airquality)
 visreg(fit, "Wind", rug=TRUE, jitter=TRUE)

inst/tests/visreg-mlm.R

@@ -14,7 +14,7 @@ fit <- lm(Y ~ Species + Petal.Width, iris)
 visreg:::se.mlm(fit)
 visreg(fit, "Species")
 
-## Rug
+# Rug
 par(mfrow=c(3,1), mar=c(5, 5, 0.5, 0.5), oma=c(0,0,2,0))
 visreg(fit, "Petal.Width", rug=TRUE, jitter=TRUE)
 visreg(fit, "Petal.Width", rug=TRUE, jitter=TRUE, type="contrast")

man/visreg.Rd

@@ -11,8 +11,8 @@ calculations are passed to \code{plot.visreg} for plotting.
 }
 \usage{
 visreg(fit, xvar, by, breaks=3, type=c("conditional", "contrast"),
-trans=I, scale=c("linear","response"), xtrans,  alpha=.05, nn=101,
-cond=list(), jitter=FALSE, collapse=FALSE, plot=TRUE, ...)
+data=NULL, trans=I, scale=c("linear","response"), xtrans,  alpha=.05,
+nn=101, cond=list(), jitter=FALSE, collapse=FALSE, plot=TRUE, ...)
 }
 \arguments{
 
@@ -62,6 +62,13 @@ cond=list(), jitter=FALSE, collapse=FALSE, plot=TRUE, ...)
     For more details, see references.
   }
 
+  \item{data}{
+    The data frame used to fit the model.  Typically, visreg() can
+    figure out where the data is, so it is not necessary to provide
+    this.  In some cases, however, the data set cannot be located and
+    must be supplied explicitly.
+  }
+
   \item{trans}{
     (Optional) A function specifying a transformation for the vertical
     axis.

man/visreg2d.Rd

@@ -6,8 +6,9 @@ A function used to visualize how two variables interact to affect the
 response in regression models.
 }
 \usage{
-visreg2d(fit, xvar, yvar, type=c("conditional", "contrast"), trans=I,
-scale=c("linear", "response"), nn=99, cond=list(), plot=TRUE, ...)
+visreg2d(fit, xvar, yvar, type=c("conditional", "contrast"), data=NULL,
+trans=I, scale=c("linear", "response"), nn=99, cond=list(), plot=TRUE,
+...)
 }
 \arguments{
   \item{fit}{
@@ -38,6 +39,12 @@ scale=c("linear", "response"), nn=99, cond=list(), plot=TRUE, ...)
     }
     For more details, see references.
   }
+  \item{data}{
+    The data frame used to fit the model.  Typically, visreg() can
+    figure out where the data is, so it is not necessary to provide
+    this.  In some cases, however, the data set cannot be located and
+    must be supplied explicitly.
+  }
   \item{trans}{
     (Optional) A function specifying a transformation for the vertical
     axis.