Skip to content
Please note that GitHub no longer supports your web browser.

We recommend upgrading to the latest Google Chrome or Firefox.

Learn more
Permalink
Browse files

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

  • Loading branch information
leeper committed Aug 1, 2018
1 parent 0a406a9 commit c1ed68d269c85f4304d94074a4950ccfbd65c35c
Showing with 81 additions and 50 deletions.
  1. +2 −0 NAMESPACE
  2. +1 −1 NEWS.md
  3. +5 −1 R/calculate_surface.R
  4. +6 −6 R/cplot.R
  5. +41 −34 R/cplot_utilities.R
  6. +24 −7 man/cplot.Rd
  7. +2 −1 man/persp.Rd
@@ -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)
@@ -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

@@ -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)
@@ -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,
@@ -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

Some generated files are not rendered by default. Learn more.

Some generated files are not rendered by default. Learn more.

0 comments on commit c1ed68d

Please sign in to comment.
You can’t perform that action at this time.