R/LDAPlot.R

In eead-csic-eesa/fingerPro: Sediment Source Fingerprinting

#' Linear discriminat analysis chart
#'
#' The function performs a linear discriminant analysis and displays the data in the relevant dimensions.
#'
#' @param data Data frame containing source and mixtures data
#' @param P3D Boolean to switch between 2 to 3 dimensional chart
#' @param text Boolean to show or not the identification number of each sample point in the plot
#' 
#' @export
#' 
LDAPlot <- function(data, P3D = FALSE, text = FALSE) {
  # reorder factor levels in order of appearance
  data[, 2] <- factor(data[, 2], levels = unique(data[, 2]))

  # read groups (second column)
  groups <- data[, 2]

  # asume last group is mixtures
  mixture <- levels(groups)[nlevels(groups)]

  # read sources
  sources <- data[!groups == mixture, ]

  # remove mixture level
  s_groups <- droplevels(sources[, 2])

  # extract properties
  data.lda1 <- sources[3:ncol(sources)]
  # assign groups
  data.lda1$groups <- as.factor(s_groups)
  data.lda <- lda(groups ~ ., data = data.lda1) 
  data.lda.pred <- predict(data.lda) 
  data.lda.temp <- data.frame(data.lda.pred$x, Sources = data.lda1$groups)

  if (P3D == TRUE) {
    plot <- with(data.lda.temp, scatter3d(LD1, LD2, LD3, revolution = 1, col = group_number, 
      point.col = group_number, speed = 3, groups = Sources, bg.col = "white", 
      model.summary = T, surface.alpha = 0.2, ellipsoid = TRUE, ellipsoid.alpha = 0.3, 
      level = 0.8))  ####defined the 3D LDA
  } else {
    if (text == TRUE) {
    data.lda.temp$row_num = 1:nrow(data.lda.temp)
    plot <- ggplot(data.lda.temp, aes(LD1, LD2, colour = Sources)) +
      geom_point(aes(shape = Sources), size = 3) + geom_text(aes(label = row_num, hjust = 2, vjust = 0.5), size=4) + geom_hline(yintercept = 0,
      colour = "black", linetype = "longdash") + geom_vline(xintercept = 0,
      colour = "black", linetype = "longdash") + stat_ellipse(type = "t",
      size = 1, geom = "polygon", alpha = 0.2, aes(fill = Sources),
      level = 0.9) + stat_ellipse(type = "t", size = 1, aes(colour = Sources),
      level = 0.9) + ggtitle("LDA") + theme(plot.title = element_text(hjust = 0.5))

      } else {
    plot <- ggplot(data.lda.temp, aes(LD1, LD2, colour = Sources)) + 
      geom_point(aes(shape = Sources), size = 3) + 
      geom_hline(yintercept = 0,colour = "black", linetype = "longdash") + 
      geom_vline(xintercept = 0, colour = "black", linetype = "longdash") + stat_ellipse(type = "t", 
       size = 1, geom = "polygon", alpha = 0.2, aes(fill = Sources),
       level = 0.9) + stat_ellipse(type = "t", size = 1, aes(colour = Sources),
       level = 0.9) + ggtitle("LDA") + theme(plot.title = element_text(hjust = 0.5))
      }
  }

  {
    print(plot)
  }
}