R/AggiPlot1200.R

In barupal/AggiePlot:

## Aggieplot 1201 : Volcano plots
## Author : Dinesh Kumar Barupal dinkumar@ucdavis.edu
## Lincense : CC-BY

###################################
## Create a volcano plot ###
###################################

library(magrittr)
library(officer)
library(rvg)


generateAggiePlot.1201 <- function(
  numericData = "data_matrix1201.csv",
  param="param1201.csv"
) {
  ndf <- read.csv(file = numericData, stringsAsFactors = F,header = T)
  prdf <- read.csv(file = param, stringsAsFactors = F,check.names = T)

  ndf$foldchange <-   as.numeric(ndf$foldchange)
  ndf$pvalue <-   as.numeric(ndf$pvalue)
  ndf$padjust <- p.adjust(ndf$pvalue)
  ndf$vlabel <- cdf$Label

  for(i in 1:nrow(prdf)) {
    df2 <- ndf

    pcutoff <- as.numeric(prdf$p_cutoff[i])

    df2$Changed <- "No Change"
    df2$Changed[which(df2$pvalue<pcutoff& df2$foldchange>1)] <- "UP"
    df2$Changed[which(df2$pvalue<pcutoff & df2$foldchange<1)] <- "DOWN"
    df2$Changed <- as.factor(df2$Changed)

    df2$GroupVar <- ndf[[prdf$PointFill[i]]]

    df2 <- df2[order(df2$foldchange),]
    df2$Xorder <- 1:nrow(df2)

    p2 <-   ggplot(df2, aes(x=Xorder, y=-log(pvalue,base = 10),colour = Changed,shape=factor(GroupVar))) +
      geom_point(size=prdf$PointSize[i]) + # 21 is filled circle
      scale_y_continuous("pvalue (-log)") +
      scale_x_continuous("foldchange order") +
      scale_color_manual("FC direction",values=c("blue", "yellow", "red","white")) +
      scale_fill_manual("",values=c("white", "yellow", "red","white")) +
      scale_shape_manual(prdf$PointFill[i],values=c(1,16))+
      theme_bw() +
      labs(title = prdf$ChartTitle[i]) +
      theme(
        plot.title = element_text(face="bold", size=30,hjust = 0.5),
        axis.title.x = element_text(face="bold", size=30),
        axis.title.y = element_text(face="bold", size=30, angle=90),
        panel.grid.major = element_blank(), # switch off major gridlines
        panel.grid.minor = element_blank(), # switch off minor gridlines
        legend.justification=c(1,0),
        legend.position=c(.6,0.8),
        legend.background = element_rect(fill="grey",size=0.5, linetype="solid"),
        legend.box = "horizontal",
        legend.text = element_text(size=20),
        legend.key.size = unit(1.5, "lines"),
        legend.key = element_blank(), # switch off the rectangle around symbols in the legend
        legend.spacing = unit(.05, "cm"),
        legend.title=element_text(size=20),
        axis.text.x = element_blank(),
        axis.text.y = element_text(size=15,angle = 0, hjust = 0.5)
      )+
      guides(shape = guide_legend(override.aes = list(size = 10)),colour = guide_legend(override.aes = list(size = 10)))

    pvalueCut <- prdf$p_cutoff[i]
    fdrCutff <- prdf$fdr_cutoff[i]

    p3 <- p2 + geom_hline(yintercept = -(log(pvalueCut,base = 10)),linetype="dotted" ) +
      geom_vline(xintercept = which(df2$foldchange>1.9999)[1],linetype="dotted") +
      geom_vline(xintercept = tail(which(df2$foldchange < 0.5000001),1),linetype="dotted") +
      annotate("text", tail(which(df2$foldchange < 0.5000001),1), -Inf, vjust = 0, label = "2X", size=10) +
      annotate("text", which(df2$foldchange>1.9999)[1], -Inf, vjust = 0, label = "2X", size=10) +
      geom_label_repel(aes(label = vlabel), color = "gray20", family = "Arial", data = subset(df2,padjust< fdrCutff), force = 5) +
      annotate("text", nrow(df2)/2, -(log(pvalueCut,base = 10)), vjust = 0, label = paste0("pvalue ",pvalueCut), size=10) +
      geom_hline(yintercept = -(log(max(df2$pvalue[which(df2$padjust<fdrCutff)]),base = 10)) ,linetype="dotted") +
      annotate("text", nrow(df2)/2, -(log(max(df2$pvalue[which(df2$padjust<fdrCutff)]),base = 10)), vjust = 0, label = paste0("FDR ",fdrCutff), size=10)
    plot(p3)

    read_pptx("./data/aggieplot_001.pptx") %>% add_slide(layout = "AggiePlot", master = "Office Theme") %>%
      ph_with_vg_at(code = print(p3), width = 15,height = 10, left = .3, top = .3) %>%
      print(target = paste0(prdf$PlotName[i],".pptx")) %>%
      invisible()
  }
}