# 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) 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=flist) }) output$pick.pathway <- renderUI({ 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='/') 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))) 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='') })