server.R 9.56 KB
Newer Older
fsoubes's avatar
fsoubes committed
1 2 3 4 5 6 7 8 9 10 11 12 13
### 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

library(shinyFiles)

shinyjscode <- "
shinyjs.init = function() {
  $(window).resize(shinyjs.calcHeight);
}
fsoubes's avatar
fsoubes committed
14
shinyjs.calcHeight = function() {
fsoubes's avatar
fsoubes committed
15 16 17 18 19
  Shiny.onInputChange('plotHeight', $(window).height());
}
"

shinyServer(function(input, output,session) {
fsoubes's avatar
fsoubes committed
20 21 22



fsoubes's avatar
fsoubes committed
23 24
  hide(id = "loading-content", anim = TRUE, animType = "fade",time=2)
  hide(id = "loading-content-bar", anim = TRUE, animType = "fade",time=2)
fsoubes's avatar
fsoubes committed
25

fsoubes's avatar
fsoubes committed
26 27 28 29 30
  observe({
    collapsestate <- input$sidebarCollapsed
    session$sendCustomMessage(type="iscollapse", collapsestate)
  })

fsoubes's avatar
fsoubes committed
31 32 33


  plotHeight <- reactive({
fsoubes's avatar
fsoubes committed
34 35
    ifelse(is.null(input$plotHeight), 0, (input$plotHeight/1.25))
  })
fsoubes's avatar
fsoubes committed
36 37


fsoubes's avatar
fsoubes committed
38 39 40 41 42
  #######################################################
  ##                                                   ##
  ##                    LOAD FILES                     ##
  ##                                                   ##
  #######################################################
fsoubes's avatar
fsoubes committed
43

fsoubes's avatar
fsoubes committed
44
  #source(file.path("server", "csvFile.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
45

fsoubes's avatar
fsoubes committed
46
  csvf <- callModule(csvFile, "datafile",stringsAsFactors = FALSE)
fsoubes's avatar
fsoubes committed
47 48


fsoubes's avatar
fsoubes committed
49 50 51
  ##########################################
  ######## Widget update and info         ##
  ##########################################
fsoubes's avatar
fsoubes committed
52

fsoubes's avatar
fsoubes committed
53
  source(file.path("server", "matrixwidg.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
54

fsoubes's avatar
fsoubes committed
55 56 57 58 59 60 61
  ##########################################
  ######## HOME page                      ##
  ##########################################

  source(file.path("server", "datasummary.R"), local = TRUE)$value #
  source(file.path("server", "renderertable.R"), local = TRUE)$value #
  source(file.path("server", "checkboxgrp.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
62

fsoubes's avatar
fsoubes committed
63 64 65 66
  ##########################################
  ######## Volcano page                   ##
  ##########################################

fsoubes's avatar
fsoubes committed
67

fsoubes's avatar
fsoubes committed
68 69 70 71 72 73 74 75
  genetodisplay <- reactive({
    if(is.null(input$fillvolc))
      return(NULL)
    else{
    if(!input$fillvolc == "")
          mycol = gsub("^\\s+|\\s+$", "", unlist(strsplit(input$fillvolc, ",")))
        else
          mycol = ""
fsoubes's avatar
update  
fsoubes committed
76 77 78
    return(toupper(mycol))
    }
  })
fsoubes's avatar
fsoubes committed
79 80 81 82 83 84 85 86 87 88
  
  
  family_input <- reactive({
    input$findfamily
  })
  
  
  family_d <- shiny::debounce(family_input, 900)
  
  
fsoubes's avatar
update  
fsoubes committed
89
  familytopdisp <- reactive({
fsoubes's avatar
fsoubes committed
90
    if(is.null(family_d))
fsoubes's avatar
update  
fsoubes committed
91 92
      return(NULL)
    else{
fsoubes's avatar
fsoubes committed
93 94
      if(!family_d() == ""){
        genfam = grep(pattern = toupper(family_d()), toupper(csvf()[[3]]$GeneName)) %>% slice(csvf()[[3]],.)%>% select(GeneName)  %>% unlist() %>% as.character() 
fsoubes's avatar
update  
fsoubes committed
95 96 97 98
      }
      else
        genfam =""
    return(toupper(genfam))
fsoubes's avatar
fsoubes committed
99 100
    }
  })
fsoubes's avatar
fsoubes committed
101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123
  
  
  observe({
    
    if(input$findfamily != ""){
      shinyjs::disable("topvolc")
      shinyjs::disable("fillvolc")
    }
    else if(input$fillvolc != ""){
      shinyjs::disable("topvolc")
      shinyjs::disable("findfamily")
    }
    else if(!is.na(input$topvolc)){
      shinyjs::disable("findfamily")
      shinyjs::disable("fillvolc")
    }
    else{
      shinyjs::enable("topvolc")
      shinyjs::enable("findfamily")
      shinyjs::enable("fillvolc")
    }
    
  })
fsoubes's avatar
fsoubes committed
124 125


fsoubes's avatar
fsoubes committed
126 127
  volcano <- reactive({
    req(csvf())
fsoubes's avatar
fsoubes committed
128 129
    EnhancedVolcano(csvf()[[3]], lab= csvf()[[3]]$GeneName , x = paste0("logFC_",input$volcacomp) ,
                    y = paste0(ifelse(input$method == "FDR", "adj.P.Val_","P.value_"),input$volcacomp),
fsoubes's avatar
fsoubes committed
130
                    topgenes = input$topvolc,DrawConnectors= T,#DrawConnectors = ifelse(is.na(input$topvolc),T,F),
fsoubes's avatar
update  
fsoubes committed
131 132 133
                    pCutoff = input$volcpval ,FCcutoff = input$volcfc ,transcriptPointSize = input$volcpt,transcriptLabSize = input$volclab,
                    title =  gsub("-"," versus " ,input$volcacomp),cutoffLineType = "twodash", findfamily =  ifelse(familytopdisp() == "" , NA,familytopdisp()),
                    displaylab = ifelse(genetodisplay() =="", NA, genetodisplay()),legendLabSize = 10,
fsoubes's avatar
fsoubes committed
134 135 136
                    cutoffLineCol = "black",cutoffLineWidth = 1,legend=c("NS","Log (base 2) fold-change","P value",
                                                                         "P value & Log (base 2) fold-change"))
  })
fsoubes's avatar
update  
fsoubes committed
137

fsoubes's avatar
fsoubes committed
138 139


fsoubes's avatar
fsoubes committed
140
  output$volcanoplot <- renderPlot({
fsoubes's avatar
fsoubes committed
141

fsoubes's avatar
fsoubes committed
142
  validate(need(csvf(), 'You need to import data to visualize this plot!'))
fsoubes's avatar
fsoubes committed
143

fsoubes's avatar
update  
fsoubes committed
144
    req(volcano())
fsoubes's avatar
fsoubes committed
145 146 147
    volcano()

  },  height = plotHeight)
fsoubes's avatar
fsoubes committed
148

fsoubes's avatar
fsoubes committed
149 150
  output$compvolc <- renderUI({
    req(adjusted())
fsoubes's avatar
update  
fsoubes committed
151
    selectInput("volcacomp", "Choose a comparison", choices = colnames(adjusted()[[1]][,-1,drop = FALSE]))
fsoubes's avatar
fsoubes committed
152
  })
fsoubes's avatar
fsoubes committed
153 154


fsoubes's avatar
fsoubes committed
155
  output$savevolcano <- downloadHandler(filename <- function() {
fsoubes's avatar
update  
fsoubes committed
156
    paste0(basename(file_path_sans_ext(projectname())), '_volcano.', input$formvolc, sep ='')
fsoubes's avatar
fsoubes committed
157 158 159
  },
  content <- function(file) {
    if (input$formvolc == "pdf")
fsoubes's avatar
fsoubes committed
160

fsoubes's avatar
fsoubes committed
161 162 163 164
      pdf(file,
          width = 12,
          height = 12,
          pointsize = 12)
fsoubes's avatar
fsoubes committed
165 166


fsoubes's avatar
fsoubes committed
167
    else if (input$formvolc == "png")
fsoubes's avatar
fsoubes committed
168

fsoubes's avatar
fsoubes committed
169 170 171 172 173 174 175 176 177 178 179
      png(
        file,
        width = 2500,
        height = 2500,
        units = "px",
        pointsize = 12,
        res = 100
      )
    else
      ggsave(file,device=cairo_ps, fallback_resolution = 600)

fsoubes's avatar
fsoubes committed
180

fsoubes's avatar
fsoubes committed
181 182 183
    plot(volcano())
    dev.off()
  })
fsoubes's avatar
fsoubes committed
184 185


fsoubes's avatar
fsoubes committed
186 187 188
  ################################
  ######## PCA page             ##
  ################################
fsoubes's avatar
fsoubes committed
189

fsoubes's avatar
fsoubes committed
190 191 192
  source(file.path("server", "PCAshiny.R"), local = TRUE)$value #
  source(file.path("server", "PCAsandp.R"), local = TRUE)$value #
  source(file.path("server", "colforpca.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
193

fsoubes's avatar
fsoubes committed
194 195 196
  ################################
  ######## Venn page            ##
  ################################
fsoubes's avatar
fsoubes committed
197

fsoubes's avatar
fsoubes committed
198 199 200 201 202
  source(file.path("server", "Venn.R"), local = TRUE)$value #
  #source(file.path("server", "Vennrender.R"), local = TRUE)$value #
  source(file.path("server", "grepcol.R"), local = TRUE)$value # adjusted
  source(file.path("server", "Venninter.R"), local = TRUE)$value # adjusted
  source(file.path("server", "trackervenn.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
203 204


fsoubes's avatar
fsoubes committed
205 206 207
  ################################
  ######## Jvenn                ##
  ################################
fsoubes's avatar
fsoubes committed
208 209


fsoubes's avatar
fsoubes committed
210
  observe({
fsoubes's avatar
fsoubes committed
211

fsoubes's avatar
fsoubes committed
212
    req(vennlist(),user_cont())
fsoubes's avatar
fsoubes committed
213

fsoubes's avatar
update  
fsoubes committed
214 215 216
    wrongcol <- function(y)
      if (any(grepl("col2rgb", y)))
        invokeRestart("muffleWarning")
fsoubes's avatar
fsoubes committed
217

fsoubes's avatar
fsoubes committed
218
    if(input$dispvenn == "genes")
fsoubes's avatar
fsoubes committed
219 220 221 222 223 224
      if(input$Notanno){
        vennlist <- lapply(vennlist()[[2]], grep, pattern="^chr[A-z0-9]{1,}:|^ENSMUST|^LOC[0-9]{1,}|^[0-9]{4,}$|^A_[0-9]{2}_P|^NAP[0-9]{4,}|[0-9]{7,}", value=TRUE, invert=TRUE)
        Rtojs <- toJvenn(vennlist,user_cont())
      }
      else
        Rtojs <- toJvenn(vennlist()[[2]],user_cont())
fsoubes's avatar
fsoubes committed
225
    else
fsoubes's avatar
fsoubes committed
226 227
        Rtojs <- toJvenn(vennlist()[[1]],user_cont())

fsoubes's avatar
fsoubes committed
228 229 230
    Mymode <-  input$updamod # Mode
    Myfont <-  input$myfont # Font size
    Mystat <-  input$mystat # Stat
fsoubes's avatar
fsoubes committed
231 232
    Myswitch <-  input$dispswitch # Stat

fsoubes's avatar
update  
fsoubes committed
233 234
    col2js =  tryCatch({
      col2rgb(mycol()) %>%  lapply(.,function(x)return(x)) %>% withCallingHandlers(error = wrongcol)
fsoubes's avatar
fsoubes committed
235 236 237
    }, error = function(e) {shinyjs::alert("Wrong color")})


fsoubes's avatar
fsoubes committed
238
    session$sendCustomMessage(type="updatejvenn", Rtojs)
fsoubes's avatar
update  
fsoubes committed
239
    session$sendCustomMessage(type="updatejcol", col2js)
fsoubes's avatar
fsoubes committed
240

fsoubes's avatar
fsoubes committed
241
  })
fsoubes's avatar
fsoubes committed
242 243 244 245 246 247
  
  
  
  jvennc_input <- reactive({
    input$fill
  })
fsoubes's avatar
fsoubes committed
248

fsoubes's avatar
fsoubes committed
249
  jvenncol <- shiny::debounce(jvennc_input, 500)
fsoubes's avatar
fsoubes committed
250

fsoubes's avatar
update  
fsoubes committed
251
  mycol <- reactive({
fsoubes's avatar
fsoubes committed
252
    if(!jvenncol() == ""){
fsoubes's avatar
fsoubes committed
253

fsoubes's avatar
update  
fsoubes committed
254 255 256 257 258 259
      mycol = gsub("^\\s+|\\s+$", "", unlist(strsplit(jvenncol(), ",")))
    }
    else
      mycol = ""
  })

fsoubes's avatar
fsoubes committed
260 261 262



fsoubes's avatar
fsoubes committed
263 264 265
  ################################
  ######## Venn GO              ##
  ################################
fsoubes's avatar
fsoubes committed
266

fsoubes's avatar
fsoubes committed
267
  source(file.path("server", "vennquery.R"), local = TRUE)$value # adjusted
fsoubes's avatar
fsoubes committed
268

fsoubes's avatar
fsoubes committed
269 270 271
  ##########################################
  ######## Grep project name              ##
  ##########################################
fsoubes's avatar
fsoubes committed
272 273


fsoubes's avatar
fsoubes committed
274 275 276 277 278 279 280 281
  file_name <- reactive({
    req(csvf())
    inFile <- csvf()[[4]]
    if (class(inFile)== "character")
      return(tools::file_path_sans_ext(inFile))
    else
      return (tools::file_path_sans_ext(inFile$name))
  })
fsoubes's avatar
fsoubes committed
282

fsoubes's avatar
fsoubes committed
283 284 285 286 287 288 289 290 291 292 293
  projectname <- reactive({
    req(file_name())
    projed <- strsplit(file_name(), "_")
    proj = grepl("^MA", projed[[2]])
    index = which(proj == T)
    myproj = list(projed[[2]][index], proj)
    if(length(myproj[[1]]) == 0){
      return(Sys.Date())
    }
    else
      return(myproj)
fsoubes's avatar
fsoubes committed
294

fsoubes's avatar
fsoubes committed
295
  })
fsoubes's avatar
fsoubes committed
296 297


fsoubes's avatar
fsoubes committed
298 299 300 301

  ################################
  ######## Heatmap page         ##
  ################################
fsoubes's avatar
fsoubes committed
302

fsoubes's avatar
fsoubes committed
303 304 305 306 307 308 309 310 311 312 313
  source(file.path("server", "checkboxcontrast.R"), local = TRUE)$value #
  source(file.path("server", "changeheatmbut.R"), local = TRUE)$value #
  source(file.path("server", "hidevent.R"), local = TRUE)$value #
  source(file.path("server", "heatmapshiny.R"), local = TRUE)$value #
  source(file.path("server", "tracker.R"), local = TRUE)$value #
  source(file.path("server", "computemean.R"), local = TRUE)$value #
  source(file.path("server", "grepcol.R"), local = TRUE)$value #
  source(file.path("server", "indexselected.R"), local = TRUE)$value #
  source(file.path("server", "selgroupandcont.R"), local = TRUE)$value #
  source(file.path("server", "backgroundcolor.R"), local = TRUE)$value #
  source(file.path("server", "groupcolor.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
314

fsoubes's avatar
fsoubes committed
315 316 317
  ##########################################
  ######## GO enrichissment               ##
  ##########################################
fsoubes's avatar
fsoubes committed
318 319


fsoubes's avatar
fsoubes committed
320 321
  source(file.path("server", "shinygo.R"), local = TRUE)$value #
  source(file.path("server", "highchartshiny.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
322

fsoubes's avatar
fsoubes committed
323 324 325
  ################################
  ######## cutheatmap page      ##
  ################################
fsoubes's avatar
fsoubes committed
326

fsoubes's avatar
fsoubes committed
327
  source(file.path("server", "cutheatmap.R"), local = TRUE)$value #
fsoubes's avatar
fsoubes committed
328

fsoubes's avatar
fsoubes committed
329 330 331
  ##########################################
  ######## Contact chat                   ##
  ##########################################
fsoubes's avatar
fsoubes committed
332

fsoubes's avatar
fsoubes committed
333 334 335
  source(file.path("server", "shinychat.R"), local = TRUE)$value #


fsoubes's avatar
fsoubes committed
336 337

})