Venninter.R 8.67 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
### 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


#' vennchoice is a reactive function that return user's selected comparisons
#'
#' @param intscol character input
#'
#' @return character vector
#' @export
#'


vennchoice <- reactive({
  if (is.null (input$intscol))
    return(NULL)
  else
    return(input$intscol)
})


#' venninter is a reactive function which aim is to return a set of lists for each possible logical relations between a finite collection of different sets
#'
#' @param vennlist list of probenames
#' @param user_cont character vector
#'
#' @return multiple lists
#' @export
#'

venninter <- reactive({
  req(vennlist(), user_cont())
  myelist <- setvglobalvenn(vennlist()[[1]], user_cont())
fsoubes's avatar
fsoubes committed
38

fsoubes's avatar
fsoubes committed
39 40 41 42 43 44
  return(myelist)
})


#' vennfinal is a reactive function which return a list of data frame corresponding to the computationnal mean of each logFC for the possible logical relations between a finite collection of different sets
#' and a data frame with as primary key the probenames associated with the corresponding gene names and logFC
fsoubes's avatar
fsoubes committed
45
#'
fsoubes's avatar
fsoubes committed
46 47 48 49 50 51 52 53 54 55 56
#'
#' @param vennchoice reactive character vector
#' @param adjusted dataframe subset of the alltoptable
#' @param dispvenn character input between probes and genes
#' @param venninter multiple lists of probenames
#'
#' @return a list of two data frames
#' @export
#'

vennfinal <- reactive({
fsoubes's avatar
fsoubes committed
57 58


fsoubes's avatar
fsoubes committed
59
  validate(
fsoubes's avatar
fsoubes committed
60
    need(csvf(), 'You need to import data to visualize this plot!') %next%
fsoubes's avatar
fsoubes committed
61
      need(choix_cont(), 'Set your thresholds and then select your comparison to display the Venn diagram!')%next%
fsoubes's avatar
fsoubes committed
62
      need(input$selcontjv ,'You need to click on a number (Venn diagram) to display the data table!'))
fsoubes's avatar
fsoubes committed
63

fsoubes's avatar
fsoubes committed
64 65
  if (is.null(vennchoice))
    return(NULL)
fsoubes's avatar
fsoubes committed
66

fsoubes's avatar
fsoubes committed
67 68 69

  reslist = list()
  reordchoice <- input$selcontjv %>%
fsoubes's avatar
fsoubes committed
70
    factor(levels = names(adjusted()[[1]][,-1,drop = FALSE])) %>%
fsoubes's avatar
fsoubes committed
71 72 73
    sort() %>%
    paste(collapse = "")

fsoubes's avatar
fsoubes committed
74

fsoubes's avatar
fsoubes committed
75
  if(!input$Allcont && !input$dispvenn == "genes"){
fsoubes's avatar
fsoubes committed
76
    resfinal <- csvf()[[3]] %>%
fsoubes's avatar
fsoubes committed
77 78
    filter(ProbeName %in% venninter()[[reordchoice]]) %>%
      #filter(ProbeName %in% input$jvennlist) %>%
fsoubes's avatar
fsoubes committed
79 80
      select(ProbeName, GeneName, paste0("logFC_",  input$selcontjv)) %>%
      mutate_if(is.numeric, funs(format(., digits = 3)))
fsoubes's avatar
fsoubes committed
81 82 83

    }
  else if (input$Allcont && !input$dispvenn == "genes"){
fsoubes's avatar
fsoubes committed
84
    resfinal <- csvf()[[3]] %>%
fsoubes's avatar
fsoubes committed
85
    filter(ProbeName %in% venninter()[[reordchoice]]) %>%
fsoubes's avatar
fsoubes committed
86
    #filter(ProbeName %in% input$jvennlist) %>%
fsoubes's avatar
fsoubes committed
87
    select(ProbeName, GeneName, paste0("logFC_", choix_cont())) %>%
fsoubes's avatar
fsoubes committed
88
    mutate_if(is.numeric, funs(format(., digits = 3)))
fsoubes's avatar
fsoubes committed
89 90
  }
  else if (!input$Allcont && input$dispvenn == "genes")
fsoubes's avatar
fsoubes committed
91

fsoubes's avatar
fsoubes committed
92 93 94 95 96 97 98 99 100 101 102 103 104
    resfinal <- csvf()[[3]] %>%
      filter(GeneName %in% input$jvennlist) %>%
      filter(ProbeName %in% unlist(vennlist()[[1]])) %>%
      select( GeneName, paste0("logFC_",  input$selcontjv)) %>%
      mutate_if(is.numeric, funs(format(., digits = 3)))
      #print(filter(resfinal, GeneName == "Afg3l1"))
  
  else
    resfinal <- csvf()[[3]] %>%
      filter(GeneName %in% input$jvennlist) %>%
      filter(ProbeName %in% unlist(vennlist()[[1]])) %>%
      select( GeneName, paste0("logFC_", choix_cont())) %>%
      mutate_if(is.numeric, funs(format(., digits = 3)))
fsoubes's avatar
fsoubes committed
105
  
fsoubes's avatar
fsoubes committed
106 107 108 109 110
  if(input$Notanno){
    resfinal <- resfinal %>%  filter(., !grepl("^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,}",GeneName)) %>% as.data.frame()
  }
  
  reslist[[1]] <- resfinal
fsoubes's avatar
fsoubes committed
111

fsoubes's avatar
fsoubes committed
112 113
  if(!input$Allcont)
    mycont = paste0("logFC_",input$selcontjv)
fsoubes's avatar
fsoubes committed
114
  else
fsoubes's avatar
fsoubes committed
115 116
    mycont = paste0("logFC_",choix_cont())

fsoubes's avatar
fsoubes committed
117
  if(input$dispvenn == "genes"){
fsoubes's avatar
fsoubes committed
118
    
fsoubes's avatar
fsoubes committed
119
    options(datatable.optimize=1)
fsoubes's avatar
fsoubes committed
120 121 122 123
    for (i in mycont) {
      resfinal[[i]] = as.numeric(as.character(resfinal[[i]]))
    }
    
fsoubes's avatar
fsoubes committed
124
    reslist[[2]] <- resfinal %>% as.data.table() %>% .[,lapply(.SD,function(x) mean=round(mean(x), 3)),"GeneName"] %>% as.data.frame()  
fsoubes's avatar
fsoubes committed
125 126
    }

fsoubes's avatar
fsoubes committed
127 128 129 130 131 132
  return(reslist)
})


output$topgenesvenn <- renderUI({

fsoubes's avatar
fsoubes committed
133
  req( input$selcontjv)
fsoubes's avatar
fsoubes committed
134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155
  tags$div(
    class = "topgeness",numericInput('topgenes',
               'Top genes', value = 50,
               min = 1,
               max = length(vennfinal()[[1]]$ProbeName))
    )
})


output$venntitle <- renderText({
  req(input$topgenes)
  if(input$dispvenn == "probes")
    mytitlevenn <<- print(paste("Barplot showing the top ", input$topgenes ," genes"))
  else
    mytitlevenn <<- print(paste("Barplot showing the computationnal logFC mean of the top " ,input$topgenes , " genes before the rendering table"))
})


output$venngenesbef <- renderText({
  req(input$topgenes)
  if(input$dispvenn == "genes")
  mytitlevenn <<- print(paste("Barplot showing the computationnal logFC mean of the top " ,input$topgenes , " genes after the rendering table"))
fsoubes's avatar
fsoubes committed
156

fsoubes's avatar
fsoubes committed
157 158 159 160 161 162 163 164 165
})


output$dfvenn <- renderText({
  req(input$topgenes)
  if(input$dispvenn == "probes")
    mytitlevenn <<- print(paste("Table showing the ProbeNames and GeneNames associated with their respective logFC for the intersection(s) selected"))
  else
    mytitlevenn <<- print(paste("Table showing the GeneNames associated with the average logFC for the intersection(s) selected"))
fsoubes's avatar
fsoubes committed
166 167


fsoubes's avatar
fsoubes committed
168 169 170 171 172 173
})

output$dfvennbef <- renderText({
  req(input$topgenes)
  if(input$dispvenn == "genes")
    mytitlevenn <<- print(paste("Table showing the GeneNames associated with their respective logFC for the intersection(s) selected"))
fsoubes's avatar
fsoubes committed
174

fsoubes's avatar
fsoubes committed
175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216
})


#' venntopgenes is a reactive function which aim is to return the user's input top n genes
#'
#' @param topgenes numeric input
#'
#' @return numeric input
#' @export
#'

venntopgenes <- reactive({
    if (is.null (input$topgenes))
      return(NULL)
    else
      return(input$topgenes)
  })

output$downloadvennset = downloadHandler('venns-filtered.csv',
  content = function(file) {
    s = input$vennresinter_rows_all
    if(input$dispvenn == "probes")
      write.csv2(vennfinal()[[1]][s, , drop = FALSE], file)
    else
      write.csv2(vennfinal()[[2]][s, , drop = FALSE], file)
  }
)

#' plottopgenes is an event reactive function which aim is to plot the top n genes selected by the user from the rendering data table
#'
#' @param topdegenes clickable event button
#' @param venntopgenes numeric input
#' @param vennchoice reactive character vector
#' @param vennfinal a list of two data frames
#' @param dispvenn character input between probes and genes
#'
#' @return ggplot object
#' @export
#'

plottopgenes <- eventReactive(input$topdegenes, {
  req(vennfinal(), venntopgenes(), input$selcontjv)
fsoubes's avatar
fsoubes committed
217 218 219

  if(input$Allcont)
    mycont <- paste0("logFC_", choix_cont())
fsoubes's avatar
fsoubes committed
220
  else
fsoubes's avatar
fsoubes committed
221
    mycont <- paste0("logFC_", input$selcontjv)
fsoubes's avatar
fsoubes committed
222

fsoubes's avatar
fsoubes committed
223
  
fsoubes's avatar
fsoubes committed
224
  if(input$dispvenn == "probes")
fsoubes's avatar
fsoubes committed
225
    myplot <- topngenes(vennfinal()[[1]][input$vennresinter_rows_all, , drop = FALSE],mycont, venntopgenes(), input$dispvenn)
fsoubes's avatar
fsoubes committed
226
  else
fsoubes's avatar
fsoubes committed
227
    myplot <- topngenes(vennfinal()[[2]][input$vennresinter_rows_all, , drop = FALSE],mycont, venntopgenes(), input$dispvenn)
fsoubes's avatar
fsoubes committed
228

fsoubes's avatar
fsoubes committed
229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
  return(myplot)
})


#' plottopgenesmean is an event reactive function which aim is to plot the top n genes selected by the user from the rendering data table with the average logFC
#'
#' @param topdegenes clickable event button
#' @param venntopgenes numeric input
#' @param vennchoice reactive character vector
#' @param vennfinal a list of two data frames
#'
#' @return ggplot object
#' @export
#'

plottopgenesmean <- eventReactive(input$topdegenes, {
  req(vennfinal(), vennchoice(), venntopgenes())
  mycont = paste0("logFC_", vennchoice())
    myplot <- topngenes(vennfinal()[[1]][input$vennresintergen_rows_all, , drop = FALSE], mycont, venntopgenes(), input$dispvenn, mean = T)
fsoubes's avatar
fsoubes committed
248

fsoubes's avatar
fsoubes committed
249 250 251 252 253 254 255 256 257 258
  return(myplot)
})



observeEvent(input$topdegenes, {
  isolate(output$barplotvenn <- renderPlot({
    req(plottopgenes())
    plotOutput(plottopgenes())
  }))
fsoubes's avatar
fsoubes committed
259

fsoubes's avatar
fsoubes committed
260 261 262 263 264 265 266
})


observeEvent(input$topdegenes, {
  isolate(output$barplotvennmean <- renderPlot({
    req(plottopgenesmean(), input$dispvenn == "genes")
    plotOutput(plottopgenesmean())
fsoubes's avatar
fsoubes committed
267

fsoubes's avatar
fsoubes committed
268
  }))
fsoubes's avatar
fsoubes committed
269

fsoubes's avatar
fsoubes committed
270 271 272 273 274 275
})



observe({
  validate(need(csvf(), 'You need to import data to visualize this plot!'))
fsoubes's avatar
fsoubes committed
276

fsoubes's avatar
fsoubes committed
277 278 279 280 281 282 283 284 285 286
  output$savebarplot <- downloadHandler(filename <- function() {
    paste0(
      basename(tools::file_path_sans_ext(projectname())),
      '_venn_barplot.',
      input$formvenbar,
      sep = ''
    )
  },
  content <- function(file) {
    if (input$formvenbar == "pdf")
fsoubes's avatar
fsoubes committed
287

fsoubes's avatar
fsoubes committed
288 289 290 291
      pdf(file,
          width = 16,
          height = 7,
          pointsize = 12)
fsoubes's avatar
fsoubes committed
292

fsoubes's avatar
fsoubes committed
293 294 295 296 297 298 299 300 301 302 303 304 305 306
    else if (input$formvenbar == "png")
      png(
        file,
        width = 1600,
        height = 700,
        units = "px",
        pointsize = 12,
        res = 100
      )
    else
      eps(file,
          width = 16,
          height = 7,
          pointsize = 12)
fsoubes's avatar
fsoubes committed
307

fsoubes's avatar
fsoubes committed
308
    print(plottopgenes())
fsoubes's avatar
fsoubes committed
309

fsoubes's avatar
fsoubes committed
310 311
    dev.off()
  })
fsoubes's avatar
fsoubes committed
312 313

})