inst/protXploRApp/server/aggregation.R

In samWieczorek/ProtXploR: Provides a GUI for DAPAR

########################################################
RunAggregation <- reactive({
    rv$matAdj
    if (is.null(rv$matAdj)) { return (NULL)}
    
    n <- NULL
    if (input$aggregationMethod == gAgregateMethod[["sum on top n"]]) { 
        n <- as.numeric(input$nTopn)
        }
    
    
    tryCatch (
        {
            if (input$checkSharedPeptides){
                data <- pepAgregate(rv$current.obj, 
                                    input$proteinId,
                                    input$aggregationMethod, 
                                    rv$matAdj$matWithSharedPeptides, 
                                    n)
                txt <- paste(
                    "data <- pepAgregate(current.obj, '",
                    input$proteinId, "', '",
                    input$aggregationMethod, 
                    "', mat$matWithSharedPeptides,",n,")",
                    sep=""
                )
                writeToCommandLogFile(txt)
                
                
            }else{
                data <- pepAgregate(rv$current.obj, 
                                    input$proteinId,
                                    input$aggregationMethod, 
                                    rv$matAdj$matWithUniquePeptides
                                    , n)
                writeToCommandLogFile(
                    paste(
                        "data <- pepAgregate(current.obj, '",
                        input$proteinId, "', '",
                        input$aggregationMethod, 
                        "', mat$matWithUniquePeptides,",n,")",
                        sep=""
                    )
                )
            }
            
            return(data)
        },
        err=function(errorCondition) {
            cat("in err handler")
            message(errorCondition)
        })
    
    
    
})




##' -- Validate the aggregation ---------------------------------------
##' @author Samuel Wieczorek
observeEvent(input$valid.aggregation,{ 
    input$nbPeptides
    input$filterProtAfterAgregation
    input$aggregationMethod
    input$columnsForProteinDataset.box
    rv$matAdj
    
    if (is.null(input$valid.aggregation) 
        || (input$valid.aggregation == 0)
        || is.null(rv$matAdj) || is.null(rv$temp.aggregate)) 
    {return(NULL)}
    
    
    result = tryCatch(
        {
            
            isolate({
                
                ##concatenation des informations
                m <- NULL
                if (input$checkSharedPeptides){ 
                    m <- rv$matAdj$matWithSharedPeptides
                    writeToCommandLogFile("m <- mat$matWithSharedPeptides")
                }else{ m <-rv$matAdj$matWithUniquePeptides
                writeToCommandLogFile("m <- mat$matWithUniquePeptides")
                }
                #updatePB(session,inputId="pb_SaveAggregation",value=10,text_value="10 %", striped = TRUE, active=TRUE)
                
                
                #total <- 60
                #delta <- round(total / length(input$columnsForProteinDataset.box))
                #cpt <- 10
                for(c in input$columnsForProteinDataset.box){
                    newCol <- BuildColumnToProteinDataset(
                        Biobase::fData(rv$current.obj), m, c)
                    cnames <- colnames(Biobase::fData(rv$temp.aggregate))
                    Biobase::fData(rv$temp.aggregate) <- 
                        data.frame(Biobase::fData(rv$temp.aggregate), newCol)
                    colnames(Biobase::fData(rv$temp.aggregate)) <- c(cnames, c)
                    #cpt <- cpt + delta
                    #updatePB(session,inputId="pb_SaveAggregation",value=cpt,text_value=paste(cpt," %", sep=""), striped = TRUE, active=TRUE)
                    
                }
                
                #if (input$filterProtAfterAgregation){
                #    rv$temp.aggregate <- FilterProteinWithFewPeptides(rv$temp.aggregate, input$nbPeptides)
                #}
                
                rv$current.obj <- rv$temp.aggregate
                rv$typeOfDataset <-
                    rv$current.obj@experimentData@other$typeOfData
                name <- paste ("Aggregated", " - ", rv$typeOfDataset, sep="")
                rv$dataset[[name]] <- rv$current.obj
                
                #updatePB(session,inputId="pb_SaveAggregation",value=70,text_value="70 %", striped = TRUE, active=TRUE)
                
                
                
                ######
                l <- buildWritableVector(input$columnsForProteinDataset.box)
                writeToCommandLogFile(
                    paste("columnsForProteinDataset <- ",l, sep="") )
                
                writeToCommandLogFile("for (c in columnsForProteinDataset) {")
                writeToCommandLogFile(
                "newCol <- BuildColumnToProteinDataset(fData(current.obj), m, c)")
                writeToCommandLogFile("cnames <- colnames(fData(temp.aggregate))")
                writeToCommandLogFile("fData(temp.aggregate) <-
                                      data.frame(fData(temp.aggregate), newCol)")
                writeToCommandLogFile("colnames(fData(temp.aggregate)) <- c(cnames, c)")
                writeToCommandLogFile("}")
                writeToCommandLogFile("current.obj <- temp.aggregate")
                writeToCommandLogFile(
                    paste("dataset[['",name, "']] <- current.obj", sep="")
                )
                #updatePB(session,inputId="pb_SaveAggregation",value=90,text_value="90 %", striped = TRUE, active=TRUE)
                
                
                updateSelectInput(session, "datasets", 
                                  paste("Dataset versions of",
                                        rv$current.obj.name, sep=" "),
                                  choices = names(rv$dataset),
                                  selected = name)
                UpdateLog(
                    paste("Aggregation : peptides were aggregated into 
                          proteins with method =",
                          input$aggregationMethod,
                          ", include Shared Peptides = ", 
                          input$checkSharedPeptides,
                          ", protein id = ", input$proteinId, sep=" "),
                    name)
                rv$temp.aggregate <- NULL
                #updatePB(session,inputId="pb_SaveAggregation",value=100,text_value="100 %", striped = TRUE, active=TRUE)
                
            } )
            
        }
        , warning = function(w) {
            shinyjs::info(conditionMessage(w))
        }, error = function(e) {
            shinyjs::info(paste("Validate the agregation",":",
                                conditionMessage(e), sep=" "))
        }, finally = {
            #cleanup-code 
        })
    
    })





output$topNOption <- renderUI({
    input$aggregationMethod
    if(is.null(input$aggregationMethod )) {return(NULL)}
    
    if(input$aggregationMethod == gAgregateMethod[["sum on top n"]])
        numericInput("nTopn", "nTopn",value = NULL, min = 0)
    
})




#-----------------------------------------------
output$ObserverAggregationDone <- renderUI({
    rv$temp.aggregate
    input$perform.aggregation
    if (is.null(rv$temp.aggregate)) {return(NULL)}
    isolate({
        if (input$perform.aggregation == 0) 
        {return(NULL)  }
        else if (input$aggregationMethod != "none"){
            h3(paste("Aggregation done with the ", 
                     input$aggregationMethod, 
                     " method.", 
                     sep=""))
        }
        
    })
})





observeEvent(input$proteinId,{
    
    rv$current.obj
    if (is.null( input$proteinId) || (input$proteinId == "None"))
    {return(NULL)}
    
    
    if (rv$current.obj@experimentData@other$typeOfData == "protein") {
        return(NULL)}
    
    result = tryCatch(
        {
            matSharedPeptides <- BuildAdjacencyMatrix(rv$current.obj, 
                                                      input$proteinId,
                                                      FALSE)
            matUniquePeptides <- BuildAdjacencyMatrix(rv$current.obj, 
                                                      input$proteinId,
                                                      TRUE)
            
            rv$matAdj <- list(matWithSharedPeptides=matSharedPeptides,
                              matWithUniquePeptides=matUniquePeptides)
            
            writeToCommandLogFile(
            paste("matSharedPeptides <- BuildAdjacencyMatrix(current.obj,\"",
                      input$proteinId,"\",FALSE)", sep="")
            )
            writeToCommandLogFile(
            paste("matUniquePeptides <- BuildAdjacencyMatrix(current.obj,\"",
                      input$proteinId,"\",TRUE)", sep="")
            )
            
            writeToCommandLogFile(
            "mat <- list(matWithSharedPeptides=matSharedPeptides,
            matWithUniquePeptides=matUniquePeptides)"
    )
            
            
        }
    #, warning = function(w) {
    #    shinyjs::info(conditionMessage(w))
    #}
    , error = function(e) {
        shinyjs::info(paste("Build adjacency matrix:",
                            conditionMessage(e), 
                            sep=" "))
    }, finally = {
        #cleanup-code 
    })
    
})



#-----------------------------------------------
output$aggregationPlot <- renderPlot({
    input$proteinId
    rv$matAdj
    rv$current.obj
    if (is.null( input$proteinId) || (input$proteinId == "None")
        || is.null(rv$matAdj))
    {return(NULL)}
    if (is.null( rv$current.obj)){return(NULL)}
    
    
    if (input$checkSharedPeptides) {
        GraphPepProt(rv$matAdj$matWithSharedPeptides)
        }
    else {
        GraphPepProt(rv$matAdj$matWithUniquePeptides)
        }
    
})





output$aggregationStats <- renderUI ({
    input$proteinId
    rv$current.obj
    rv$matAdj
    if (is.null( input$proteinId) 
        || (input$proteinId == "None")
        || is.null(rv$matAdj))
    {return(NULL)}
    if (is.null( rv$current.obj)){return(NULL)}
    
    res <- getProteinsStats(rv$matAdj$matWithUniquePeptides, 
                            rv$matAdj$matWithSharedPeptides)
    
    text <- paste("<ul style=\"list-style-type:disc;\">
                  <li>
                  Number of peptides: ", 
                  nrow(rv$matAdj$matWithSharedPeptides),
                  "</li>
                  
                  <li>
                  Number of specific peptides: ", 
                  nrow(rv$matAdj$matWithUniquePeptides),
                  "</li>
                  
                  
                  <li>
                  Number of shared peptides: ",
                  nrow(rv$matAdj$matWithSharedPeptides)
                  -nrow(rv$matAdj$matWithUniquePeptides),
                  "</li>
                  
                  <li>
                  Number of proteins:  ", ncol(rv$matAdj$matWithSharedPeptides),
                  " </li>
                  <li>
                  Number of proteins only defined by specific peptides: ", 
                  length(res$protOnlyUniquePep), 
                  "</li>
                  
                  <li>
                  Number of proteins only defined by shared peptides:  ", 
                  length(res$protOnlySharedPep), 
                  "</li>
                  
                  <li>
                  Number of proteins defined both by shared and specific peptides:  ", 
                  length(res$protMixPep), 
                  "</li>
                  
                  </ul>" , sep="")
    
    
    
    
    HTML(text)
})

output$aggregationPlotShared <- renderPlot({
    
    rv$matAdj
    
    if (is.null(rv$matAdj)) {return(NULL)}
    result = tryCatch(
        {
            GraphPepProt(rv$matAdj$matWithSharedPeptides)
        }
        , warning = function(w) {
            shinyjs::info(conditionMessage(w))
        }, error = function(e) {
            shinyjs::info(paste(match.call()[[1]],":",conditionMessage(e), 
                                sep=" "))
        }, finally = {
            #cleanup-code 
        })
    
    
})


output$aggregationPlotUnique <- renderPlot({
    rv$matAdj
    
    if (is.null(rv$matAdj)) {return(NULL)}
    result = tryCatch(
        {
            GraphPepProt(rv$matAdj$matWithUniquePeptides)
        }
        , warning = function(w) {
            shinyjs::info(conditionMessage(w))
        }, error = function(e) {
            shinyjs::info(paste(match.call()[[1]],":",conditionMessage(e), 
                                sep=" "))
        }, finally = {
            #cleanup-code 
        })
    
    
})



###------------ Perform aggregation--------------------
observeEvent(input$perform.aggregation,{
    #input$perform.aggregation
    #input$aggregationMethod
    if (is.null(input$perform.aggregation) 
        || (input$perform.aggregation == 0))
    {return(NULL)}
    
    isolate({
        
        result = tryCatch(
            {
                if (input$aggregationMethod != "none")
                {
                    rv$temp.aggregate <- RunAggregation()
                    writeToCommandLogFile("temp.aggregate <- data")
                }
                
            }
            , warning = function(w) {
                shinyjs::info(conditionMessage(w))
            }, error = function(e) {
                shinyjs::info(paste(match.call()[[1]],":",conditionMessage(e), 
                                    sep=" "))
            }, finally = {
                #cleanup-code 
            })
        
        
        
        
    })
})








output$ChooseAggregationMethod <- renderUI({
    rv$current.obj
    if (is.null(rv$current.obj)) {return (NULL)}
    
    selectInput("aggregationMethod",
                "Aggregation methods",
                choices =  gAgregateMethod)
})


output$AggregationSideBar_Step1 <-  renderUI({
    rv$current.obj
    if (is.null(rv$current.obj) || 
        (rv$current.obj@experimentData@other$typeOfData == "protein"))
    {return (NULL)}
    
    wellPanel(id = "sidebar_Aggregation",
              height = "100%",
              tagList(
                  h4("Aggregation options"),
                  uiOutput("warningAgregationMethod"),
                  uiOutput("chooseProteinId"),
                  checkboxInput("checkSharedPeptides",
                                "Include shared peptides",
                                value = FALSE),
                  uiOutput("ChooseAggregationMethod"),
                  uiOutput("topNOption"),
                  actionButton("perform.aggregation","Perform aggregation")
              )
    )
    
})




output$AggregationWellPanel_Step1 <- renderUI({
    rv$current.obj
    if (is.null(rv$current.obj))
    {return (NULL)}
    
    if (rv$current.obj@experimentData@other$typeOfData == "peptide") {
        tagList(
            HTML("Please select first the id of protein in your dataset. 
                <br>Then, the stats will be showed and it will be possible to 
                perform the aggregation"),
            fluidRow(
                column(width=6, h4("Only specific peptides")),
                column(width=6, h4("All (specific & shared) peptides"))
                ),
            busyIndicator("Calculation in progress",wait = 0),
            fluidRow(
                column(width=6, plotOutput("aggregationPlotUnique")),
                column(width=6, plotOutput("aggregationPlotShared"))
                ),
            uiOutput("aggregationStats"),
            uiOutput("ObserverAggregationDone")
            )
    } else {
        h4("The dataset is a protein one: the aggregation cannot be performed.")
    }
})



output$displayNbPeptides <- renderUI({
    input$filterProtAfterAgregation
    if (is.null(input$filterProtAfterAgregation)){return (NULL) }
    
    if (input$filterProtAfterAgregation) {
        numericInput("nbPeptides", "Nb of peptides defining a protein", 
                     value = 0, min =0, step=1,
                     width = "250px")
    }
})



output$Aggregation_Step2 <- renderUI({
    
    rv$current.obj
    if (is.null(rv$current.obj)){return (NULL)}
    
    if (rv$current.obj@experimentData@other$typeOfData == "peptide") {
        tagList(
            fluidRow(
                #column(width=3,
                #       checkboxInput("filterProtAfterAgregation",
                #                     "Filtering : remove the proteins that are 
                #                     defined by less than n peptides.",
                #                     value = FALSE)
                #),
                column(width=4,uiOutput("displayNbPeptides")
                )
                
            ),
            
            
            helpText("Select the columns of the meta-data (related to proteins)
                    that have to be recorded in the new protein dataset."),
            div(class="row"),
            div(class="span5", "",
                uiOutput("columnsForProteinDataset"),
                fluidRow(
                    column(width=3,
                           actionButton("valid.aggregation",
                                        "Save aggregation", 
                                        styleclass = "primary")
                    )
                ) 
                
            )
            )
    } else {
        h4("The peptide dataset has been aggregated into a protein dataset.")
    }
    
})





output$warningAgregationMethod <- renderUI({
    rv$current.obj
    if (is.null(rv$current.obj)) {return (NULL)}
    
    if (length(which(is.na(Biobase::exprs(rv$current.obj)))) > 0)
    {
        text <- "<font color=\"red\"> Warning ! <br> 
        Your dataset contains missing values.
        <br> For better results, you should impute  <br> them first"
        HTML(text)
    }
    
})


buildWritableVector <- function(v){
    t <- "c("
    for (i in v){
        t <- paste(t, "\"", as.character(i), "\"", sep="")
        if (i == last(v)) {t <- paste(t, ")", sep="")}
        else {t <- paste(t, ",", sep="")}
    }
    return(t)
}



######################################################### 
output$columnsForProteinDataset <- renderUI({
    rv$current.obj
    if (is.null(rv$current.obj)) {return(NULL)  }
    
    choices <- colnames(Biobase::fData(rv$current.obj))
    names(choices) <- colnames(Biobase::fData(rv$current.obj))
    selectizeInput("columnsForProteinDataset.box",
                   label = "",
                   choices = choices,
                   multiple = TRUE, width='200%')
    
})





output$chooseProteinId <- renderUI({
    rv$current.obj
    if (is.null(rv$current.obj)) {return (NULL)}
    
    selectInput("proteinId", 
                "Choose the protein ID",
                choices = c("None",colnames(Biobase::fData(rv$current.obj))))
})