inst/doc/uni-vs-multi.R

In mvinfluence: Influence Measures and Diagnostic Plots for Multivariate Linear Models

## ----setup, include = FALSE---------------------------------------------------
knitr::opts_chunk$set(
  collapse = TRUE,
  message = FALSE,
  warning = FALSE,
  comment = "#>",
  fig.width =  7,
  fig.height = 6
)

options(digits = 4)

## ----packages-----------------------------------------------------------------
library(tibble)      # Simple Data Frames
library(ggplot2)     # Create Elegant Data Visualisations Using the Grammar of Graphics
library(car)         # Companion to Applied Regression
library(mvinfluence) # Influence Measures and Diagnostic Plots for Multivariate Linear Models
library(patchwork)   # The Composer of Plots
library(rgl)         # 3D Visualization Using OpenGL
rgl::setupKnitr(autoprint = TRUE)

## ----toy-data-----------------------------------------------------------------
Toy <- tibble(
   case = 1:9,
   x =  c(1,    1,    2,    2,    3,    3,    4,    4,    10),
   y1 = c(0.10, 1.90, 1.00, 2.95, 2.10, 4.00, 2.95, 4.95, 10.00),
   y2 = c(0.10, 1.80, 1.00, 2.93, 2.00, 4.10, 3.05, 4.93, 10.00)
)

## ----scatmat------------------------------------------------------------------
car::scatterplotMatrix(~y1 + y2 + x, data=Toy, cex=2,
        col = "blue", pch = 16,
        id = list(n=1, cex=2), 
        regLine = list(lwd = 2, col="red"),
        smooth = FALSE)

## -----------------------------------------------------------------------------
car::scatter3d(y1 ~ y2 + x, data=Toy,
               ellipsoid = TRUE,              # show the data ellipsoid
               radius = c(rep(1,8), 2),       # make case 9 larger
               grid.col = "pink", grid.lines = 10, 
               fill = FALSE,
               id = list(n=1), offset=2
               )
rgl::rglwidget()

## ----models-------------------------------------------------------------------
Toy.lm1 <- lm(y1 ~ x, data=Toy)
Toy.lm2 <- lm(y2 ~ x, data=Toy)
Toy.mlm <- lm(cbind(y1, y2) ~ x, data=Toy)

## ----coefs--------------------------------------------------------------------
coef(Toy.lm1)
coef(Toy.lm2)
coef(Toy.mlm)

## ----anovas-------------------------------------------------------------------
car::Anova(Toy.lm1)
car::Anova(Toy.lm2)
car::Anova(Toy.mlm)

## ----cooks-distance-----------------------------------------------------------
df <- Toy
df$D1  <- cooks.distance(Toy.lm1)
df$D2  <- cooks.distance(Toy.lm2)
df$D12 <- cooks.distance(Toy.mlm)

df

## ----inflplots, fig.show='hold', out.width="45%", out.height="50%", collapse=FALSE----
ip1 <- car::influencePlot(Toy.lm1, id=list(cex=1.5))
ip2 <- car::influencePlot(Toy.lm2, id=list(cex=1.5))

## ----inflplot-mlm, fig.width=5, fig.height=4, fig.align='center'--------------
par(mar = c(4,4,1,1)+.1)
influencePlot(Toy.mlm, id.n=2)

## ----inflplot-mlm-lr, fig.width=5, fig.height=4, fig.align='center', results='hide'----
par(mar = c(4,4,1,1)+.1)
influencePlot(Toy.mlm, id.n=2, type = 'LR')

## ----dfbetas-plot, fig.width=9, fig.height=4.5--------------------------------
db1 <- as.data.frame(dfbetas(Toy.lm1))
gg1 <- ggplot(data = db1, aes(x=`(Intercept)`, y=x, label=rownames(db1))) +
  geom_point(size=1.5) +
  geom_label(size=6, fill="pink") +
  xlab(expression(paste("Deletion Intercept  ", b[0]))) +
  ylab(expression(paste("Deletion Slope  ", b[1]))) +
  ggtitle("dfbetas for y1") +
  theme_bw(base_size = 16)

db2 <- as.data.frame(dfbetas(Toy.lm2))
gg2 <- ggplot(data = db2, aes(x=`(Intercept)`, y=x, label=rownames(db2))) +
  geom_point(size=1.5) +
  geom_label(size=6, fill="pink") +
  xlab(expression(paste("Deletion Intercept  ", b[0]))) +
  ylab(expression(paste("Deletion Slope  ", b[1]))) +
  ggtitle("dfbetas for y2") +
  theme_bw(base_size = 16)

gg1 + gg2