R/plo_sup.R

In morepls: Interpretation Tools for Partial Least Squares Regression

plo_sup <- function(object,
                    vars,
                    excl = NULL,
                    comps = c(1,2),
                    shapesize = 2,
                    textsize = 3,
                    vlab = TRUE,
                    force = 1,
                    max.overlaps = Inf,
                    dashes = TRUE) {

  # check factors
  if(any(sapply(vars, FUN = function(x) !is.factor(x)))) stop("variables in data should all be factors")

  # check if only one variable
  if(is.factor(vars)) {
    vars <- data.frame(vars)
    if(!is.null(excl)) excl <- paste0("vars.", excl)
  }

  # recode dashes argument
  if(length(dashes) == 1 & is.logical(dashes)) {
    # if(is.logicaldashes == TRUE | dashes == FALSE)
    dashes <- rep(dashes, length(vars))
  }

  # get coordinates of observations
  indiv <- pls::scores(object)
  class(indiv) <- "matrix"
  indiv <- as.data.frame(indiv)[, comps]
  names(indiv) <- paste0("axis", 1:2)

  # compute mean points of categories
  coord <- list()
  for(i in 1:ncol(vars)) {
    tmp  <- stats::aggregate(indiv, list(vars[[i]]), mean)
    tmp$var <- rep(names(vars)[i], nrow(tmp))
    tmp$dashes <- rep(dashes[i], nrow(tmp))
    coord[[i]] <- tmp
  }
  coord <- do.call("rbind.data.frame", coord)
  names(coord)[1] <- "cat"
  coord$varcat <- paste(coord$var, coord$cat, sep = ".")
  coord$var <- factor(coord$var)

  # vlab option
  if(vlab) {
    coord$labs <- coord$varcat
  } else {
    coord$labs <- coord$cat
  }

  # drop excluded categories
  coord <- coord[!(coord$varcat %in% excl),]

  # plot observations
  p <-
    ggplot2::ggplot(indiv, ggplot2::aes(x = .data$axis1, y = .data$axis2)) +
    ggplot2::geom_point(color = "gray95", size = 1) +
    ggplot2::geom_hline(yintercept = 0, colour = "gray", linetype = "solid", alpha = 0.6) +
    ggplot2::geom_vline(xintercept = 0, colour = "gray", linetype = "solid", alpha = 0.6) +
    ggplot2::xlab(paste("Comp", comps[1])) +
    ggplot2::ylab(paste("Comp", comps[2])) +
    ggplot2::theme_bw() +
    ggplot2::theme(panel.grid.major = ggplot2::element_blank(),
                   panel.grid.minor = ggplot2::element_blank())

  # add labels of categories
  p <- p +
    ggplot2::geom_point(data = coord,
                        ggplot2::aes(x = .data$axis1,
                                     y = .data$axis2,
                                     shape = .data$var,
                                     color = .data$var),
                        size = shapesize) +
    ggrepel::geom_text_repel(data = coord,
                             ggplot2::aes(x = .data$axis1,
                                          y = .data$axis2,
                                          label = .data$labs,
                                          color = .data$var),
                             size = textsize,
                             force = force,
                             max.overlaps = max.overlaps) +
    ggplot2::guides(color = "none",
                    shape = "none")

  ## add dashes
  p <- p +
    ggplot2::geom_path(data = coord[coord$dashes == TRUE,],
                       ggplot2::aes(x = .data$axis1,
                                    y = .data$axis2,
                                    group = .data$var,
                                    color = .data$var),
                       linetype = "dashed",
                       alpha = 0.5)

  return(p)

}

# plo_sup(pls2,
#         vars = pc18[,c("catage","diplome")],
#         excl = "diplome.88",
#         vlab = FALSE,
#         textsize = 5,
#         shapesize = 1,
#         dashes = c(T,F))