Notes

This is just a test suite for functionality of partial.plot(). But this may help you to understand what current partial.plot() can draw and how to control its behavior.

Test controlling graphic elements in 2D plot

Testing 2D plot without interaction terms

model <- glm(Petal.Length ~ Sepal.Length + Petal.Width, data = iris)
info <- partial.plot(model, "Sepal.Length", pch = 16)
pp.legend(info, "topleft")

Prepare test model

model <- glm(
    Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris
)

Testing 2D plot with an interaction term

info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16)
pp.legend(info, "topleft")

Type of prediction

# Test using iris.
model <- glm(Petal.Length ~ Sepal.Length + Petal.Width, data = iris)
info <- partial.plot(model, "Sepal.Length", pch = 16)

model <- glm(
    Petal.Length ~ Sepal.Length + Petal.Width, data = iris,
    family = Gamma(log)
)
info <- partial.plot(model, "Sepal.Length", pch = 16, type = "response")

info <- partial.plot(model, "Sepal.Length", pch = 16, type = "link")

# Test using ChickWeight
model <- glm(
    weight ~ Time * Diet, family = Gamma, data = as.data.frame(ChickWeight)
)
info <- partial.plot(model, c("Time", "Diet"), pch = 16, type = "response")
points(ChickWeight$Time, ChickWeight$weight, col = "black", pch = 16)

info <- partial.plot(model, c("Time", "Diet"), pch = 16, type = "link")

# Test from glmmML example.
id <- factor(rep(1:20, rep(5, 20)))
y <- rbinom(100, prob = rep(runif(20), rep(5, 20)), size = 1)
x <- rnorm(100)
dat <- data.frame(y = y, x = x, id = id)
model <- glm(y ~ x + id, data = dat, family = binomial)
partial.plot(model, c("x", "id"))

## Warning in .Object$initialize(...): Currently, partial residual can't be
## calculated for logit link function.

# Test probability
library(randomForest)
model <- randomForest(Species ~ ., data = iris)
partial.plot(
    model, "Petal.Length", positive.class = "setosa", type = "prob",
    col = "red", resolution = 20, draw.residual = FALSE
)
partial.plot(
    model, "Petal.Length", positive.class = "versicolor", add = TRUE,
    type = "prob", col = "blue", resolution = 20, draw.residual = FALSE
)
partial.plot(
    model, "Petal.Length", positive.class = "virginica", add = TRUE,
    type = "prob", col = "green", resolution = 20, draw.residual = FALSE
)

Hide points

model <- glm(
    Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), draw.residual = FALSE
)
pp.legend(info, "topleft")

Hide interval

info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, draw.interval = FALSE
)
pp.legend(info, "topleft")

Hide lines

info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, draw.relationship = FALSE
)
pp.legend(info, "topleft")

Draw histogram

info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, draw.hist = TRUE
)
pp.legend(info, "topleft")

Draw extrapolation

info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, extrapolate = TRUE
)
pp.legend(info, "topleft")

Set labels

info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    xlab = "X Label", ylab = "Y Label"
)
pp.legend(info, "topleft")

Change colors

par(mfrow = c(2, 2))
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "col = 'black'", col = "black"
)
pp.legend(info, "topleft", cex = 0.7)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "col = viridis", col = viridis
)
pp.legend(info, "topleft", cex = 0.7)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "col = c('red', 'blue', 'cyan')", col = c("red", "blue", "cyan")
)
pp.legend(info, "topleft", cex = 0.7)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "col = c(versicolor='blue', \nsetosa='red', virginica='cyan')",
    col = c(versicolor = "blue", setosa = "red", virginica = "cyan")
)
pp.legend(info, "topleft", cex = 0.7)

par(mfrow = c(1, 1))

Change line width

info <- partial.plot(
    model, c("Sepal.Length", "Species"), lwd = c(1, 4, 8),
    main = "col = 'black'", col = "black"
)
pp.legend(info, "topleft")

Change line type

info <- partial.plot(
    model, c("Sepal.Length", "Species"), lty = c("solid", "dashed", "dotted"),
    main = "col = 'black'", col = "black", lwd = 2
)
pp.legend(info, "topleft")

Change plot character

info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16:18,
    main = "col = 'black'", col = "black", lwd = 2
)
pp.legend(info, "topleft")

Change intervals

par(mfrow = c(2, 2))
partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "interval = 0.95 (Default)"
)
partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "interval = 0.8", interval.levels = 0.8
)
partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "interval = 0.7", interval.levels = 0.7
)
partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16,
    main = "interval = 0.6", interval.levels = 0.6
)

par(mfrow = c(1, 1))

Reuse information

par(mfrow = c(2, 2))

info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1
)
pp.legend(info, "topleft", cex = 0.5)

info <- partial.plot(info, pch = 6, draw.relationship = FALSE)
pp.legend(info, "topleft", cex = 0.5)

info <- partial.plot(info, col = rainbow, draw.interval = FALSE)
pp.legend(info, "topleft", cex = 0.5)

info <- partial.plot(info, col = heat.colors, draw.residual = FALSE)
pp.legend(info, "topleft", cex = 0.5)

par(mfrow = c(1, 1))

Use function with package name

model <- stats::glm(
    Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris
)
info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16)
pp.legend(info, "topleft")

Test controlling graphic elements in 3D plot

Test persp()

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), col = viridis, fun.3d = persp
)

Test image()

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), col = viridis, pch = 16,
    fun.3d = image
)

Test contour()

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), fun.3d = contour
)

Test persp3d()

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), col = viridis,
    fun.3d = persp3d
)

You must enable Javascript to view this page properly.

Test persp() with changing labels

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), col = viridis,
    fun.3d = persp, xlab = "X label", ylab = "Y label", zlab = "Z label"
)

Test persp3d() with changing labels

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), col = viridis,
    fun.3d = persp3d, xlab = "X label", ylab = "Y label", zlab = "Z label"
)

You must enable Javascript to view this page properly.

Test for functions

Test cforest()

library(party)
# 2D plot.
model <- cforest(
    Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris,
    controls = cforest_unbiased(ntree = 10, mtry = 2)
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 2
)
pp.legend(info, "topleft")

# 3D plot.
model <- cforest(
    Petal.Length ~ Sepal.Length + Petal.Width, data = iris,
    controls = cforest_unbiased(ntree = 10, mtry = 2)
)
info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, n.cores = 2,
    fun.3d = persp, col = viridis, theta = 40
)

Test ctree()

library(party)
# 2D plot.
model <- ctree(
    Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris,
    controls = ctree_control(mtry = 2)
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 2
)
pp.legend(info, "topleft")

# 3D plot.
model <- ctree(
    Petal.Length ~ Sepal.Length + Petal.Width, data = iris,
    controls = ctree_control(mtry = 2)
)
info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, n.cores = 2,
    fun.3d = persp, col = viridis, theta = 40
)

Test gam::gam()

Waiting for the support of model.adapter.

#library(gam)
#model <- gam(
    #Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris
#)
#info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1)
#pp.legend(info, "topleft")
#info <- partial.plot(
    #model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    #fun.3d = persp
#)

Test mgcv::gam()

Waiting for the support of model.adapter.

#library(mgcv)
#model <- gam(
    #Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris
#)
#info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16)
#pp.legend(info, "topleft")
#info <- partial.plot(
    #model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    #fun.3d = persp
#)

Test mgcv::gamm()

Waiting for the support of model.adapter.

#library(mgcv)
#model <- gamm(
    #Petal.Length ~ Sepal.Length * Species + s(Petal.Width), data = iris
#)
#info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16)
#pp.legend(info, "topleft")
#info <- partial.plot(
    #model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    #fun.3d = persp
#)

Test gbm()

Need some tricks to control n.tree of predict method…

#library(gbm)
#model <- gbm(
    #Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris,
    #n.trees = 100
#)
#info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1)
#pp.legend(info, "topleft")
#info <- partial.plot(
    #model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    #fun.3d = persp, n.cores = 1
#)

Test glm.nb()

library(MASS)
data(quine)
temp <- quine
temp$Age <- as.numeric(temp$Age)
model <- glm.nb(Days ~ Sex * Age, data = temp)
partial.plot(model, c("Age", "Sex"))

Test glmer()

library(lme4)

##  要求されたパッケージ Matrix をロード中です

## 
##  次のパッケージを付け加えます: 'lme4'

##  以下のオブジェクトは 'package:modeltools' からマスクされています: 
## 
##      refit

# Prepare Data
iris2 <- iris
iris2$random <- factor(rep(c("a", "b", "c"), 50))
iris2$Seeds <- rpois(150, iris2$Petal.Length*3 + as.numeric(iris2$Species))

# Run test.
model <- glmer(
    Seeds ~ (Petal.Length + Petal.Width) + Species + (1 | random),
    data = iris2, family = poisson
)
info <- partial.plot(model, c("Petal.Length", "Species"), pch = 16)

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Petal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp
)

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

Test glmer.nb()

library(lme4)
data(quine)
temp <- quine
temp$Age <- as.numeric(temp$Age)
model <- glmer.nb(Days ~ Sex * Age + (1 | Eth), data = temp)
partial.plot(model, c("Age", "Sex"))

## Warning in Ops.factor(1, Eth): '|' は因子に対しては無意味です

## Warning in Ops.factor(1, Eth): '|' は因子に対しては無意味です

Test glmmadmb()

library(glmmADMB)
model <- glmmadmb(
    Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris,
    family = "gaussian"
)
# 2D plot
info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16)
pp.legend(info, "topleft")

# 3D plot
info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp
)

Test glmmML()

library(party)
library(glmmML)
library(viridis)
model <- glmmML(
    age ~ (shoeSize + score) * nativeSpeaker, cluster = 1:200,
    data = readingSkills, family = poisson
)
# 2D plot.
info <- partial.plot(model, c("score", "nativeSpeaker"), pch = 16)

info <- partial.plot(model, c("score", "nativeSpeaker"), pch = 16, type = "link")
pp.legend(info, "topleft")

# 3D plot.
info <- partial.plot(
    model, c("shoeSize", "score"), pch = 16, col = viridis,
    fun.3d = persp
)

Test lm()

model <- lm(
    Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris
)
info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16)
pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp
)

Test lme()

library(nlme)
# 2D plot.
model <- lme(
    MEANSES ~ (DISCLIM + PRACAD) * Sector, random = ~ 1 | School,
    data =  MathAchSchool
)
info <- partial.plot(model, c("DISCLIM", "Sector"), pch = 16)
pp.legend(info, "topleft")

# 3D plot.
model <- lme(
    MEANSES ~ DISCLIM + PRACAD, random = ~ 1 | School,
    data = MathAchSchool
)
info <- partial.plot(
    model, c("DISCLIM", "PRACAD"), col = viridis, fun.3d = persp
)

Test lmer()

Waiting for the support of model.adapter.

library(lme4)
iris2 <- iris
iris2$random <- factor(rep(c("a", "b", "c"), 50))
model <- lmer(
    Petal.Length ~ (Sepal.Length + Petal.Width) * Species + (1 | random),
    data = iris2, REML = FALSE, na.action = na.fail
)
info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16)

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

##  要求されたパッケージ pbkrtest をロード中です

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp
)

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

## Warning in Ops.factor(1, random): '|' は因子に対しては無意味です

Test MCMCglmm()

library(MCMCglmm)
model <- MCMCglmm(
    Petal.Length ~ (Sepal.Length + Petal.Width) * Species, data = iris,
    verbose = FALSE
)
# 2D plot
info <- partial.plot(model, c("Sepal.Length", "Species"), pch = 16, data = iris)
pp.legend(info, "topleft")

# 3D plot
info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp, data = iris
)

Test randomForest()

Currently, cluster is not supported.

library(randomForest)
model <- randomForest(
    Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris,
    ntree = 100
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1
)
pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp, n.cores = 1
)

Test ranger()

Waiting for the support of model.adapter.

library(ranger)

## 
##  次のパッケージを付け加えます: 'ranger'

##  以下のオブジェクトは 'package:randomForest' からマスクされています: 
## 
##      importance

model <- ranger(
    Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris,
    write.forest = TRUE
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1
)
pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp, n.cores = 1
)

Test rpart()

library(rpart)
model <- rpart(
    Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1
)
pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp, n.cores = 1
)

Test svm()

library(e1071)
model <- svm(
    Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1
)
pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp, n.cores = 1
)

Test tree()

library(tree)
model <- tree(
    Petal.Length ~ Sepal.Length + Petal.Width + Species, data = iris
)
info <- partial.plot(
    model, c("Sepal.Length", "Species"), pch = 16, n.cores = 1
)
pp.legend(info, "topleft")

info <- partial.plot(
    model, c("Sepal.Length", "Petal.Width"), pch = 16, col = viridis,
    fun.3d = persp, n.cores = 1
)

Test of partial.plot() for models.

Michio Oguro

2018-11-09

Notes

Test controlling graphic elements in 2D plot

Testing 2D plot without interaction terms

Prepare test model

Testing 2D plot with an interaction term

Type of prediction

Hide points

Hide interval

Hide lines

Draw histogram

Draw extrapolation

Set labels

Change colors

Change line width

Change line type

Change plot character

Change intervals

Reuse information

Use function with package name

Test controlling graphic elements in 3D plot

Test persp()

Test image()

Test contour()

Test persp3d()

Test persp() with changing labels

Test persp3d() with changing labels

Test for functions

Test cforest()

Test ctree()

Test gam::gam()

Test mgcv::gam()

Test mgcv::gamm()

Test gbm()

Test glm.nb()

Test glmer()

Test glmer.nb()

Test glmmadmb()

Test glmmML()

Test lm()

Test lme()

Test lmer()

Test MCMCglmm()

Test randomForest()

Test ranger()

Test rpart()

Test svm()

Test tree()