finish cplot.default() method (closes #84)

leeper · Aug 1, 2018 · c1ed68d269c85f4304d94074a4950ccfbd65c35c · c1ed68d
1 parent 0a406a9
commit c1ed68d269c85f4304d94074a4950ccfbd65c35c
Unified Split

Showing with 81 additions and 50 deletions.

+2 −0 NAMESPACE

+1 −1 NEWS.md

+5 −1 R/calculate_surface.R

+6 −6 R/cplot.R

+41 −34 R/cplot_utilities.R

+24 −7 man/cplot.Rd

+2 −1 man/persp.Rd
diff --git a/NAMESPACE b/NAMESPACE
@@ -2,6 +2,7 @@
 
 S3method(confint,margins)
 S3method(cplot,clm)
+S3method(cplot,default)
 S3method(cplot,glm)
 S3method(cplot,lm)
 S3method(cplot,loess)
@@ -76,4 +77,5 @@ importFrom(prediction,mean_or_mode)
 importFrom(prediction,prediction)
 importFrom(prediction,seq_range)
 importFrom(stats,stepfun)
+importFrom(utils,capture.output)
 importFrom(utils,head)
diff --git a/NEWS.md b/NEWS.md
@@ -1,6 +1,6 @@
 # margins 0.3.25
 
-* Setup a `cplot.default()` method and modified documentation of `cplot()`, `image()`, and `persp()` methods slightly.
+* Setup a `cplot.default()` method and modified documentation of `cplot()`, `image()`, and `persp()` methods slightly. (#84, h/t Luke Sonnet)
 
 # margins 0.3.24
 

diff --git a/R/calculate_surface.R b/R/calculate_surface.R
@@ -9,14 +9,18 @@ calculate_surface <- function(x, xvar, yvar, dx, nx, ny, type, vcov = stats::vco
     yvals <- seq_range(dat[[yvar]], ny)
 
     if (what == "prediction") {
-        datmeans <- structure(lapply(lapply(dat[, !names(dat) %in% c(xvar, yvar), drop = FALSE], mean_or_mode), rep, length(xvals) * length(yvals)),
+        # mean predictions
+        datmeans <- structure(lapply(lapply(dat[, !names(dat) %in% c(xvar, yvar), drop = FALSE],
+                                            prediction::mean_or_mode),
+                                     rep, length(xvals) * length(yvals)),
                               class = "data.frame", row.names = seq_len(length(xvals) * length(yvals)))
         outcome <- outer(xvals, yvals, FUN = function(a, b) {
             datmeans[, xvar] <- a
             datmeans[, yvar] <- b
             prediction(model = x, data = datmeans, type = type)[["fitted"]]
         })
     } else if (what == "effect") {
+        # average marginal effects
         mar <- summary(margins(x, at = setNames(list(xvals, yvals), c(xvar, yvar)), vce = "none", type = type))
         vals <- mar[mar[["factor"]] == dx, "AME"]
         outcome <- matrix(NA_real_, nrow = nx, ncol = ny)

diff --git a/R/cplot.R b/R/cplot.R
@@ -202,15 +202,15 @@ function(object,
     type <- match.arg(type)
     a <- (1 - level)/2
     fac <- qnorm(c(a, 1 - a))
-
+    
     # setup `outdat` data
     if (what == "prediction") {
         # generates predictions as mean/mode of all variables rather than average prediction!
-        tmpdat <- lapply(dat[, names(dat) != xvar, drop = FALSE], mean_or_mode)
+        tmpdat <- lapply(dat[, names(dat) != xvar, drop = FALSE], prediction::mean_or_mode)
         tmpdat <- structure(lapply(tmpdat, rep, length.out = length(xvals)),
                             class = "data.frame", row.names = seq_len(length(xvals)))
         tmpdat[[xvar]] <- xvals
-        outdat <- prediction(model = object, data = tmpdat, at = stats::setNames(list(xvals), xvar), type = type, level = level)
+        outdat <- prediction(model = object, data = tmpdat, type = type, level = level)
         out <- structure(list(xvals = xvals,
                               yvals = outdat[["fitted"]],
                               upper = outdat[["fitted"]] + (fac[2] * outdat[["se.fitted"]]),
@@ -234,9 +234,9 @@ function(object,
                     scatter = scatter, scatter.pch = scatter.pch, scatter.col = scatter.col, ...)
     }
     if (isTRUE(draw) || draw == "add") {
-        draw_one(xvals = out[["xvals"]], 
-                 yvals = out[["yvals"]], 
-                 upper = out[["upper"]], 
+        draw_one(xvals = out[["xvals"]],
+                 yvals = out[["yvals"]],
+                 upper = out[["upper"]],
                  lower = out[["lower"]],
                  x_is_factor = x_is_factor,
                  col = col, lty = lty, lwd = lwd,

diff --git a/R/cplot_utilities.R b/R/cplot_utilities.R
@@ -18,23 +18,25 @@ check_factors <- function(object, data, xvar, dx) {
 
 # function to setup plot
 setup_cplot <- 
-function(plotdat,
-         data,
-         xvals,
-         xvar,
-         yvar, 
-         xlim, ylim, 
-         x_is_factor,
-         y_is_factor = FALSE,
-         xlab,
-         ylab,
-         xaxs,
-         yaxs,
-         las,
-         scatter,
-         scatter.pch,
-         scatter.col,
-         ...) {
+function(
+  plotdat,
+  data,
+  xvar,
+  yvar,
+  xlim,
+  ylim,
+  x_is_factor,
+  y_is_factor = FALSE,
+  xlab,
+  ylab,
+  xaxs,
+  yaxs,
+  las,
+  scatter,
+  scatter.pch,
+  scatter.col,
+  ...
+) {
     if (is.null(xlim)) {
         if (isTRUE(x_is_factor)) {
             xlim <- c(0.75, nrow(plotdat) + 0.25)
@@ -77,23 +79,28 @@ function(plotdat,
 }
 
 # function to draw one set of lines
-draw_one <- 
-function(xvals, yvals, upper, lower, 
-         x_is_factor,
-         y_is_factor = FALSE,
-         col,
-         lty,
-         lwd,
-         se.type,
-         factor.lty = 0L,
-         factor.pch, 
-         factor.fill, 
-         factor.col, 
-         factor.cex,
-         se.lwd,
-         se.fill,
-         se.col,
-         se.lty) {
+draw_one <-
+function(
+  xvals,
+  yvals,
+  upper,
+  lower,
+  x_is_factor,
+  y_is_factor = FALSE,
+  col,
+  lty,
+  lwd,
+  se.type,
+  factor.lty = 0L,
+  factor.pch, 
+  factor.fill, 
+  factor.col, 
+  factor.cex,
+  se.lwd,
+  se.fill,
+  se.col,
+  se.lty
+) {
     if (isTRUE(x_is_factor)) {
         xvals <- seq_along(xvals)
         # uncertainty

diff --git a/man/cplot.Rd b/man/cplot.Rd
diff --git a/man/persp.Rd b/man/persp.Rd