From 422f4fa15f287fc7a53884c5193e3377c6e11c25 Mon Sep 17 00:00:00 2001
From: Brandi Cantarel <brandi.cantarel@utsouthwestern.edu>
Date: Fri, 1 Feb 2019 13:25:19 -0600
Subject: [PATCH] update shiny code, process scripts
---
astrocyte_pkg.yml | 9 +-
vizapp/load_libs.R | 4 +-
vizapp/server.R | 4 +-
vizapp/tools/dea.R | 356 +++++++--------------------------
vizapp/tools/gc.R | 228 +++------------------
vizapp/tools/gc_ui.R | 14 +-
workflow/process_scripts | 2 +-
workflow/scripts/concat_cts.pl | 2 +-
8 files changed, 121 insertions(+), 498 deletions(-)
diff --git a/astrocyte_pkg.yml b/astrocyte_pkg.yml
index 55e96a4..f74af09 100644
--- a/astrocyte_pkg.yml
+++ b/astrocyte_pkg.yml
@@ -188,19 +188,26 @@ workflow_parameters:
# The workflow must publish all final output into $baseDir
# Name of the R module that the vizapp will run against
-vizapp_r_module: 'R/3.2.1-intel'
+vizapp_r_module: 'R/3.4.1-gccmkl'
# List of any CRAN packages, not provided by the modules, that must be made
# available to the vizapp
vizapp_cran_packages:
- sqldf
+ - crosstalk
+ - htmltools
+ - htmlwidgets
+ - httpuv
- shiny
- Vennerable
- DT
+ - grid
+ - gridExtra
- ggplot2
- gplots
- gtools
- RColorBrewer
+ - tidyverse
# # List of any Bioconductor packages, not provided by the modules, that must be made
diff --git a/vizapp/load_libs.R b/vizapp/load_libs.R
index 268ae9d..6b745d8 100644
--- a/vizapp/load_libs.R
+++ b/vizapp/load_libs.R
@@ -1,10 +1,10 @@
options("repos"="http://cran.rstudio.com/")
update.packages()
-install.packages("sqldf",dep=TRUE)
+#install.packages("sqldf",dep=TRUE)
install.packages("gmp",dep=TRUE)
install.packages("shinythemes",dep=TRUE)
-install.packages(c('gplots','lattice','latticeExtra','vegan','labdsv','cluster','ggplot2'))
+install.packages(c('gplots','lattice','latticeExtra','vegan','labdsv','cluster','ggplot2',"tidyverse"))
install.packages("Vennerable", repos="http://R-Forge.R-project.org",type='source')
source("http://bioconductor.org/biocLite.R")
biocLite(c('graph', 'RBGL', 'RColorBrewer', 'reshape', 'gtools',"edgeR", "DESeq2","qusage","ballgown"))
diff --git a/vizapp/server.R b/vizapp/server.R
index 7e0b4fd..e4ce7e3 100644
--- a/vizapp/server.R
+++ b/vizapp/server.R
@@ -4,9 +4,11 @@ library(qusage)
library(DT)
library(ggplot2)
library(ballgown)
-library(sqldf)
+library(tidyverse)
library(reshape2)
library("gplots")
+library(gridExtra)
+library(grid)
shinyServer(function(input, output, session) {
diff --git a/vizapp/tools/dea.R b/vizapp/tools/dea.R
index 7531f70..1676e6f 100644
--- a/vizapp/tools/dea.R
+++ b/vizapp/tools/dea.R
@@ -1,309 +1,101 @@
# UI-elements for DEA
-ctfile <- paste(data.dir, 'countTable.logCPM.txt', sep = '/')
-samfile <- paste(data.dir, 'design.shiny.txt', sep = '/')
-cts <- read.table(file = ctfile, header = TRUE, sep = '\t')
-samtbl <- read.table(samfile, header = TRUE, sep = "\t")
-samples <- colnames(cts[, 4:length(cts)])
-mergetbl <-
- merge(
- as.data.frame(samples),
- samtbl,
- by.x = "samples",
- by.y = "SampleID",
- all.x = TRUE,
- sort = FALSE
- )
+ctfile <- paste(data.dir,'countTable.logCPM.txt',sep='/')
+samfile <- paste(data.dir,'design.shiny.txt',sep='/')
+cts <- read.table(file=ctfile,header=TRUE,sep='\t')
+samtbl <- read.table(samfile,header=TRUE,sep="\t")
+samples <- colnames(cts[,4:length(cts)])
+mergetbl <- merge(as.data.frame(samples),samtbl,by.x="samples",by.y="SampleID",all.x=TRUE,sort=FALSE)
grps <- mergetbl$SampleGroup
grpnames <- levels(factor(grps))
-col.blocks <- col.grp(grps, grpnames)
-MSIG.geneSets <-
- read.gmt(paste(data.dir, 'geneset.shiny.gmt', sep = '/'))
+col.blocks <-col.grp(grps,grpnames)
+MSIG.geneSets <- read.gmt(paste(data.dir,'geneset.shiny.gmt',sep='/'))
output$pick.dea <- renderUI({
- flist <- list.files(data.dir, pattern = "*edgeR.txt$")
- selectInput("file", "Choose Pair", choices=flist, width = "800px")
+ flist <- list.files(data.dir,pattern="*edgeR.txt$")
+ selectInput("file", "Choose Pair", choices=flist)
})
output$pick.pathway <- renderUI({
- pathways <- names(MSIG.geneSets)
- pathchoices = setNames(1:length(pathways), pathways)
- selectInput("deapathname", "Choose Pair", choices = pathchoices)
+ pathways <- names(MSIG.geneSets)
+ pathchoices = setNames(1:length(pathways),pathways)
+ selectInput("deapathname", "Choose Pair", choices=pathchoices)
})
get.data <- function(var) {
- f <- paste(data.dir, var$file, sep = '/')
- # f <-paste(f, "edgeR.txt", sep = ".") #This line needs to comment out if input is fullname
- f1 <- paste(data.dir, input$file, sep = '/')
- hmcomp <-paste("Heatmap of all genes with an FDR < 0.05 using EdgeR Results", sep ='')
- top50 <- paste("Top 50 User Defined Genes")
- allgene <- paste("All Differentially Expressed Genes")
- comp <- read.table(f, header = TRUE, sep = '\t')
- comp.filt <-
- na.omit(comp[abs(comp$logFC) >= var$fc.thresh &
- comp$rawP <= var$pval.thresh,])
- if (var$adjust == 'FDR') {
- comp.filt <-
- na.omit(comp[abs(comp$logFC) >= var$fc.thresh &
- comp$fdr <= var$pval.thresh,])
- }
- if (var$adjust == 'BONF') {
- comp.filt <-
- na.omit(comp[abs(comp$logFC) >= var$fc.thresh &
- comp$bonf <= var$pval.thresh,])
- }
- genelist <-
- as.character(head(comp.filt[order(comp.filt$fdr),]$symbol, n = var$numgenes))
- if (var$heatmap == 'hgeneset') {
- genelist <- unlist(MSIG.geneSets[as.numeric(var$deapathname)])
- }
- if (var$heatmap == 'cgeneset') {
- genelist <- unlist(strsplit(as.character(var$genes), "[;\n]+"))
- }
- return(
- list(
- filt = comp.filt,
- glist = genelist,
- f1 = f1,
- hmcomp = hmcomp,
- top50 = top50,
- allgene = allgene,
- cluster=input$cluster
- )
- )
+ f <- paste(data.dir,var$file,sep='/')
+ comp <- read.table(f,header=TRUE,sep='\t')
+ comp.filt <- na.omit(comp[abs(comp$logFC) >= var$fc.thresh & comp$rawP <= var$pval.thresh,])
+ if (var$adjust == 'FDR') {
+ comp.filt <- na.omit(comp[abs(comp$logFC) >= var$fc.thresh & comp$fdr <= var$pval.thresh,])
+ }
+ if (var$adjust == 'BONF') {
+ comp.filt <- na.omit(comp[abs(comp$logFC) >= var$fc.thresh & comp$bonf <= var$pval.thresh,])
+ }
+ genelist <- as.character(head(comp.filt[order(comp.filt$fdr),]$symbol,n=var$numgenes))
+ if (var$heatmap == 'hgeneset') {
+ genelist <- unlist(MSIG.geneSets[as.numeric(var$deapathname)])
+ }
+ if (var$heatmap == 'cgeneset') {
+ genelist <- unlist(strsplit(as.character(var$genes), "[;\n]+"))
+ }
+ return(list(filt=comp.filt,glist=genelist))
}
-tbls <- eventReactive(input$deButton,{
- get.data(input)
-})
+tbls <- eventReactive(input$deButton,{get.data(input)})
output$selectgenes <- renderUI({
- symnames <- tbls()$glist
- textAreaInput(
- "genes",
- "Gene Symbols separated by ';'",
- value = paste(symnames, collapse = ";"),
- width = '95%',
- rows = 10
- )
+ symnames <- tbls()$glist
+ textAreaInput("genes", "Gene Symbols separated by ';'",value=paste(symnames,collapse=";"), width = '95%',rows=10)
})
output$dge.c <- DT::renderDataTable({
- t1 <- tbls()$filt
- t1$symbol <-
- paste(
- "<a href=http://www.genecards.org/cgi-bin/carddisp.pl?gene=",
- t1$symbol,
- '>',
- t1$symbol,
- "</a>",
- sep = ''
- )
- t1$ensembl <-
- paste(
- "<a href=http://www.ensembl.org/Homo_sapiens/Gene/Summary?g=",
- t1$ensembl,
- '>',
- t1$ensembl,
- "</a>",
- sep = ''
- )
- t1
-}, escape = FALSE, filter = 'top', options = list(
- lengthMenu = list(c(10, 25, 50, 100, -1), list('10', '25', '50', '100', 'All')),
- autoWidth = TRUE,
- columnDefs = list(list(width = '5%', targets = '0')),
- scrollX = TRUE
-))
+ t1 <- tbls()$filt
+ t1$symbol <- paste("<a href=http://www.genecards.org/cgi-bin/carddisp.pl?gene=",t1$symbol,'>',t1$symbol,"</a>",sep='')
+ t1$ensembl <- paste("<a href=http://www.ensembl.org/Homo_sapiens/Gene/Summary?g=",t1$ensembl,'>',t1$ensembl,"</a>",sep='')
+ t1
+},escape=FALSE,filter = 'top',options = list(lengthMenu = c(10, 25, 50, 200, -1)))
+
+output$downloadC <- downloadHandler(
+ file <- paste(input$file,".filt.txt",sep=""),
+ content = function(file) {
+ write.table(tbls()$filt,file,quote=FALSE,row.names=FALSE,sep='\t')
+ })
-output$downloadC <- renderUI({
- if (!is.null(tbls()$filt)) {
- downloadButton('OutputFile', 'Download CSV')
- }
-})
-output$OutputFile <- downloadHandler(
- file <- paste(input$file, ".filt.txt", sep = ""),
- content = function(file) {
- write.table(
- tbls()$filt,
- file,
- quote = FALSE,
- row.names = FALSE,
- sep = '\t'
- )
- }
-)
plotHeatmap <- reactive({
- syms <- tbls()$glist
- ct2 <- cts[cts$SYMBOL %in% syms,]
- subset <- ct2[, 4:length(ct2)]
- row.names(subset) <- ct2$SYMBOL
- STREE <- hclust(dist(t(subset)))
- zscores <- scale(t(subset))
- ngenes <- length(colnames(zscores))
- textscale <- (1 / (ngenes/30))
- if (textscale > 1) {
- textscale <- 12
- }
- if (textscale < 0.1) {
- textscale <- 12
- }
- if (tbls()$cluster == 2) {
- heatmap.2(
- zscores,
- col = bluered(100),
- #Rowv = as.dendrogram(STREE),
- Rowv = FALSE,
- Colv = FALSE,
- lwid = c(0.5,3),
- RowSideColors = col.blocks,
- dendrogram = 'row',
- cexCol = 1.1,
- srtRow = 45,
- srtCol = 45,
- trace = "none",
- margins = c(8, 7)
- )
- } else{
- heatmap.2(
- zscores,
- col = bluered(100),
- Rowv = as.dendrogram(STREE),
- RowSideColors = col.blocks,
- dendrogram = 'row',
- cexCol = 1.1,
- srtRow = 45,
- srtCol = 45,
- lwid = c(0.5,3),
- trace = "none",
- margins = c(8, 7)
- )
- }
- legend("top",
- legend = grpnames,
- col = rainbow(length(grpnames)),
- pch = 20)
+ syms <- tbls()$glist
+ ct2 <- cts[cts$SYMBOL %in% syms,]
+ subset <- ct2[,4:length(ct2)]
+ row.names(subset) <- ct2$SYMBOL
+ STREE <- hclust(dist(t(subset)))
+ zscores <- scale(t(subset))
+ ngenes <- length(colnames(zscores))
+ textscale <- (1/(ngenes/30))
+ if (textscale > 1) {
+ textscale <-1
+ }
+ if (textscale < 0.1) {
+ textscale <- 0.1
+ }
+ heatmap.2(zscores, col = bluered(100),Rowv = as.dendrogram(STREE), RowSideColors = col.blocks,dendrogram='row', cexCol=textscale,srtRow=45,srtCol=45,trace="none",margins=c(8,16))
+ legend("topright",legend=grpnames,col=rainbow(length(grpnames)),pch=20)
})
output$plot.heatmap <- renderPlot({
- plotHeatmap()
-})
-
-output$dlheatmap <- renderUI({
- if (!is.null(tbls()$glist)) {
- downloadButton('Downloadhp', 'Download PNG')
- }
+ plotHeatmap()
})
-
-output$Downloadhp <- downloadHandler(
- file = function() {
- paste('mean', 'png', sep = ".")
- },
- content <- function(file) {
- png(
- file,
- width = 8 * 140,
- height = 4 * 100,
- res = 140,
- pointsize = 5
- )
- if (is.null(tbls()$glist)) {
- return()
- }
- syms <- tbls()$glist
- ct2 <- cts[cts$SYMBOL %in% syms,]
- subset <- ct2[, 4:length(ct2)]
- row.names(subset) <- ct2$SYMBOL
- STREE <- hclust(dist(t(subset)))
- zscores <- scale(t(subset))
- ngenes <- length(colnames(zscores))
- textscale <- (1 / (ngenes/30))
- if (textscale > 1) {
- textscale <- 12
- }
- if (textscale < 0.1) {
- textscale <- 12
- }
- if (tbls()$cluster == 2) {
- plot <- heatmap.2(
- zscores,
- col = bluered(100),
- Rowv = FALSE,
- Colv = FALSE,
- lwid = c(0.5,3),
- RowSideColors = col.blocks,
- dendrogram = 'row',
- cexCol = 1.1,
- srtRow = 45,
- srtCol = 45,
- trace = "none",
- margins = c(8, 7)
- )
- } else{
- plot <- heatmap.2(
- zscores,
- col = bluered(100),
- Rowv = as.dendrogram(STREE),
- RowSideColors = col.blocks,
- dendrogram = 'row',
- cexCol = 1.1,
- srtRow = 45,
- srtCol = 45,
- lwid = c(0.5,3),
- trace = "none",
- margins = c(8, 7)
- )
- }
- legend("top",
- legend = grpnames,
- col = rainbow(length(grpnames)),
- pch = 20)
- print(plot)
- dev.off()
- },
- contentType = "image/png"
-)
-
output$downloadpdf = downloadHandler(
- filename = "output.heatmap.pdf",
- content = function(file) {
- pdf(file = file, paper = "letter")
- plotHeatmap()
- dev.off()
- }
-)
+ filename = "output.heatmap.pdf",
+ content = function(file) {
+ pdf(file = file,paper="letter")
+ plotHeatmap()
+ dev.off()
+ })
output$hm.comp <- renderImage({
- f1 <- paste(tbls()$f1)
- png <- gsub('edgeR.txt', 'heatmap.edgeR.png', f1)
- list(
- src = png,
- alt = paste("HeatMap Comparison"),
- width = "100%",
- height = "auto"
- )
-}, deleteFile = FALSE)
+ f1 <- paste(data.dir,input$file,sep='/')
+ png <- gsub('edgeR.txt','heatmap.edgeR.png',f1)
+ list(src=png, alt=paste("HeatMap Comparison"))
+},deleteFile=FALSE)
-output$dlhmcomp <- renderUI({
- if (!is.null(tbls()$f1)) {
- downloadButton('Downloadhm', 'Download PNG')
- }
-})
-output$Downloadhm <- downloadHandler(
- file = function() {
- paste('heatmap_comp', 'png', sep = ".")
- },
- content <- function(file) {
- f1 <- paste(tbls()$f1)
- png <- gsub('edgeR.txt', 'heatmap.edgeR.png', f1)
- file.copy(png, file)
- }
-)
-
-output$hmcomp.allgene <- renderText({
- paste(tbls()$allgene)
-})
-output$hmcomp.top50 <- renderText({
- paste(tbls()$top50)
-})
-output$hmcomp.desc <- renderText({
- paste(tbls()$hmcomp)
-})
+output$hmcomp.desc <- renderText({
+ paste("Heatmap of all genes with an FDR < 0.05 using EdgeR Results",sep='')
+ })
diff --git a/vizapp/tools/gc.R b/vizapp/tools/gc.R
index 68f94cf..4dc9d8c 100644
--- a/vizapp/tools/gc.R
+++ b/vizapp/tools/gc.R
@@ -1,139 +1,46 @@
-samfile <- paste(data.dir, 'design.shiny.txt', sep = '/')
-samtbl <- read.table(samfile, header = TRUE, sep = "\t")
+samtbl <- read_tsv(paste(data.dir,'design.shiny.txt',sep='/'))
+wrapper <- function(x, ...)
+ {
+ paste(strwrap(x, ...), collapse = "\n")
+ }
output$pick.group <- renderUI({
- opts <- names(samtbl)
- selectInput("groupname",
- "Plot By",
- choices = opts,
- selected = 'SampleGroup')
+ opts <- names(samtbl)
+ selectInput("groupname", "Plot By", choices=opts,selected='SampleGroup')
})
get.ct <- function(var) {
- ctfile <- paste(data.dir, 'countTable.logCPM.txt', sep = '/')
- statfile <- paste(data.dir, 'edgeR.results.txt', sep = '/')
- wp.df <- data.frame(Column1 = c(0), Column2 = c(0))
- bx <-
- paste(
- "Relative Abudance of",
- input$gc_symsearch,
- "calculated by Log2(Counts Per Million Reads). Boxplots draw to represent the 25th and 75th percentile (the lower and upper quartiles, respectively) as a box with a band in the box representing 50th percentile (the median). The upper whisker is located at the 'smaller' of the maximum x value and Q_3 + 1.5 inner quantile range(IRQ), whereas the lower whisker is located at the 'larger' of the smallest x value and Q_1 - 1.5 IQR",
- sep = ' '
- )
- vio <- paste(
- "Relative Abudance of",
- input$gc_symsearch,
- input$gc_enssearch,
- "calculated by Log2(Counts Per Million Reads). Violin plot is similar to box plots above, except that it also show the kernel probability density of the data at different value. Violin plots include a marker for the median of the data and a box indicating the interquartile range, as in boxplot above.",
- sep = ' '
- )
- if (nchar(as.vector(var$gc_symsearch)) > 2) {
- cts <-
- read.csv.sql(
- ctfile,
- sql = paste("select * from file where symbol ='", var$gc_symsearch, "'", sep =
- ''),
- sep = "\t"
- )
- if (file.exists(statfile)) {
- wp.df <-
- read.csv.sql(
- statfile,
- sql = paste(
- "select * from file where symbol ='",
- var$gc_symsearch,
- "'",
- sep = ''
- ),
- sep = "\t"
- )
+ cttbl <- read_tsv(paste(data.dir,'countTable.logCPM.txt',sep='/'))
+ if ("symsearch" %in% names(var)) {
+ if (length(as.character(var$symsearch)) > 2) {
+ cts <- filter(cttbl,SYMBOL == var$symsearch)
}
- }
- else {
- if (nchar(as.vector(var$gc_enssearch)) > 2) {
- cts <-
- read.csv.sql(
- ctfile,
- sql = paste(
- "select * from file where ENSEMBL ='",
- var$gc_enssearch,
- "'",
- sep = ''
- ),
- sep = "\t"
- )
- if (file.exists(statfile)) {
- wp.df <-
- read.csv.sql(
- statfile,
- sql = paste(
- "select * from file where ENSEMBL ='",
- var$gc_enssearch,
- "'",
- sep = ''
- ),
- sep = "\t"
- )
- }
}
+ if ("enssearch" %in% names(var)) {
+ if (length(as.character(var$enssearch)) > 2) {
+ cts <- filter(cttbl,ENSEMBL == var$enssearch)
+ }
+ }
+ countTable <- gather(select(cts,4:length(cts)),key="SampleID",value="cts")
+ newdf <- inner_join(countTable,samtbl)
+ return(list(ctable=newdf))
}
- countTable <- cts[, 4:length(cts)]
- samples <- colnames(countTable)
- mergetbl <-
- merge(
- as.data.frame(samples),
- samtbl,
- by.x = "samples",
- by.y = "SampleID",
- all.x = TRUE,
- sort = FALSE
- )
- grps <- mergetbl[, var$groupname]
- newdf <- data.frame(ct = t(countTable), grp = as.character(grps))
- names(newdf) = c('cts', 'grp')
- return(list(
- ctable = newdf,
- tbl = cts,
- design = samtbl,
- stats = wp.df,
- bx = bx,
- vio = vio
- ))
-}
-forct <- eventReactive(input$gcButton, {
- get.ct(input)
-})
+forct <- eventReactive(input$gcButton,{get.ct(input)})
output$plot.gene <- renderPlot({
- countTable <- forct()$ctable
- par(oma = c(4, 4, 1, 1))
- grpnames <- levels(factor(as.character(countTable$grp)))
- p <- ggplot(countTable, aes(x = grp, y = cts)) + ggtitle(input$groupname) + theme_bw() +
- theme(plot.title = element_text(
- hjust = 0.5,
- size = 18,
- margin = margin(b = 20, unit = "pt")
- )) + geom_boxplot(trim = FALSE, aes(fill = factor(grp))) +
- theme(
- legend.position = "none",
- axis.title.y = element_text(size =14),
- axis.text.y = element_text(size =14),
- axis.text.x = element_text(
- angle = 45,
- hjust = 1,
- vjust = 1,
- size =14
- )
- ) + ylab("Relative Abundance (logCPM)") + xlab("")
- print(p)
-}, height = "auto", width = 'auto')
+ newdf <- forct()$ctable
+ p1 <- ggplot(newdf, aes(x=!!as.symbol(input$groupname), y=cts,fill=!!as.symbol(input$groupname))) + geom_boxplot() + theme(legend.position="top",axis.text.x=element_text(angle=45,hjust=1, vjust=1)) + labs(title=paste("Relative Abudance of",input$symsearch),x=input$groupname, y = "Relative Abundance (logCPM)",caption=wrapper("Boxplots draw to represent the 25th and 75th percentile (the lower and upper quartiles, respectively) as a box with a band in the box representing 50th percentile (the median). The upper whisker is located at the 'smaller' of the maximum x value and Q_3 + 1.5 inner quantile range(IRQ), whereas the lower whisker is located at the 'larger' of the smallest x value and Q_1 - 1.5 IQR")) + theme(legend.position = "bottom",plot.margin = margin(15, 15, 15, 15),plot.caption = element_text(size = 10, hjust = 0))
+ p2 <- ggplot(newdf, aes(x=!!as.symbol(input$groupname), y=cts,fill=!!as.symbol(input$groupname))) + geom_violin() + theme(legend.position="top",axis.text.x=element_text(angle=45,hjust=1, vjust=1)) + labs(title=paste("Relative Abudance of",input$symsearch),x=input$groupname, y = "Relative Abundance (logCPM)",caption=wrapper("Violin plot shows the kernel probability density of the data at different value. Violin plots include a marker for the median of the data and a box indicating the interquartile range")) + theme(legend.position = "bottom",plot.margin = margin(15, 15, 15, 15),plot.caption = element_text(size = 10, hjust = 0))
+ grid.arrange(p1,p2,nrow=2)
+}, height = 900, width = 900)
output$dlboxplot <- renderUI({
if (!is.null(forct()$ctable)) {
downloadButton('Downloadbp', 'Download PNG')
}
})
+
output$Downloadbp <- downloadHandler(
file = function() {
paste('boxplot', 'png', sep = ".")
@@ -149,87 +56,12 @@ output$Downloadbp <- downloadHandler(
if (is.null(forct()$ctable)) {
return()
}
- countTable <- forct()$ctable
- par(oma = c(4, 4, 1, 1))
- grpnames <- levels(factor(as.character(countTable$grp)))
- plot <- ggplot(countTable, aes(x = grp, y = cts)) + ggtitle(input$groupname) + theme_bw() +
- theme(plot.title = element_text(
- hjust = 0.5,
- size = 18,
- margin = margin(b = 20, unit = "pt")
- )) + geom_boxplot(trim = FALSE, aes(fill = factor(grp))) +
- theme(legend.position = "none",
- axis.text.x = element_text(
- angle = 45,
- hjust = 1,
- vjust = 1
- )) + ylab("Relative Abundance (logCPM)") + xlab("")
- print(plot)
- dev.off()
- },
- contentType = "image/png"
-)
-
-output$bxplot.desc <- renderText({
- paste(forct()$bx)
-})
-
-output$violin.gene <- renderPlot({
- countTable <- forct()$ctable
- par(oma = c(4, 4, 1, 1))
- p <- ggplot(countTable, aes(x = grp, y = cts)) + geom_violin(trim = FALSE, aes(fill = factor(grp))) + theme_bw() +
- geom_jitter(height = 0) + theme(legend.position = "none",
- axis.title.y = element_text(size =14),
- axis.text.y = element_text(size =14),
- axis.text.x = element_text(
- angle = 45,
- hjust = 1,
- vjust = 1,
- size = 14
- )
- ) + ylab("Relative Abundance (logCPM)") + xlab("")
- print(p)
-}, height = "auto", width = 'auto')
-
-output$dlviolinplot <- renderUI({
- if (!is.null(forct()$ctable)) {
- downloadButton('Downloadvp', 'Download PNG')
- }
-})
-
-output$Downloadvp <- downloadHandler(
- file = function() {
- paste('violinplot', 'png', sep = ".")
- },
- content <- function(file) {
- png(
- file,
- width = 8 * 120,
- height = 4 * 120,
- res = 120,
- pointsize = 5
- )
- if (is.null(forct()$ctable)) {
- return()
- }
- countTable <- forct()$ctable
- par(oma = c(4, 4, 1, 1))
- grpnames <- levels(factor(as.character(countTable$grp)))
- par(oma = c(4, 4, 1, 1))
- plot <- ggplot(countTable, aes(x = grp, y = cts)) + geom_violin(trim = FALSE, aes(fill = factor(grp))) +
- geom_jitter(height = 0) + theme_bw() +
- theme(legend.position = "none",
- axis.text.x = element_text(
- angle = 45,
- hjust = 1,
- vjust = 1
- )) + ylab("Relative Abundance (logCPM)") + xlab("")
- print(plot)
+ newdf <- forct()$ctable
+ p1 <- ggplot(newdf, aes(x=!!as.symbol(input$groupname), y=cts,fill=!!as.symbol(input$groupname))) + geom_boxplot() + theme(legend.position="top",axis.text.x=element_text(angle=45,hjust=1, vjust=1)) + labs(title=paste("Relative Abudance of",input$symsearch),x=input$groupname, y = "Relative Abundance (logCPM)",caption=wrapper("Boxplots draw to represent the 25th and 75th percentile (the lower and upper quartiles, respectively) as a box with a band in the box representing 50th percentile (the median). The upper whisker is located at the 'smaller' of the maximum x value and Q_3 + 1.5 inner quantile range(IRQ), whereas the lower whisker is located at the 'larger' of the smallest x value and Q_1 - 1.5 IQR")) + theme(legend.position = "bottom",plot.margin = margin(15, 15, 15, 15),plot.caption = element_text(size = 10, hjust = 0))
+ p2 <- ggplot(newdf, aes(x=!!as.symbol(input$groupname), y=cts,fill=!!as.symbol(input$groupname))) + geom_violin() + theme(legend.position="top",axis.text.x=element_text(angle=45,hjust=1, vjust=1)) + labs(title=paste("Relative Abudance of",input$symsearch),x=input$groupname, y = "Relative Abundance (logCPM)",caption=wrapper("Violin plot shows the kernel probability density of the data at different value. Violin plots include a marker for the median of the data and a box indicating the interquartile range")) + theme(legend.position = "bottom",plot.margin = margin(15, 15, 15, 15),plot.caption = element_text(size = 10, hjust = 0))
+ grid.arrange(p1,p2,nrow=1)
dev.off()
},
contentType = "image/png"
)
-output$violin.desc <- renderText({
- paste(forct()$vio)
-})
diff --git a/vizapp/tools/gc_ui.R b/vizapp/tools/gc_ui.R
index ce5106d..d4744cb 100644
--- a/vizapp/tools/gc_ui.R
+++ b/vizapp/tools/gc_ui.R
@@ -12,21 +12,11 @@ output$ui_gc <- renderUI({
tabsetPanel(
tabPanel(
"Gene Compare",
- dataTableOutput('gc.stats'),
- br(),
plotOutput("plot.gene"),
- uiOutput('dlboxplot'),
- br(),
- textOutput("bxplot.desc"),
- br(),
- plotOutput("violin.gene"),
- uiOutput('dlviolinplot'),
- br(),
- textOutput("violin.desc")
+ uiOutput('dlboxplot')
)
)),
- tags$style(type='text/css', "#dlboxplot { width:100%;margin-left: 35px;}"),
- tags$style(type='text/css', "#dlviolinplot { width:100%;margin-left: 35px;}")
+ tags$style(type='text/css', "#dlboxplot { width:100%;margin-left: 35px;}")
)
))
diff --git a/workflow/process_scripts b/workflow/process_scripts
index 0f5e4dc..7adcb10 160000
--- a/workflow/process_scripts
+++ b/workflow/process_scripts
@@ -1 +1 @@
-Subproject commit 0f5e4dca5c3985a7f7b0d409edb5140715b925b8
+Subproject commit 7adcb10cc4b0159f22faf630fba29ad31c48bf9d
diff --git a/workflow/scripts/concat_cts.pl b/workflow/scripts/concat_cts.pl
index b36bd22..7626a06 100755
--- a/workflow/scripts/concat_cts.pl
+++ b/workflow/scripts/concat_cts.pl
@@ -78,7 +78,7 @@ foreach $gene (keys %cts) {
}
$cpm = ($cts{$gene}{$sample}/$total{$sample})*1e6;
push @cpm, sprintf("%.2f",log2($cpm));
- push @line, $cts{$gene}{$sample};
+ push @line, sprintf("%0.f",$cts{$gene}{$sample});
}
my @sortct = sort {$b cmp $a} @cpm;
#next unless ($sortct[0] >= 1);
--
GitLab