Maintenance - Mise à jour mensuelle Lundi 6 Avril 2020 entre 7h00 et 9h00

plotreact2.R 3.24 KB
Newer Older
fsoubes's avatar
fsoubes committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64
### Author: Franck Soubès
### Bioinformatics Master Degree - University of Bordeaux, France
### Link: https://github.com/fsoubes/MA_Trix_App
### Where: GET-TRiX's facility
### Application: MATRiX is a shiny application for Microarray Analysis on Transcriptomic impact of Xenobiotics
### Licence: GPL-3.0


###############################
######## not Reactive side    #
###############################


shinyjs::enable("heatm")



#' hmbis is an event reactive function that pre-computed hierarchical clustering on microarray data
#'
#' @param new_data a data frame with all the individuals selected
#' @param formated  a data frame with the indexes corresponding to the sigificant genes
#' @param new_group  a data frame with the corresponding groups
#' @param workingPath the current user's repository
#' @param k a numeric value which aim is to defined the treshold value to cut the dendogram input$clusters
#' @param Rowdistfun a function used to compute the distance for the rows
#' @param Coldistfun a function used to compute the distance for the columns
#' @param meanGrp a boolean value to computes the mean for each groups; default = F
#' @param genename a data frame
#'
#' @return  a list of objects which aim is to being passed as argument in the plotHeatmaps function
#'
#' @export
#'

hmbis <- reactive({
  withProgress(message = 'Performing the hierarchical clustering:', # Add sliderbar when loading heatmap
               value = 0,
               {
                 n <- NROW(formated()[[1]]) #number of row in the formated dataframe
                 for (i in 1:n) {
                   incProgress(1 / n, detail = "Please wait...")
                 }
                 
                 truncatedhat(
                   data.matrix(new_data()),
                   formated()[[1]],
                   droplevels(new_group()$Grp),
                   workingPath = wd_path,
                   k = input$clusters,
                   mypal = unlist(colors()),
                   Rowdistfun = input$dist ,
                   Coldistfun = input$dist,
                   meanGrp = input$meangrp,
                   genename =  csvf()[[3]],
                   algo = input$algomet
                 )
                 
               })
})


observeEvent(input$heatm, {
  
  if (is.null(my_intermediate())) {
fsoubes's avatar
fsoubes committed
65
    pdf(NULL) 
fsoubes's avatar
fsoubes committed
66
    heatmapfinal(isplot = F)
fsoubes's avatar
fsoubes committed
67 68
    shinyjs::alert("The colors defined for the heatmap are not fit to be together!!")
    return(NULL)
fsoubes's avatar
fsoubes committed
69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102
  }
  else
    output$distPlot <- renderPlot({
      isolate({

        hmbis()
        hmsize$cut <- hmbis()[[8]]
        
        observe({
          boolhm <<- T
        })
        
        output$heatmbool <- reactive({
          boolhm
        })
        
        withProgress(message = 'Plotting heatmap:', # Add sliderbar when loading heatmap
                     value = 0,
                     {
                       n <- NROW(formated()[[1]]) #number of row in the formated dataframe
                       for (i in 1:n) {
                         incProgress(1 / n, detail = "Please wait...")
                       }
                       hmboth$tot <- heatmapfinal(isplot = F)
                       hmobj$hm <- hmboth$tot[[1]]
                       hmobj$obj <- hmboth$tot[[2]]
                     })
      })
      
    })
})