R/plot_biplot.R

In leandroroser/RNASeqFunctions: Several functions for rna-seq analysis

#' Biplot representation of a pca analysis
#' @param x result of do_PCA
#' @param ax1 axis 1 to plot
#' @param ax2 axis 2 to plot
#' @export

plot_biplot <- function(x, ax1 = 1, ax2 = 2, scale_arrow = 0.2,
                        length_tip = 0.05, lwd = 0.5,
                        point_col = "#FF9999", arr_col = "#066500",
                        label_col = "#69CD80", font_col = "white",
                        arr_size = 0.2, point_pch = 16,
                        point_alpha = 0.4,
                        point_size = 3,
                        segment.color = '#69CD80',
                        input = c("do_PCA", "dudi.pca"),
                        label_alpha = 0.9,
                        draw_centroids = FALSE,
                        line_centroid_alpha = 0.4,
                        ...) {

  input <- match.arg(input)
  if(input == "dudi.pca") {
    input <- list()
    input$pc <- x$li
    input$rotation <- x$co
    colnames(input$rotation) <- rownames(x$co)
    input$var <- 100 * x$eig/sum(x$eig)
    x <- input
  }




  x_label <- paste0("PC", ax1, " (", round(x$var[ax1], 1), "% variance)")
  y_label <- paste0("PC", ax2, " (", round(x$var[ax2], 1), "% variance)")
  pc <- data.frame(x$pc)
  arr <- data.frame(x$rotation)
  origin <- apply(x$pc, 2, mean)
  nind <- nrow(pc)
  nvar <- ncol(pc)
  label <- scale_arrow * data.frame(x = arr[, ax1] , y =  arr[, ax2])

  label <- data.frame(label, domain = factor(label_col))
  left_lab <- label[label[, 1] < 0 , ]
  left_lab_names <- colnames(arr)[label[, 1] < 0]
  right_lab <- label[label[, 1] >= 0 , ]
  right_lab_names <- colnames(arr)[label[, 1] >= 0]


  out <- ggplot2::ggplot()
  
  if(!draw_centroids) {
  out <- out + ggplot2::geom_point(ggplot2::aes(pc[, ax1], pc[, ax2]),
                      col = point_col, alpha = point_alpha,
                      pch = point_pch, size = point_size) 
  } else {


    
    centroids <- aggregate(pc[,c(ax1, ax2)], list(point_col), mean)
    centroids2 <- centroids[match(point_col, centroids$Group.1), ]
    input <- cbind(pc[, c(ax1, ax2)], centroids2[, 2:3])
    colnames(input)[3:4] <- c("x.mean", "y.mean")
   
    
  out <- out +  ggplot2::geom_point(ggplot2::aes(pc[, ax1], pc[, ax2]), 
                                    col = factor(point_col), alpha = point_alpha,
                                    pch = point_pch, size = point_size, show.legend = FALSE) +
      geom_segment(data = input,  aes(x=x.mean, y=y.mean, xend= input[, 1],
                                      yend= input[, 2]), col = factor(point_col), 
                                     alpha = line_centroid_alpha,
                   show.legend = FALSE) 
    #ggplot2::stat_ellipse(ggplot2::aes(pc[, ax1], pc[, ax2, 
    #                      col = factor(point_col)),
    #                      show.legend = FALSE) 
      #+geom_point(data=centroids, aes(centroids[, 2],centroids[, 3]))
  }
  
  out + ggplot2::geom_segment(ggplot2::aes(x = rep(origin[ax1], nvar),
         y = rep(origin[ax2], nvar),
         xend = scale_arrow*arr[, ax1],
         yend = scale_arrow*arr[, ax2]),
         col = arr_col,
         arrow = ggplot2::arrow(length = ggplot2::unit(arr_size, "cm"))) +
  ggrepel::geom_label_repel(ggplot2::aes(x = right_lab[, 1] ,
                          y = right_lab[, 2],
                          label = right_lab_names,
                          fill = right_lab[, 3]),
                          segment.color = segment.color,
                          fontface = 'bold', color = font_col,
                          box.padding = 0.35, point.padding = 0.5,
                          alpha = label_alpha) +
  ggrepel::geom_label_repel(ggplot2::aes(x = left_lab[, 1] ,
                                    y = left_lab[, 2],
                                    label = left_lab_names,
                                    fill = left_lab[, 3]),
                                    segment.color = segment.color,
                            fontface = 'bold', color = font_col,
                            box.padding = 0.35, point.padding = 0.5,
                            alpha = label_alpha) +
  ggplot2::labs(x = x_label, y = y_label, fill = "Domain") +
  ggplot2::theme_bw(base_size = 16)
}