From 7f6be42f6e8ec3e65110522843a71f9dc2f31d41 Mon Sep 17 00:00:00 2001
From: Danni Luo <danni.luo@utsouthwestern.edu>
Date: Thu, 31 May 2018 11:43:50 -0500
Subject: [PATCH] fix issue 3 comments
---
vizapp/.Rhistory | 512 +++++++++++++++++++++++++++++++++++++++
vizapp/server.R | 3 +-
vizapp/tools/altsplice.R | 8 +-
vizapp/tools/dea.R | 16 +-
vizapp/tools/dea_ui.R | 2 +-
vizapp/tools/gc.R | 132 +++++-----
vizapp/tools/gc_ui.R | 4 +-
vizapp/tools/qc_ui.R | 2 +-
workflow/scripts/dea.R | 6 +-
9 files changed, 597 insertions(+), 88 deletions(-)
create mode 100644 vizapp/.Rhistory
diff --git a/vizapp/.Rhistory b/vizapp/.Rhistory
new file mode 100644
index 0000000..6cff52a
--- /dev/null
+++ b/vizapp/.Rhistory
@@ -0,0 +1,512 @@
+div(class="card-footer",
+a(class="btn btn-primary btn-sm", 'data-toggle'="tab",'data-value'="DEA",id="dea","DEA")
+)
+)
+),
+column(4,
+div(class="card text-center",
+div(class="card-header",
+"GSEA"
+),
+div(class="card-body",
+h5(class="card-title","To Examine Gene Set Enrichment Analysis"),
+p(class="card-text","Here you will be able explore Gene Set Enrichment Analysis by Group and Gene Set List.")
+),
+div(class="card-footer",
+a(class="btn btn-primary btn-sm",'data-toggle'="tab", 'data-value'="QuSAGE",id="gsea","GSEA")
+)
+)
+)
+)
+)
+),
+fluidRow(
+column(10,offset=1,
+br(),
+br(),
+p("Note:Error messages can indicate data processing or missing data. Please wait 30 seconds for the program to catch up to any changes in data loading."),
+h6("Questions? Contract Brandi Cantarel brandi.cantarel@baylorhealth.edu")
+)
+)
+)
+)
+id='intropage',
+fluidRow(
+br(),
+column(8,offset=2,
+h1("Welcome to the RNASeq Analysis Portal", align = "center"),
+br(),
+br(),
+div(
+column(4,
+div(class="card text-center",
+div(class="card-header",
+"Gene Compare"
+),
+div(class="card-body",
+h5(class="card-title","To Compare Gene Abundances", align = "center"),
+p(class="card-text","Here you will be able explore gene abundances by (1) Transmembrane Proteins, (2) Transcription Fractors and (3) Chemocytokines. Also you can compare the gene abundances of genes by Available Clinicial Data")
+),
+div(class="card-footer",
+# a(class="btn btn-primary btn-sm", 'data-toggle'="tab", 'data-value'="Gene Compare", 'id'="btgc", "Gene Compare")
+actionButton(class = "btn btn-primary btn-sm", inputId="actionbtgc", label="Gene Compare", icon=NULL)
+)
+)
+),
+column(4,
+div(class="card text-center",
+div(class="card-header",
+"DEA"
+),
+div(class="card-body",
+h5(class="card-title","To Examine Differential Gene Analysis"),
+p(class="card-text","Here you will be able explore Differential Gene Expresss by Group. You will also be able to compare two comparisons: such as Case1 vs Control and Case2 vs Control.")
+),
+div(class="card-footer",
+# a(class="btn btn-primary btn-sm", 'data-toggle'="tab",'data-value'="DEA",id="dea","DEA")
+actionButton(class="btn btn-primary btn-sm", inputId = "actionbtdea", label="DEA", icon = NULL)
+)
+)
+),
+column(4,
+div(class="card text-center",
+div(class="card-header",
+"GSEA"
+),
+div(class="card-body",
+h5(class="card-title","To Examine Gene Set Enrichment Analysis"),
+p(class="card-text","Here you will be able explore Gene Set Enrichment Analysis by Group and Gene Set List.")
+),
+div(class="card-footer",
+#a(class="btn btn-primary btn-sm",'data-toggle'="tab", 'data-value'="QuSAGE",id="gsea","GSEA")
+actionButton(class="btn btn-primary btn-sm", inputId = "actionbtgsea", label="GSEA")
+)
+)
+)
+)
+)
+),
+fluidRow(
+column(8,offset=2,
+br(),
+br(),
+div(class="alert alert-info",
+a(icon("new-window", lib="glyphicon"),strong("citation link"), href="https://git.biohpc.swmed.edu/BICF/Astrocyte/rnaseq", target="_blank", style="color:white"),
+p(strong("Note:"), "Error messages can indicate data processing or missing data. Please wait 30 seconds for the program to catch up to any changes in data loading.")
+)
+)
+)
+fluidPage(id='intropage',
+fluidRow(
+br(),
+column(8,offset=2,
+h1("Welcome to the RNASeq Analysis Portal", align = "center"),
+br(),
+br(),
+div(
+column(4,
+div(class="card text-center",
+div(class="card-header",
+"Gene Compare"
+),
+div(class="card-body",
+h5(class="card-title","To Compare Gene Abundances", align = "center"),
+p(class="card-text","Here you will be able explore gene abundances by (1) Transmembrane Proteins, (2) Transcription Fractors and (3) Chemocytokines. Also you can compare the gene abundances of genes by Available Clinicial Data")
+),
+div(class="card-footer",
+# a(class="btn btn-primary btn-sm", 'data-toggle'="tab", 'data-value'="Gene Compare", 'id'="btgc", "Gene Compare")
+actionButton(class = "btn btn-primary btn-sm", inputId="actionbtgc", label="Gene Compare", icon=NULL)
+)
+)
+),
+column(4,
+div(class="card text-center",
+div(class="card-header",
+"DEA"
+),
+div(class="card-body",
+h5(class="card-title","To Examine Differential Gene Analysis"),
+p(class="card-text","Here you will be able explore Differential Gene Expresss by Group. You will also be able to compare two comparisons: such as Case1 vs Control and Case2 vs Control.")
+),
+div(class="card-footer",
+# a(class="btn btn-primary btn-sm", 'data-toggle'="tab",'data-value'="DEA",id="dea","DEA")
+actionButton(class="btn btn-primary btn-sm", inputId = "actionbtdea", label="DEA", icon = NULL)
+)
+)
+),
+column(4,
+div(class="card text-center",
+div(class="card-header",
+"GSEA"
+),
+div(class="card-body",
+h5(class="card-title","To Examine Gene Set Enrichment Analysis"),
+p(class="card-text","Here you will be able explore Gene Set Enrichment Analysis by Group and Gene Set List.")
+),
+div(class="card-footer",
+#a(class="btn btn-primary btn-sm",'data-toggle'="tab", 'data-value'="QuSAGE",id="gsea","GSEA")
+actionButton(class="btn btn-primary btn-sm", inputId = "actionbtgsea", label="GSEA")
+)
+)
+)
+)
+)
+),
+fluidRow(
+column(8,offset=2,
+br(),
+br(),
+div(class="alert alert-info",
+a(icon("new-window", lib="glyphicon"),strong("citation link"), href="https://git.biohpc.swmed.edu/BICF/Astrocyte/rnaseq", target="_blank", style="color:white"),
+p(strong("Note:"), "Error messages can indicate data processing or missing data. Please wait 30 seconds for the program to catch up to any changes in data loading.")
+)
+)
+)
+)
+source('~/shiny_R/vizapp/workflow_322_output/t.R')
+source('~/shiny_R/vizapp/workflow_322_output/t.R')
+source('~/shiny_R/vizapp/workflow_322_output/t.R')
+source('~/shiny_R/vizapp/workflow_322_output/t.R')
+source('~/shiny_R/vizapp/workflow_322_output/t.R')
+source('~/shiny_R/vizapp/workflow_322_output/t.R')
+source('~/shiny_R/vizapp/workflow_322_output/t.R')
+shiny::runApp('shiny_R/activebuttontab')
+runApp('shiny_R/activebuttontab')
+if (var$adjust == 'FDR') {
+comp.filt <- na.omit(comp[abs(comp$logFC) >= var$fc.thresh & comp$fdr <= var$pval.thresh,])
+}
+ctfile <- paste(data.dir,'countTable.logCPM.txt',sep='/')
+data.dir <- "workflow_322_output"
+# UI-elements for DEA
+data.dir <- "workflow_322_output"
+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='/'))
+output$pick.dea <- renderUI({
+flist <- list.files(data.dir,pattern="*edgeR.txt$")
+# selectInput("file", "Choose Pair", choices=substr(flist,0,nchar(flist)-10), width = "100%")
+selectInput("file", "Choose Pair", choices=flist, width = "100%")
+})
+output$pick.pathway <- renderUI({
+pathways <- names(MSIG.geneSets)
+pathchoices = setNames(1:length(pathways),pathways)
+selectInput("deapathname", "Choose Pair", choices=pathchoices)
+})
+get.data <- function(var) {
+# var$file <- paste(var$file, ".edgeR.txt", sep="")
+f <- paste(data.dir,var$file,sep='/')
+print(f)
+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)})
+output$selectgenes <- renderUI({
+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 = c(10, 25, 50, 200, -1), autoWidth=TRUE,columnDefs = list(list(width = '5%', targets = '0'))))
+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')
+})
+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 <-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$downloadpdf = downloadHandler(
+filename = "output.heatmap.pdf",
+content = function(file) {
+pdf(file = file,paper="letter")
+plotHeatmap()
+dev.off()
+})
+output$hm.comp <- renderImage({
+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$hmcomp.desc <- renderText({
+paste("Heatmap of all genes with an FDR < 0.05 using EdgeR Results",sep='')
+})
+output$ui_dea <- renderUI({
+list(
+fluidPage(
+includeCSS("www/style.css"),
+fluidRow(
+sidebarPanel(
+numericInput("fc.thresh",
+"LogFold Change Threshold:", 1),
+numericInput("gene.thresh",
+"Gene Mean Threshold:", 5),
+numericInput("pval.thresh",
+"P-Value Threshold:", 0.05),
+selectInput("adjust", "Choose P-Value Correction", choices=c("raw","FDR",'BONF'),selected='FDR'),
+uiOutput("pick.dea"),
+selectInput(
+"heatmap", "HeatMap",
+c(Top = "top",
+HallmarkGeneSet = "hgeneset",
+CustomGeneSet= "cgeneset")
+),
+conditionalPanel(
+condition = "input.heatmap == 'cgeneset'",
+uiOutput("selectgenes")
+),
+conditionalPanel(
+condition = "input.heatmap == 'top'",
+numericInput("numgenes","Number Top Genes:", 50)
+),
+conditionalPanel(
+condition = "input.heatmap == 'hgeneset'",
+uiOutput("pick.pathway")
+),
+actionButton("deButton", "Go")
+),
+column(7,
+tabsetPanel(
+tabPanel("Differential Gene Set Comparison",br(),br(),
+downloadButton('downloadC', 'Download CSV'),
+dataTableOutput('dge.c', width=500, height='auto')
+),
+tabPanel("Heatmap",
+#downloadButton('downloadpdf', 'Download Heatmap'),
+h1("HeatMap Comparison"),
+h3("Top 50 User Defined Genes"),
+plotOutput("plot.heatmap"),
+h3("All Differentially Expressed Genes"),
+imageOutput("hm.comp",width="1200px",height="1200px"),
+textOutput("hmcomp.desc")
+)
+)
+)
+)
+),
+fluidRow(style = "margin-top:40px",
+tags$footer(
+class = "footer",
+div(
+class = "container",
+style = "padding-bottom:0; margin-bottom:0",
+p(
+icon("envelope", lib = "glyphicon"),
+"brandi.cantarel@baylorhealth.edu | @ UT Southwestern Medical Center",
+style = "margin-bottom:-40px;"
+)
+# p("@ UT Southwestern Medical Center", style = "margin-top:-40px;")
+)
+)))
+})
+#######################################
+# Shiny interface for data functions
+#######################################
+# data ui and tabs
+output$ui_dea <- renderUI({
+list(
+fluidPage(
+includeCSS("www/style.css"),
+fluidRow(
+sidebarPanel(
+numericInput("fc.thresh",
+"LogFold Change Threshold:", 1),
+numericInput("gene.thresh",
+"Gene Mean Threshold:", 5),
+numericInput("pval.thresh",
+"P-Value Threshold:", 0.05),
+selectInput("adjust", "Choose P-Value Correction", choices=c("raw","FDR",'BONF'),selected='FDR'),
+uiOutput("pick.dea"),
+selectInput(
+"heatmap", "HeatMap",
+c(Top = "top",
+HallmarkGeneSet = "hgeneset",
+CustomGeneSet= "cgeneset")
+),
+conditionalPanel(
+condition = "input.heatmap == 'cgeneset'",
+uiOutput("selectgenes")
+),
+conditionalPanel(
+condition = "input.heatmap == 'top'",
+numericInput("numgenes","Number Top Genes:", 50)
+),
+conditionalPanel(
+condition = "input.heatmap == 'hgeneset'",
+uiOutput("pick.pathway")
+),
+actionButton("deButton", "Go")
+),
+column(7,
+tabsetPanel(
+tabPanel("Differential Gene Set Comparison",br(),br(),
+downloadButton('downloadC', 'Download CSV'),
+dataTableOutput('dge.c', width=500, height='auto')
+),
+tabPanel("Heatmap",
+#downloadButton('downloadpdf', 'Download Heatmap'),
+h1("HeatMap Comparison"),
+h3("Top 50 User Defined Genes"),
+plotOutput("plot.heatmap"),
+h3("All Differentially Expressed Genes"),
+imageOutput("hm.comp",width="1200px",height="1200px"),
+textOutput("hmcomp.desc")
+)
+)
+)
+)
+),
+fluidRow(style = "margin-top:40px",
+tags$footer(
+class = "footer",
+div(
+class = "container",
+style = "padding-bottom:0; margin-bottom:0",
+p(
+icon("envelope", lib = "glyphicon"),
+"brandi.cantarel@baylorhealth.edu | @ UT Southwestern Medical Center",
+style = "margin-bottom:-40px;"
+)
+# p("@ UT Southwestern Medical Center", style = "margin-top:-40px;")
+)
+)))
+})
+runApp('shiny_R/activebuttontab')
+runApp('shiny_R/vizapp')
+runApp('shiny_R/vizapp')
+runApp('shiny_R/activebuttontab')
+install.packages("shinydashboard")
+runApp('shiny_R/activebuttontab')
+runApp('shiny_R/vizapp')
+list(
+fluidPage(
+includeCSS("www/style.css"),
+fluidRow(
+sidebarPanel(
+numericInput("fc.thresh",
+"LogFold Change Threshold:", 1),
+numericInput("gene.thresh",
+"Gene Mean Threshold:", 5),
+numericInput("pval.thresh",
+"P-Value Threshold:", 0.05),
+selectInput("adjust", "Choose P-Value Correction", choices=c("raw","FDR",'BONF'),selected='FDR'),
+uiOutput("pick.dea"),
+selectInput(
+"heatmap", "HeatMap",
+c(Top = "top",
+HallmarkGeneSet = "hgeneset",
+CustomGeneSet= "cgeneset")
+),
+conditionalPanel(
+condition = "input.heatmap == 'cgeneset'",
+uiOutput("selectgenes")
+),
+conditionalPanel(
+condition = "input.heatmap == 'top'",
+numericInput("numgenes","Number Top Genes:", 50)
+),
+conditionalPanel(
+condition = "input.heatmap == 'hgeneset'",
+uiOutput("pick.pathway")
+),
+actionButton("deButton", "Go", class = "btn btn-primary btn-bg centerbtn")
+),
+column(7,
+tabsetPanel(
+tabPanel("Differential Gene Set Comparison",br(),br(),
+downloadButton('downloadC', 'Download CSV'),
+# dataTableOutput('dge.c')
+box(
+title = "Box title", width = NULL, status = "primary",
+div(style = 'overflow-x: scroll', DT::dataTableOutput('dge.c'))
+)
+),
+tabPanel("Heatmap",
+#downloadButton('downloadpdf', 'Download Heatmap'),
+h1("HeatMap Comparison"),
+h3("Top 50 User Defined Genes"),
+plotOutput("plot.heatmap"),
+h3("All Differentially Expressed Genes"),
+imageOutput("hm.comp",width = "100%", height ="auto"),
+textOutput("hmcomp.desc")
+)
+)
+)
+)
+),
+fluidRow(style = "margin-top:40px",
+tags$footer(
+class = "footer",
+div(
+class = "container",
+style = "padding-bottom:0; margin-bottom:0",
+p(
+icon("envelope", lib = "glyphicon"),
+"brandi.cantarel@baylorhealth.edu | @ UT Southwestern Medical Center",
+style = "margin-bottom:-40px;"
+)
+# p("@ UT Southwestern Medical Center", style = "margin-top:-40px;")
+)
+)))
+runApp('shiny_R/vizapp')
+runApp('shiny_R/vizapp')
+runApp('shiny_R/vizapp')
+runApp('shiny_R/vizapp')
+runApp('shiny_R/vizapp')
+install.packages(shinyjs)
+runApp('shiny_R/vizapp')
+runApp('shiny_R/vizapp')
+install.packages("shinyjs")
+runApp('shiny_R/vizapp')
+if(input$file==TRUE){
+shinyjs::enable("downloadC")
+}else{
+shinyjs::disable("downloadC")
+}
+runApp('shiny_R/vizapp')
+runApp('shiny_R/vizapp')
+install.packages("shinythemes")
+install.packages("shinythemes", dep=TRUE)
+shiny::runApp('shiny_R/rnaseq/vizapp')
+runApp('shiny_R/rnaseq/vizapp')
diff --git a/vizapp/server.R b/vizapp/server.R
index e0a38d7..31b788a 100644
--- a/vizapp/server.R
+++ b/vizapp/server.R
@@ -10,7 +10,8 @@ library("gplots")
shinyServer(function(input, output, session) {
- data.dir <- Sys.getenv('outputDir')
+ #data.dir <- Sys.getenv('outputDir')
+ data.dir <-"../../vizapp/workflow_322_output"
rda.dir <- data.dir
symsyn <- read.table(file='symbol2synonym.txt',header=FALSE)
names(symsyn) <- c('symbol','synonyms')
diff --git a/vizapp/tools/altsplice.R b/vizapp/tools/altsplice.R
index 3eb2df7..3352b24 100644
--- a/vizapp/tools/altsplice.R
+++ b/vizapp/tools/altsplice.R
@@ -228,7 +228,9 @@ output$trx.gene <- renderPlot({
countTable <- getgeneid()$cttbl
par(oma = c(4, 1, 4, 1))
p <-
- ggplot(countTable, aes(x = grptrx, y = log2(value + 1))) + geom_boxplot(aes(fill = factor(grptrx))) + geom_jitter(height = 0) + theme(
+ ggplot(countTable, aes(x = grptrx, y = log2(value + 1))) + geom_boxplot(aes(fill = factor(grptrx))) +
+ geom_jitter(height = 0) + theme_bw() +
+ theme(
legend.position = "left",
axis.text.x = element_text(
angle = 45,
@@ -266,7 +268,9 @@ output$Downloadtregene <- downloadHandler(
countTable <- getgeneid()$cttbl
par(oma = c(4, 1, 4, 1))
p <-
- ggplot(countTable, aes(x = grptrx, y = log2(value + 1))) + geom_boxplot(aes(fill = factor(grptrx))) + geom_jitter(height = 0) + theme(
+ ggplot(countTable, aes(x = grptrx, y = log2(value + 1))) + geom_boxplot(aes(fill = factor(grptrx))) +
+ geom_jitter(height = 0) + theme_bw() +
+ theme(
legend.position = "left",
axis.text.x = element_text(
angle = 45,
diff --git a/vizapp/tools/dea.R b/vizapp/tools/dea.R
index de9b93d..7531f70 100644
--- a/vizapp/tools/dea.R
+++ b/vizapp/tools/dea.R
@@ -22,7 +22,7 @@ MSIG.geneSets <-
output$pick.dea <- renderUI({
flist <- list.files(data.dir, pattern = "*edgeR.txt$")
- selectInput("file", "Choose Pair", choices=flist, width = "100%")
+ selectInput("file", "Choose Pair", choices=flist, width = "800px")
})
output$pick.pathway <- renderUI({
pathways <- names(MSIG.geneSets)
@@ -66,15 +66,15 @@ get.data <- function(var) {
f1 = f1,
hmcomp = hmcomp,
top50 = top50,
- allgene = allgene
+ allgene = allgene,
+ cluster=input$cluster
)
)
}
-tbls <- eventReactive(input$deButton,
- {
- get.data(input)
- })
+tbls <- eventReactive(input$deButton,{
+ get.data(input)
+})
output$selectgenes <- renderUI({
symnames <- tbls()$glist
@@ -147,7 +147,7 @@ plotHeatmap <- reactive({
if (textscale < 0.1) {
textscale <- 12
}
- if (input$cluster == 2) {
+ if (tbls()$cluster == 2) {
heatmap.2(
zscores,
col = bluered(100),
@@ -222,7 +222,7 @@ output$Downloadhp <- downloadHandler(
if (textscale < 0.1) {
textscale <- 12
}
- if (input$cluster == 2) {
+ if (tbls()$cluster == 2) {
plot <- heatmap.2(
zscores,
col = bluered(100),
diff --git a/vizapp/tools/dea_ui.R b/vizapp/tools/dea_ui.R
index a0d88eb..a62163c 100644
--- a/vizapp/tools/dea_ui.R
+++ b/vizapp/tools/dea_ui.R
@@ -36,7 +36,7 @@ output$ui_dea <- renderUI({
conditionalPanel(condition = "input.heatmap == 'hgeneset'",
uiOutput("pick.pathway")),
radioButtons("cluster", label = "Cluster",
- choices = list("Display Cluster" = 1, "Hide Cluster" = 2),
+ choices = list("Display" = 1, "Hide" = 2),
selected = 1),
actionButton("deButton", "Go", class = "btn btn-primary btn-bg centerbtn")
),
diff --git a/vizapp/tools/gc.R b/vizapp/tools/gc.R
index e0bf506..68f94cf 100644
--- a/vizapp/tools/gc.R
+++ b/vizapp/tools/gc.R
@@ -16,22 +16,22 @@ get.ct <- function(var) {
bx <-
paste(
"Relative Abudance of",
- input$symsearch,
+ 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$symsearch,
- input$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$symsearch)) > 2) {
+ "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$symsearch, "'", sep =
+ sql = paste("select * from file where symbol ='", var$gc_symsearch, "'", sep =
''),
sep = "\t"
)
@@ -41,7 +41,7 @@ get.ct <- function(var) {
statfile,
sql = paste(
"select * from file where symbol ='",
- var$symsearch,
+ var$gc_symsearch,
"'",
sep = ''
),
@@ -50,13 +50,13 @@ get.ct <- function(var) {
}
}
else {
- if (nchar(as.vector(var$enssearch)) > 2) {
+ if (nchar(as.vector(var$gc_enssearch)) > 2) {
cts <-
read.csv.sql(
ctfile,
sql = paste(
"select * from file where ENSEMBL ='",
- var$enssearch,
+ var$gc_enssearch,
"'",
sep = ''
),
@@ -68,7 +68,7 @@ get.ct <- function(var) {
statfile,
sql = paste(
"select * from file where ENSEMBL ='",
- var$enssearch,
+ var$gc_enssearch,
"'",
sep = ''
),
@@ -109,30 +109,23 @@ output$plot.gene <- renderPlot({
countTable <- forct()$ctable
par(oma = c(4, 4, 1, 1))
grpnames <- levels(factor(as.character(countTable$grp)))
- #boxplot(
- # countTable$cts ~ countTable$grp,
- # col = rainbow(length(grpnames)),
- #cex.axis = 0.7,
- # ylab = 'Relative Abundance (logCPM)',
- # las = 1,
- # main = input$groupname
- # )
- p <-
- ggplot(countTable, aes(x = grp, y = cts)) + ggtitle(input$groupname) +
- 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("")
+ 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')
@@ -159,20 +152,19 @@ output$Downloadbp <- downloadHandler(
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(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)
+ 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"
@@ -185,17 +177,17 @@ output$bxplot.desc <- renderText({
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))) + 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("")
+ 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')
@@ -224,14 +216,14 @@ output$Downloadvp <- downloadHandler(
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(legend.position =
- "none",
- axis.text.x = element_text(
- angle = 45,
- hjust = 1,
- vjust = 1
- )) + ylab("Relative Abundance (logCPM)") + xlab("")
+ 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)
dev.off()
},
diff --git a/vizapp/tools/gc_ui.R b/vizapp/tools/gc_ui.R
index b9903c0..ce5106d 100644
--- a/vizapp/tools/gc_ui.R
+++ b/vizapp/tools/gc_ui.R
@@ -4,8 +4,8 @@ output$ui_gc <- renderUI({
fluidRow(
sidebarPanel(
uiOutput("pick.group"),
- textInput("symsearch", "Search By Gene Symbol", 'IL1B'),
- textInput("enssearch", "Search By ENS ID", ''),
+ textInput("gc_symsearch", "Search By Gene Symbol", 'IL1B'),
+ textInput("gc_enssearch", "Search By ENS ID", ''),
actionButton("gcButton", "GO", class = "btn btn-primary btn-bg centerbtn")
),
column(7,
diff --git a/vizapp/tools/qc_ui.R b/vizapp/tools/qc_ui.R
index 5c9168c..a921f70 100644
--- a/vizapp/tools/qc_ui.R
+++ b/vizapp/tools/qc_ui.R
@@ -4,7 +4,7 @@ output$ui_qc <- renderUI({
fluidRow(
sidebarPanel(
uiOutput("dir.qc"),
- p("Click it to load data"),
+ p("Click to load data"),
actionButton("qcButton", "GO", class = "btn btn-primary btn-bg centerbtn")
),
column(7,
diff --git a/workflow/scripts/dea.R b/workflow/scripts/dea.R
index 2a6cd27..79128e5 100644
--- a/workflow/scripts/dea.R
+++ b/workflow/scripts/dea.R
@@ -65,13 +65,13 @@ dds <- DESeq(dds)
rld <- rlogTransformation(dds, blind=TRUE)
sampleDists <- dist(t(assay(rld)))
-png(file="samples_heatmap.png",bg ="transparent",height=768,width=1024)
+png(file="samples_heatmap.png",bg ="white",height=768,width=1024)
par(mar=c(7,4,4,2)+0.1)
heatmap.2(as.matrix(sampleDists), col = bluered(100),RowSideColors = col.blocks,srtRow=45,srtCol=45,trace="none", margins=c(8,8), cexRow = 1.5, cexCol = 1.5)
dev.off()
#Compare Samples using PCA
-png(file="pca.png",bg ="transparent",height=768,width=1024,res = 150)
+png(file="pca.png",bg ="white",height=768,width=1024)
print(plotPCA(rld, intgroup="SampleGroup"),col.hab=col.blocks)
dev.off()
@@ -125,7 +125,7 @@ design <- model.matrix(~grps)
d <- DGEList(counts=countTable,group=grps,lib.size=libSizes)
d <- calcNormFactors(d)
d <- estimateCommonDisp(d)
-png(file="mds.png",bg ="transparent",height=768,width=1024)
+png(file="mds.png",bg ="white",height=768,width=1024)
plotMDS(d, labels=grps,col=col.blocks, cex.axis=1.5, cex.lab=1.5, cex=1.5)
op <- par(cex = 1.5)
legend("topleft",legend=grpnames,col=rainbow(length(grpnames)),pch=20)
--
GitLab