In dajmcdon/ubc-stat406-labs: Tutorials and labs for UBC Stat 406 in the 2020-2021 online year

library(knitr)
opts_chunk$set(echo=FALSE, fig.align='center', fig.width=4, fig.height=3,
               cache=TRUE, autodep=TRUE, cache.comments=FALSE,
               message=FALSE, warning=FALSE)

Analysis with the famed "iris" data

This is a very old, and by now canonical data set. It's in base R. Load it with data(iris).

1. Using this data, perform lda, qda, and lasso-logit using only the first 2 variables.

data("iris")
form = formula(Species~Sepal.Length+Sepal.Width)
library(MASS)
lind = lda(form, data=iris)
quadd = qda(form, data=iris)
library(nnet)
logit = multinom(form, data=iris, trace=FALSE)

1. Use the following function to view the discriminant boundaries for each of the methods above.

decisionplot <- function(model, predict_type = "class",
  resolution = 100, showgrid = TRUE, ...) {
  cl = iris[,5]
  k <- length(unique(cl))
  plot(iris[,1:2], col = as.integer(cl)+1L, pch = as.integer(cl)+1L, ...)
  # make grid
  r <- sapply(iris[,1:2], range, na.rm = TRUE)
  xs <- seq(r[1,1], r[2,1], length.out = resolution)
  ys <- seq(r[1,2], r[2,2], length.out = resolution)
  g <- cbind(rep(xs, each=resolution), rep(ys, time = resolution))
  colnames(g) <- colnames(r)
  g <- as.data.frame(g)
  ### guess how to get class labels from predict
  ### (unfortunately not very consistent between models)
  p <- predict(model, g, type = predict_type)
  if(is.list(p)) p <- p$class
  p <- as.factor(p)

  if(showgrid) points(g[[1]],g[[2]], col = as.integer(p)+1L, pch = ".")

  z <- matrix(as.integer(p), nrow = resolution, byrow = TRUE)
  contour(xs, ys, z, add = TRUE, drawlabels = FALSE,
    lwd = 2, levels = (1:(k-1))+.5)
  invisible(z)
}

par(mfrow=c(1,3),mar=c(5,4,0,0),bty='n',las=1,family='serif')
decisionplot(lind)
decisionplot(logit)
decisionplot(quadd)

1. Redo the analysis using all four covariates. Report the classification error of each method with two and four covariates.

form = formula(Species~.)
errs = list()
errs$lda2 = mean(iris[,5] != predict(lind)$class)
errs$qda2 = mean(iris[,5] != predict(quadd)$class)
errs$logit2 = mean(iris[,5] != predict(logit))
lind = lda(form, data=iris)
quadd = qda(form, data=iris)
logit = multinom(form, data=iris, trace=FALSE)
errs$lda4 = mean(iris[,5] != predict(lind)$class)
errs$qda4 = mean(iris[,5] != predict(quadd)$class)
errs$logit4 = mean(iris[,5] != predict(logit))

errs = matrix(unlist(errs),3)
rownames(errs) = c('lda','qda','logit')
colnames(errs) = c('p=2', 'p=4')
knitr::kable(errs, digits = 3)

dajmcdon/ubc-stat406-labs documentation built on Aug. 18, 2020, 1:23 p.m.