inst/protXploRApp/server.R

options(shiny.maxRequestSize=100*1024^2) 
options(shiny.trace=FALSE)
options(shiny.reactlog=TRUE)

library(DAPAR)
library(DAPARdata)
library(shiny)
library(rhandsontable)
library(data.table)
library(shinyjs)
library(shinyAce)
library(highcharter)

library(rhandsontable)
library(data.table)
library(reshape2)
library(DT)
library(MSnbase)
library(openxlsx)
library(sm)
library(imp4p)
library(highcharter)
#if (!interactive()) sink(stderr(), type = "output")
#source(file.path("server", "anaDiff.R"),  local = TRUE)$value

shinyServer(function(input, output, session) {
    load("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/matSharedPeptides.RData")
    load("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/matUniquePeptides.RData")
    
    rv <- reactiveValues(
        dataset = list(original = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Original.MSnset"),
                       filtered = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Filtered.MSnset"),
                       normalized = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Normalized.MSnset"),
                       imputed = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_pept_Imputed.MSnset"),
                       aggregated = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_prot_Aggregated.MSnset"),
                       anaDiff = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_prot_AnaDiff.MSnset")),
        current.obj = readRDS("/Volumes/Data/Projets/KDD-Tools/Bioproj/ProtXploR/trunk/ProtXploR/inst/extdata/Exp1_R25_prot_AnaDiff.MSnset"),
        matSharedPeptides = matSharedPeptides,
        matUniquePeptides = matUniquePeptides
    )
    
    set.seed(122)
    histdata <- rnorm(500)
    
    output$plot1 <- renderPlot({
        data <- histdata[seq_len(input$slider)]
        hist(data)
    })
    
    
    
    getDataInfosVolcano <- reactive({
        input$eventPointClicked
        rv$current.obj
        if (is.null(rv$current.obj)){ return()}
        
        test.table <- data.frame(lapply(
            Biobase::exprs(rv$current.obj)[(input$eventPointClicked+1),], 
            function(x) t(data.frame(x))))
        rownames(test.table) <- rownames(rv$current.obj)[input$eventPointClicked +1]
        test.table <- round(test.table, digits=3)
        test.table
    })
    
    
    getUniquePeptidesInfos <- reactive({
        input$eventPointClicked
        #rv$current.obj
        #if (is.null(rv$current.obj)){ return()}
        
        indiceUniquePeptides <- indicePeptides <- NULL
        print(input$eventPointClicked +1)
        indicePeptides <- which(rv$matSharedPeptides[,input$eventPointClicked +1] ==1)
         for (i in indicePeptides){
             if (sum(rv$matSharedPeptides[i,]) == 1)
                 {
                 indiceUniquePeptides <- i
             }
         }
        print(indicePeptides)
        
        print(indiceUniquePeptides)
        #print(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
        test.table <- NULL
        test.table <- data.frame(lapply(
            Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,], 
            function(x) t(data.frame(x))))
        #test.table <- data.frame(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
        if (dim(test.table) != c(0,0)){
            colnames(test.table) <- colnames(Biobase::exprs(rv$dataset[['original']]))
            rownames(test.table) <- rownames(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
            }
        #rownames(test.table) <- 1:length(indiceUniquePeptides)
        test.table <- round(test.table, digits=3)
        test.table
    })
    
    
    
    getSharedPeptidesInfos <- reactive({
        input$eventPointClicked
        #rv$current.obj
        #if (is.null(rv$current.obj)){ return()}
        
        
        indiceSharedePeptides <- indicePeptides <- NULL
        print(input$eventPointClicked +1)
        indicePeptides <- which(rv$matSharedPeptides[,input$eventPointClicked +1] ==1)
        for (i in indicePeptides){
            if (sum(rv$matSharedPeptides[i,]) > 1)
            {
                indiceSharedePeptides <- i
            }
        }
        print(indicePeptides)
        
        print(indiceSharedePeptides)
        #print(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
        test.table <- NULL
        test.table <- data.frame(lapply(
            Biobase::exprs(rv$dataset[['original']])[indiceSharedePeptides,], 
            function(x) t(data.frame(x))))
        print(dim(test.table))
        #test.table <- data.frame(Biobase::exprs(rv$dataset[['original']])[indiceUniquePeptides,])
        if (dim(test.table) != c(0,0)){
            colnames(test.table) <- colnames(Biobase::exprs(rv$dataset[['original']]))
            rownames(test.table) <- rownames(Biobase::exprs(rv$dataset[['original']])[indiceSharedePeptides,])
            }
        #rownames(test.table) <- 1:length(indiceUniquePeptides)
        test.table <- round(test.table, digits=3)
        test.table
    })
    
    
    
    output$volcanoplot_rCharts <- renderHighchart({
        #input$eventPointClicked
        #rv$current.obj
        #if (is.null(rv$current.obj)){ return()}
        
        if (length(which(is.na(Biobase::exprs(rv$current.obj)))) > 0) {
            return()}
        
        result = tryCatch(
            {
                
                if ("logFC" %in% names(fData(rv$current.obj) )){
                    
                    df <- data.frame(x=fData(rv$current.obj)$logFC, 
                                     y = -log10(fData(rv$current.obj)$P_Value),
                                     index = as.character(rownames(rv$current.obj)),
                                     stringsAsFactors = FALSE)
                    #if (!is.null(input$tooltipInfo)){
                    #    df <- cbind(df,fData(rv$current.obj)[input$tooltipInfo])
                    #}
                    rownames(df) <- rownames(rv$current.obj)
                    colnames(df) <- gsub(".", "_", colnames(df), fixed=TRUE)
                    names(rv$current.obj@experimentData@other) <- gsub(".", "_", names(rv$current.obj@experimentData@other), fixed=TRUE)
                    
                    if (ncol(df) > 3){
                        colnames(df)[4:ncol(df)] <- 
                            paste("tooltip_", colnames(df)[4:ncol(df)], sep="")
                    }
                    hc_clickFunction <- 
                        JS("function(event) {Shiny.onInputChange('eventPointClicked', [this.index]);}")
                    #             print("avant 5")
                    cond <- c(rv$current.obj@experimentData@other$condition1,
                              rv$current.obj@experimentData@other$condition2)
                    diffAnaVolcanoplot_rCharts(df,
                                               threshold_logFC = rv$current.obj@experimentData@other$threshold_logFC,
                                               conditions = cond,
                                               clickFunction=hc_clickFunction) 
                } else {
                   
                }
            }
            , warning = function(w) {
                shinyjs::info(conditionMessage(w))
            }, error = function(e) {
                shinyjs::info(paste("titi",match.call()[[1]],":",
                                    conditionMessage(e),
                                    sep=" "))
            }, finally = {
                #cleanup-code
            })
    })

    
    
    output$infosUniquePeptidesTable <- DT::renderDataTable({
        rv$current.obj
        input$eventPointClicked
        
        if (is.null(input$eventPointClicked)){return()}
        if (is.null(rv$current.obj)){return()}
        
        data <- as.matrix(rv$current.obj@experimentData@other$isMissingValues)[input$eventPointClicked,]
        print(input$eventPointClicked)
        id <-  which(data==1)
        if (length(id) == 0){
            dat <- DT::datatable(getUniquePeptidesInfos(), 
                                 options=list(dom='t',ordering=F))
        } else {
            dat <- DT::datatable(getUniquePeptidesInfos(), 
                                 options=list(dom='t',
                                              ordering=F
                                              ,drawCallback=JS(
                                                  paste("function(row, data) {",
                                                        paste(sapply(1:ncol(getUniquePeptidesInfos()),function(i)
                                                            paste( "$(this.api().cell(",
                                                                   id %% nrow(getUniquePeptidesInfos()),",",
                                                                   id / nrow(getUniquePeptidesInfos()),
                                                                   ").node()).css({'background-color': 'lightblue'});")
                                                        ),collapse = "\n"),"}" ))
                                              ,server = FALSE))
        }
        dat
        
    })
    
    
    
    output$infosSharedPeptidesTable <- DT::renderDataTable({
        rv$current.obj
        input$eventPointClicked
        
        if (is.null(input$eventPointClicked)){return()}
        if (is.null(rv$current.obj)){return()}
        
        data <- as.matrix(rv$current.obj@experimentData@other$isMissingValues)[input$eventPointClicked,]
        print(input$eventPointClicked)
        id <-  which(data==1)
        if (length(id) == 0){
            dat <- DT::datatable(getSharedPeptidesInfos(), 
                                 options=list(dom='t',ordering=F))
        } else {
            dat <- DT::datatable(getSharedPeptidesInfos(), 
                                 options=list(dom='t',
                                              ordering=F
                                              ,drawCallback=JS(
                                                  paste("function(row, data) {",
                                                        paste(sapply(1:ncol(getSharedPeptidesInfos()),function(i)
                                                            paste( "$(this.api().cell(",
                                                                   id %% nrow(getSharedPeptidesInfos()),",",
                                                                   id / nrow(getSharedPeptidesInfos()),
                                                                   ").node()).css({'background-color': 'lightblue'});")
                                                        ),collapse = "\n"),"}" ))
                                              ,server = FALSE))
        }
        dat
        
    })
    
    
    
    output$infosVolcanoTable <- DT::renderDataTable({
        rv$current.obj
        input$eventPointClicked
        
        if (is.null(input$eventPointClicked)){return()}
        if (is.null(rv$current.obj)){return()}
        
        data <- as.matrix(rv$current.obj@experimentData@other$isMissingValues)[input$eventPointClicked,]
        #print(data)
        id <-  which(data==1)
        if (length(id) == 0){
            dat <- DT::datatable(getDataInfosVolcano(), 
                                 options=list(dom='t',ordering=F))
        } else {
            dat <- DT::datatable(getDataInfosVolcano(), 
                                 options=list(dom='t',
                                              ordering=F
                                              ,drawCallback=JS(
                                                  paste("function(row, data) {",
                                                        paste(sapply(1:ncol(getDataInfosVolcano()),function(i)
                                                            paste( "$(this.api().cell(",
                                                                   id %% nrow(getDataInfosVolcano()),",",
                                                                   id / nrow(getDataInfosVolcano()),
                                                                   ").node()).css({'background-color': 'lightblue'});")
                                                        ),collapse = "\n"),"}" ))
                                              ,server = FALSE))
        }
        dat
        
    })


    
})
samWieczorek/ProtXploR documentation built on May 30, 2019, 8:16 a.m.