--- a
+++ b/server.R
@@ -0,0 +1,510 @@
+shinyServer(function(input, output, session) {
+ options(shiny.maxRequestSize=500*1024^2)
+ library(edgeR)
+ library(limma)
+ library(DESeq2)
+ library(caret)
+ library(kernlab)
+ library(randomForest)
+ library(sSeq)
+ library(plyr)
+ library(pamr)
+ library(sfsmisc)
+ library(foreach)
+ library(digest)
+ library(RColorBrewer)
+ library(gplots)
+ library(d3heatmap)
+ library(igraph)
+ library(DT)
+ library(miRNAtap)
+ library(topGO)
+ library(org.Hs.eg.db)
+
+
+ source("allFunctions.R")
+
+ ## Source codes of PLDA (Witten et. al.)
+ source("Classify.cv.R")
+ source("Classify.R")
+ source("CountDataSet.R")
+ source("FindBestTransform.R")
+ source("Functions.R")
+ source("NullModel.R")
+ source("NullModelTest.R")
+ source("PoissonDistance.R")
+
+ ## Source codes of NBLDA
+ source("classnb.R")
+ source("CountDataSet1.R")
+ source("GetDnb.R")
+
+ ## Source codes of voom classifiers
+ source("voomGSD.R")
+ source("weighted.stats.R")
+ source("voomNSC.train.R")
+ source("predict.voomNSC.R")
+ source("voomDDA.train.R")
+ source("predict.voomDDA.R")
+
+ observe({
+ if (input$varF){
+ dat = t(dataM())
+ nZ = nearZeroVar(dat,saveMetrics = FALSE)
+ updateTextInput(session, inputId = "maxVar", label = "Number of genes with maximum variance", value = as.character(ncol(dat) - length(nZ)))
+ }
+ })
+
+
+ dataM <- reactive({ ## Data input.
+ if(input$dataInput==1){ ## Load example data.
+
+ if(input$sampleData==1){
+ data <- read.table("cervical_train.txt", header=TRUE)
+ }
+
+ else if(input$sampleData==2){
+ data <- read.table("lung_train.txt", header=TRUE)
+ }
+ }
+
+ else if(input$dataInput==2){ ## Upload data. Train
+
+ inFile <- input$uploadTrain
+ mySep <- switch(input$fileSepDF, '1'=",",'2'="\t",'3'=";", '4'="")
+
+ if (is.null(input$uploadTrain)) {return(NULL)}
+
+ if (file.info(inFile$datapath)$size <= 10485800){
+ data <- read.table(inFile$datapath, sep=mySep, header=TRUE, fill=TRUE, na.strings = c("", "NA","."))
+ }
+
+ else print("File is bigger than 10MB and will not be uploaded.")
+ }
+ return(data)
+ })
+
+ dataC <- reactive({ ## Data input. Conditions
+ if(input$dataInput==1){ ## Load example data.
+
+ if(input$sampleData==1){
+ data <- read.table("cervical_cond.txt", header=FALSE, sep="\t")
+ }
+
+ else if(input$sampleData==2){
+ data <- read.table("lung_cond.txt", header=FALSE, sep="\t")
+ }
+ }
+
+ if(input$dataInput==2){ ## Upload data.
+
+ inFile <- input$uploadCond
+ mySep <- switch(input$fileSepDF, '1'=",",'2'="\t",'3'=";", '4'="")
+
+ if (is.null(input$uploadCond)) {return(NULL)}
+
+ if (file.info(inFile$datapath)$size <= 10485800){
+ data <- read.table(inFile$datapath, sep=mySep, header=FALSE, fill=TRUE, na.strings = c("", "NA","."),
+ stringsAsFactors = TRUE, colClasses = "character")
+ }
+
+ else print("File is bigger than 10MB and will not be uploaded.")
+ }
+ return(data)
+ })
+
+ dataT <- reactive({ ## Data input.
+
+ if(input$dataInput==1){ ## Load example data.
+
+ if(input$sampleData==1){
+ data <- read.table("cervical_test.txt", header=TRUE)
+ }
+
+ else if(input$sampleData==2){
+ data <- read.table("lung_test.txt", header=TRUE)
+ }
+ }
+
+ if(input$dataInput==2){ ## Upload data.
+
+ inFile <- input$uploadTest
+ mySep <- switch(input$fileSepDF, '1'=",",'2'="\t",'3'=";", '4'="")
+
+ if (is.null(input$uploadTest)) {return(NULL)}
+
+ if (file.info(inFile$datapath)$size <= 10485800){
+ data <- read.table(inFile$datapath, sep=mySep, header=TRUE, fill=TRUE, na.strings = c("", "NA","."))
+ }
+
+ else print("File is bigger than 10MB and will not be uploaded.")
+ }
+ return(data)
+ })
+
+
+ output$RawDataTrain <- DT::renderDataTable({
+ dataTrain <- dataM()
+ conditions <- dataC()[,1]
+ dataTrain <- dataTrain[order(rownames(dataTrain)),]
+
+ col_dots = rep("...", 10)
+ row_dots = rep("...", 15)
+
+ ## Buraya data wiev için bir fonsiyon yazılacak.
+ rawTrain = rbind(data.frame(dataTrain[1:8, c(1:12)], col_dots = rep("...", 8),
+ dataTrain[1:8, c(dim(dataTrain)[2]-1, dim(dataTrain)[2])]),
+ row_dots, cbind(dataTrain[c(dim(dataTrain)[1]-1,dim(dataTrain)[1]), 1:12], col_dots = c("...","..."),
+ dataTrain[c(dim(dataTrain)[1]-1,dim(dataTrain)[1]), c(dim(dataTrain)[2]-1,
+ dim(dataTrain)[2])]))
+ return(rawTrain)
+
+
+
+ })
+
+
+ output$RawDataTest <- DT::renderDataTable({
+ dataTest <- dataT()
+ dataTest <- dataTest[order(rownames(dataTest)),]
+
+ return(dataTest)
+
+
+
+ })
+
+
+ output$trainConsole <- renderPrint({
+
+ if(input$runVoomDDA){
+ dataTrain <- dataM()
+ conditions <- as.factor(dataC()[,1])
+ dataTest <- dataT()
+ dataTrain <- dataTrain[order(rownames(dataTrain)),]
+ dataTest <- dataTest[order(rownames(dataTest)),]
+
+ ## Control steps
+ trGenes <- sort(rownames(dataTrain))
+ tsGenes <- sort(rownames(dataTest))
+
+ if (!identical(trGenes, tsGenes)) stop(warning("Gene names should be identical for both training and test data sets."))
+ if (ncol(dataTrain) != length(conditions)) stop(warning("Number of conditions and sample size do not match."))
+
+ ## Filtering
+
+ if (input$nearZeroF){
+ nZ = nearZeroVar(t(dataTrain),saveMetrics = FALSE)
+ if(length(nZ) != 0){
+ dataTrain = dataTrain[-nZ,]
+ dataTest = dataTest[-nZ,]
+ }
+ }
+
+ if (input$varF){
+ ## Variance Filtering
+ vars = apply(log(dataTrain+1),1,var)
+ idx = order(vars, decreasing = TRUE)
+ dataTrain <- dataTrain[idx[1:input$maxVar],]
+ dataTest <- dataTest[rownames(dataTrain),]
+ }
+
+ ###
+ if (input$models == "vDLDA") model = voomDDA.train(counts = dataTrain, conditions = conditions, normalization = input$normMeth, TRUE)
+ if (input$models == "vDQDA") model = voomDDA.train(counts = dataTrain, conditions = conditions, normalization = input$normMeth, FALSE)
+ if (input$models == "vNSC") model = voomNSC.train(counts = dataTrain, conditions = conditions, normalization = input$normMeth)
+
+ cat("Model Summary:", "\n")
+ cat("-----------------------------------------","\n")
+ cat(paste("Raw Data"),"\n")
+ cat(paste(" Data includes the read counts of ", dim(dataM())[1], " genes belong to ", dim(dataM())[2], " observations.", sep=""),"\n\n")
+
+ if (input$nearZeroF){
+ cat(paste("Near-zero filtering"), "\n")
+ cat(paste(" ", length(nZ), " out of ", dim(dataM())[1]," genes are filtered.", sep=""), "\n\n")
+ }
+
+ if (input$varF){
+ cat(paste("Variance filtering"), "\n")
+ cat(paste(" ", input$maxVar, " genes are selected based on their maximum variance.",sep=""), "\n")
+ }
+ cat("-----------------------------------------","\n\n")
+
+
+ if ("trSummary" %in% input$advOpts){
+ if (input$models != "vNSC") trainSummary <- caret::confusionMatrix(table(Actual = conditions, Predicted = predict.voomDDA(model, dataTrain)))
+ if (input$models == "vNSC") trainSummary <- caret::confusionMatrix(table(Actual = conditions, Predicted = predict.voomNSC(model, dataTrain)))
+
+ cat("Training Summary:","\n")
+ cat("-----------------------------------------","\n")
+ caret:::print.confusionMatrix(trainSummary)
+ cat("-----------------------------------------","\n\n")
+ }
+
+ if (input$models != "vNSC") Predicted = predict.voomDDA(model, dataTest)
+ if (input$models == "vNSC") Predicted = predict.voomNSC(model, dataTest)
+
+ cat("Predictions:","\n")
+ cat("-----------------------------------------","\n")
+ cat(paste(c(" ", as.character(Predicted)), sep=""), "\n\n")
+
+ if ("selGenes" %in% input$advOpts){
+ if (input$models == "vNSC"){
+ selectedGenes <- model$SelectedGenes[[which(model$threshold == model$opt.threshold)]]
+ cat(paste("Selected Genes (voomNSC): ", length(selectedGenes), " out of ", dim(dataTrain)[1], " genes are selected", sep=""),"\n")
+ cat("-----------------------------------------","\n")
+ cat(paste(selectedGenes,"\n"))
+ }}
+
+
+ heatMapData <- reactive({
+
+
+ if (input$models == "vNSC"){
+ nSelFeat <- length(selectedGenes)
+ if (nSelFeat < 2) stop(warning("At least 2 features should be selected in the model. Heatmap can not be drawn with 1 feature."))
+ }
+
+ dataTrain_HM <- dataM()
+ HM_data <- t(log2(t(dataTrain_HM + 0.5)/(apply(dataTrain_HM, 2, sum) + 1) * 1e+06))
+
+ if (input$models == "vNSC") HM_data <- HM_data[selectedGenes,]
+ if (input$models != "vNSC") HM_data <- HM_data[rownames(dataTrain),]
+
+ if (input$centerHeat) HM_data <- scale(as.matrix(HM_data), scale = FALSE)
+ hmcol = colorRampPalette(brewer.pal(8, "GnBu"))(250)
+
+
+ return(HM_data)
+ })
+
+
+
+
+
+ output$heatMap <- renderD3heatmap({
+ if ((input$runHeatMap)){
+
+ #heatmap.2(HM_data, col = hmcol, trace="none", margin=c(10, 6))
+ if(input$darkTheme){
+ d3heatmap(heatMapData(), theme = "dark", color = input$colorsHM, width = "800px", height = "1800px")
+ }else{
+
+ d3heatmap(heatMapData(), theme = "", color = input$colorsHM, width = "800px", height = "1800px")
+
+ }
+ }
+
+ })#, height = 800, width = 800)
+
+
+ output$newtwork <- renderPlot({
+
+ if ((input$runNetwork)){
+ cor_mat = cor = cor(t(heatMapData()))
+ diag(cor_mat)<-0
+ graph<-graph.adjacency(cor_mat,weighted=TRUE,mode="upper")
+ E(graph)[ weight>0.7 ]$color <- "green"
+ E(graph)[ weight < -0.7 ]$color <- "red"
+ E(graph)[ weight>0.6 & weight < 0.7 ]$color <- "black"
+ E(graph)[ weight< -0.6 & weight > -0.7 ]$color <- "black"
+ plot(graph)
+ }
+
+ }, height = 650, width = 650)
+
+
+
+ if(input$models == "vNSC"){
+ observe({
+ updateSelectInput(session, "showResults", choices = selectedGenes[3:length(selectedGenes)], selected = selectedGenes[3:length(selectedGenes)][1])
+ })
+ }
+
+ observe({
+ if(input$goAlgorithm == "classic" || input$goAlgorithm == "elim" || input$goAlgorithm == "weight01" || input$goAlgorithm == "lea"){
+
+ updateSelectInput(session, "goStatistic", choices = c("ks"="ks", "fisher"="fisher", "t"="t", "ks.ties"="ks.ties"), selected = "ks")
+ }else {
+
+ updateSelectInput(session, "goStatistic", choices = c("fisher"="fisher"), selected = "fisher")
+ }
+ })
+
+
+ observe({
+ if(input$goGeneAlgorithm == "classic" || input$goGeneAlgorithm == "elim" || input$goGeneAlgorithm == "weight01" || input$goGeneAlgorithm == "lea"){
+
+ updateSelectInput(session, "goGeneStatistic", choices = c("ks"="ks", "fisher"="fisher", "t"="t", "ks.ties"="ks.ties"), selected = "ks")
+ }else {
+
+ updateSelectInput(session, "goGeneStatistic", choices = c("fisher"="fisher"), selected = "fisher")
+ }
+ })
+
+ geneOntology <- reactive({
+
+ if(input$runRNAGO && input$miRNAorGene == 1){
+ mir = input$showResults
+ predictions = getPredictedTargets(mir, species = 'hsa', method = 'geom', min_src = 2)
+ rankedGenes = predictions[,'rank_product']
+ selection = function(x) TRUE
+ allGO2genes = annFUN.org(whichOnto=input$ontology, feasibleGenes = NULL, mapping="org.Hs.eg.db", ID = "entrez")
+ GOdata = new('topGOdata', ontology = input$ontology, allGenes = rankedGenes,
+ annot = annFUN.GO2genes, GO2genes = allGO2genes,
+ geneSel = selection, nodeSize=10)
+ results = runTest(GOdata, algorithm = input$goAlgorithm, statistic = input$goStatistic)
+ allRes = GenTable(GOdata, statistic = results, orderBy = "statistic", topNodes = input$topRNAs)
+ allRes = allRes[,c('GO.ID','Term','statistic')]
+ colnames(allRes)[1] = "GO ID"
+ colnames(allRes)[3] = input$goStatistic
+ return(allRes)
+
+
+ }
+ if(input$runGeneGO && input$miRNAorGene == 2){
+ data = dataM()
+ condition = as.factor(dataC()[,1])
+ design = model.matrix(~condition)
+
+ dge = DGEList(counts=as.matrix(data), group = condition)
+ dge = calcNormFactors(dge, method = input$normMeth) #webtool'da var. RLE dediği deseq, TMM dediği TMM, none dediği none
+ v = voom(dge,design, plot=F)
+ fit = lmFit(v, design)
+ fit = eBayes(fit)
+ res = topTable(fit, coef=ncol(design), number = dim(data)[1])
+ geneList = res$adj.P.Val #voomNSC tarafından seçilen genler
+ names(geneList) = rownames(res) #voomNSC tarafından seçilen genler
+ biomarkers = selectedGenes #voomNSC tarafından seçilen genler
+
+ truefalse = function(allScore) {
+ truefalse = is.element(names(geneList), biomarkers)
+ return(truefalse)
+ }
+
+ allGO2genes = annFUN.org(whichOnto=input$ontologyGene, feasibleGenes = NULL,
+ mapping="org.Hs.eg.db", ID = "symbol")
+
+ GOdata = new('topGOdata', ontology = input$ontologyGene, allGenes = geneList,
+ annot = annFUN.GO2genes, GO2genes = allGO2genes,
+ geneSel = truefalse, nodeSize=10)
+
+ results = runTest(GOdata, algorithm = input$goGeneAlgorithm, statistic = input$goGeneStatistic)
+
+ allRes = GenTable(GOdata, statistic = results, orderBy = "statistic", topNodes = input$topGenes)
+ allRes = allRes[,c('GO.ID','Term','statistic')]
+ colnames(allRes)[1] = "GO ID"
+ colnames(allRes)[3] = input$goGeneStatistic
+ return(allRes)
+
+ }
+ else{
+ return(allRes = NULL)
+ }
+
+ })
+
+
+
+ geneOntologyPlot <- reactive({
+
+ if(input$runVoomDDA){
+ if(input$miRNAorGene == 1){
+ mir = input$showResults
+ predictions = getPredictedTargets(mir, species = 'hsa', method = 'geom', min_src = 2)
+ rankedGenes = predictions[,'rank_product']
+ selection = function(x) TRUE
+ allGO2genes = annFUN.org(whichOnto=input$ontology, feasibleGenes = NULL, mapping="org.Hs.eg.db", ID = "entrez")
+ GOdata = new('topGOdata', ontology = input$ontology, allGenes = rankedGenes,
+ annot = annFUN.GO2genes, GO2genes = allGO2genes,
+ geneSel = selection, nodeSize=10)
+ results = runTest(GOdata, algorithm = input$goAlgorithm, statistic = input$goStatistic)
+ showSigOfNodes(GOdata, score(results), firstSigNodes = 5, useInfo = 'all')
+
+
+
+ }
+ if(input$miRNAorGene == 2){
+ data = dataM()
+ condition = as.factor(dataC()[,1])
+ design = model.matrix(~condition)
+
+ dge = DGEList(counts=as.matrix(data), group = condition)
+ dge = calcNormFactors(dge, method = input$normMeth) #webtool'da var. RLE dediği deseq, TMM dediği TMM, none dediği none
+ v = voom(dge,design, plot=F)
+ fit = lmFit(v, design)
+ fit = eBayes(fit)
+ res = topTable(fit, coef=ncol(design), number = dim(data)[1])
+ geneList = res$adj.P.Val #voomNSC tarafından seçilen genler
+ names(geneList) = rownames(res) #voomNSC tarafından seçilen genler
+ biomarkers = selectedGenes #voomNSC tarafından seçilen genler
+
+ truefalse = function(allScore) {
+ truefalse = is.element(names(geneList), biomarkers)
+ return(truefalse)
+ }
+
+ allGO2genes = annFUN.org(whichOnto=input$ontologyGene, feasibleGenes = NULL,
+ mapping="org.Hs.eg.db", ID = "symbol")
+
+ GOdata = new('topGOdata', ontology = input$ontologyGene, allGenes = geneList,
+ annot = annFUN.GO2genes, GO2genes = allGO2genes,
+ geneSel = truefalse, nodeSize=10)
+
+ results = runTest(GOdata, algorithm = input$goGeneAlgorithm, statistic = input$goGeneStatistic)
+ showSigOfNodes(GOdata, score(results), firstSigNodes = 5, useInfo = 'all')
+
+ }
+
+ }
+
+ })
+
+
+ output$geneOntologyTable <- DT::renderDataTable({
+
+ if(input$runRNAGO || input$runGeneGO){
+
+
+ datatable(geneOntology(), extensions = c('Buttons','KeyTable', 'Responsive'), options = list(
+ dom = 'Bfrtip',
+ buttons = c('copy', 'csv', 'excel', 'pdf', 'print'), keys = FALSE, pageLength = 20
+ ))
+
+
+ }else{return(NULL)}
+
+ })
+
+ #output$geneOntologyPlot <- renderPlot({
+
+ #if(input$includePlot){
+ # geneOntologyPlot()
+ #
+ # }
+ #})
+
+
+ output$downloadGoPlot <- downloadHandler(
+
+ filename <- function() { paste('GOplot.pdf') },
+ content <- function(file) {
+ pdf(file)
+ if(input$runVoomDDA == 0){stop('First, run voomDDA')}
+ else{
+ geneOntologyPlot()
+ }
+ dev.off()
+ },
+ contentType = 'application/pdf'
+ )
+
+ }
+ })
+
+})
+
+
+
+
+
Datasets
Models
