Venn.R 9.14 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
### 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


#########################################
######## Venn diagram                   #
#########################################

value=T # boolean at t=0

#' bool is a reactive function that return the bool value in the local environment
#'
#' @value boolean
#'
#' @return bool a reactive boolean outside the reactive environment
#'
#' @export

output$bool <- reactive({
  value
})

outputOptions(output,"bool",suspendWhenHidden=F)

fsoubes's avatar
fsoubes committed
29 30
#' vennlist is a reactive function which aim is to return a list of signficant probenames
#'
fsoubes's avatar
fsoubes committed
31 32 33
#' @param csvf a data frame
#' @param user_cont a subset data frame with the selected comparisons for the adj.p.val or p.val
#' @param user_fc a subset data frame with the selected comparisons for the logfc
fsoubes's avatar
fsoubes committed
34
#' @param regulation vector input
fsoubes's avatar
fsoubes committed
35 36 37 38 39 40 41 42 43
#' @param pvalvenn numeric input for the p value cutoff
#' @param fcvenn numeric input for the logfc value cutoff
#'
#' @return probven a reactive list of probenames
#'
#' @export

vennlist <- reactive({
  req(user_cont() > 0)
fsoubes's avatar
fsoubes committed
44

fsoubes's avatar
fsoubes committed
45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65
  if (is.null(csvf()))
    return(NULL)
  # adj <- user_cont()
  # fc <- user_fc()
  # cutoffpval <-input$pvalvenn
  # cutofffc <- input$fcvenn
  # reg <- input$regulation
  # cl <- makeCluster(getOption("cl.cores", 2))
  # clusterExport(cl,c("adj","fc","cutoffpval","cutofffc","reg","cutoffpval"),envir=environment())
  #mycont = Vennlist(adj,fc, reg, cutoffpval, cutofffc,cl)
  #stopCluster(cl)
  mycont = Vennlist(user_cont(),user_fc(), input$regulation, input$pvalvenn, input$fcvenn)
  probven = rowtoprob(mycont,csvf()[[3]], user_cont())
  return(probven)
})

#' Vennplot is a reactive function that return a plot object or a link if the user want to display more tha  5sets
#'
#' @param Vennploted a reactive object
#'
#' @return Vennplot a reactive object to be plot
fsoubes's avatar
fsoubes committed
66
#'
fsoubes's avatar
fsoubes committed
67 68 69
#' @export

#' Vennplot <- reactive({
fsoubes's avatar
fsoubes committed
70
#'
fsoubes's avatar
fsoubes committed
71
#'   req(vennlist)
fsoubes's avatar
fsoubes committed
72
#'
fsoubes's avatar
fsoubes committed
73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
#'   #' Vennplot is a reactive function that return an object of type venn if the number of set is stricly inferior to 6
#'   #' or a link to a website if it's not
#'   #'
#'   #' @param user_cont a subset data frame with the selected comparisons for the adj.p.val or p.val
#'   #' @param input$vennsize the police size for the contrasts
#'   #' @param vennlist a list of probenames
#'   #' @param pvalvenn numeric input for the p value cutoff
#'   #' @param fcvenn  numeric input for the logfc value cutoff
#'   #' @param methodforvenn character input
#'   #' @param dispvenn character input for plot a venn diagram with probes or genes
#'   #' @param csvf data frame corresponding to the alltoptable
#'   #'
#'   #' @return Vennploted a reactive object to be plot
#'   #'
#'   #' @export
fsoubes's avatar
fsoubes committed
88
#'
fsoubes's avatar
fsoubes committed
89
#'   Vennploted <- reactive({
fsoubes's avatar
fsoubes committed
90 91 92
#'
#'
#'
fsoubes's avatar
fsoubes committed
93 94
#'   if(length(user_cont()) <= 5){
#'   #g = Vennfinal(vennlist(), user_cont(), cex = input$vennsize, input$pvalvenn, input$fcvenn)
fsoubes's avatar
fsoubes committed
95
#'
fsoubes's avatar
fsoubes committed
96 97
#'   if(!input$fill == "")
#'     mycol = gsub("^\\s+|\\s+$", "", unlist(strsplit(input$fill, ",")))
fsoubes's avatar
fsoubes committed
98
#'   else
fsoubes's avatar
fsoubes committed
99
#'     mycol = ""
fsoubes's avatar
fsoubes committed
100
#'
fsoubes's avatar
fsoubes committed
101
#'   g = Vennfinal(vennlist()[[1]], user_cont(), cex = input$vennsize, input$pvalvenn, input$fcvenn, input$methodforvenn, input$dispvenn , csvf()[[3]], mycol = mycol)
fsoubes's avatar
fsoubes committed
102 103 104 105
#'
#'
#'    observe({value <<-T}) # listen inside the reactive expression
#'
fsoubes's avatar
fsoubes committed
106 107 108 109 110
#'    #' output$bool is a reactive function that set the bool value to T
#'    #'
#'    #' @value a boolean
#'    #'
#'    #' @return bool a reactive boolean inside the reactive environment
fsoubes's avatar
fsoubes committed
111
#'    #'
fsoubes's avatar
fsoubes committed
112
#'    #' @export
fsoubes's avatar
fsoubes committed
113 114
#'
#'     output$bool <- reactive({
fsoubes's avatar
fsoubes committed
115 116
#'       value
#'     })
fsoubes's avatar
fsoubes committed
117
#'
fsoubes's avatar
fsoubes committed
118
#'   return(g)}
fsoubes's avatar
fsoubes committed
119 120 121 122
#'   else {
#'
#'     observe({ value <<- F}) # listen inside the reactive expression
#'
fsoubes's avatar
fsoubes committed
123 124 125 126 127 128
#'     #' output$bool is a reactive function that set the bool value to F
#'     #'
#'     #' @value a boolean
#'     #'
#'     #' @return bool a reactive boolean inside the reactive environment
#'     #'
fsoubes's avatar
fsoubes committed
129
#'
fsoubes's avatar
fsoubes committed
130 131 132
#'     output$bool <- reactive({
#'       value
#'     })
fsoubes's avatar
fsoubes committed
133
#'
fsoubes's avatar
fsoubes committed
134 135 136 137 138 139
#'     output$image <- renderUI({
#'       tags$img(src = "https://i.imgur.com/lB5wmMp.png")
#'     })
#'     url <- a("venntools", href = "http://jvenn.toulouse.inra.fr/app/example.html", target = "_blank")
#'     url2 <- a("venntools2", href = "http://bioinfogp.cnb.csic.es/tools/venny/", target = "_blank")
#'     output$sorry <- renderUI({tagList("You're trying to plot more than 5 sets, download the csv file and use the following tool", url)})
fsoubes's avatar
fsoubes committed
140
#'
fsoubes's avatar
fsoubes committed
141 142
#'     }
#'   })
fsoubes's avatar
fsoubes committed
143
#'
fsoubes's avatar
fsoubes committed
144 145 146 147
#'   return(Vennploted())
#' })

observe({
fsoubes's avatar
fsoubes committed
148 149


fsoubes's avatar
fsoubes committed
150 151 152 153
  validate(
    need(csvf(), 'You need to import data to visualize this plot!'))
  #req(csvf())

fsoubes's avatar
fsoubes committed
154 155


fsoubes's avatar
fsoubes committed
156
observe({
fsoubes's avatar
fsoubes committed
157 158 159

   groupinline = ifelse(length(levels(csvf()[[2]]$Grp)) > 6, T, F)

fsoubes's avatar
fsoubes committed
160 161 162 163 164 165
output$contout <- renderUI(
  ##validate

  checkboxGroupInput(
    inputId = "cont" ,
    label =  "Choose your comparison",
fsoubes's avatar
fsoubes committed
166
    choices = colnames(adjusted()[[1]][,-1,drop = FALSE][myindex()]),
fsoubes's avatar
fsoubes committed
167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182
    #selected = colnames(adjusted()[[1]][,-1][myindex()])
    inline = groupinline
  )
)
})

})


observeEvent(input$allCont, {
  groupinline = ifelse(length(levels(csvf()[[2]]$Grp)) > 6, T, F)
  updateCheckboxGroupInput(
    session,
    "cont",
    label = "Choose your comparison",

fsoubes's avatar
fsoubes committed
183
    choices = colnames(adjusted()[[1]][,-1,drop = FALSE][myindex()]),
fsoubes's avatar
fsoubes committed
184
    #choices = colnames(adjusted()[[1]][,-1][,-c(indnull())]),
fsoubes's avatar
fsoubes committed
185
    selected = colnames(adjusted()[[1]][,-1,drop = FALSE][myindex()]),
fsoubes's avatar
fsoubes committed
186 187 188 189 190 191 192 193 194 195
    inline = groupinline
  )
})

observeEvent(input$noCont, {
  groupinline = ifelse(length(levels(csvf()[[2]]$Grp)) > 6, T, F)
  updateCheckboxGroupInput(session,
                           "cont",
                           label = "Choose your comparison",
                           #choices = colnames(adjusted()[[1]][,-1][,-c(indnull())]),
fsoubes's avatar
fsoubes committed
196
                           choices = colnames(adjusted()[[1]][,-1,drop = FALSE][myindex()]),
fsoubes's avatar
fsoubes committed
197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241
                           inline=groupinline
  )
})

#' indnull is a reactive function that return a vector for the contrasts with 0 genes significant at a treshold set to 5%
#'
#' @param vennlist a list
#'
#' @return indnull a reactive vector
#'
#' @export

indnull <- reactive({

    indexnull = which( sapply(vennlist()[[1]] ,length) == 0)
    return(indexnull)
})


#' choix_cont is a reactive function that return the contrast selected by the user
#'
#' @param cont a set of contrasts selected by the user
#'
#' @return choix_cont a set of characters input
#'
#' @export
#'

choix_cont <- reactive({
  return(input$cont)
})


#' user_cont is a reactive function that  return the contrast selected by the user
#'
#' @param adjusted data frame corresponding to the pvalue or adjusted pvalue
#' @param choix_cont a set of contrasts selected by the user
#'
#' @return user_cont a reactive data frame with the contrast selected
#'
#' @export
#'

user_cont <- reactive({
  req(adjusted())
fsoubes's avatar
fsoubes committed
242

fsoubes's avatar
fsoubes committed
243 244 245
  if (input$methodforvenn == "FDR")
    mysel = (subset(adjusted()[[1]],
                  select = choix_cont()))
fsoubes's avatar
fsoubes committed
246
  else
fsoubes's avatar
fsoubes committed
247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263
    mysel = (subset(adjusted()[[3]],
                    select = choix_cont()))
  return(mysel)
})


#' user_cont is a reactive function that  return the contrast selected by the user
#'
#' @param adjusted data frame corresponding to the logfc value
#' @param choix_cont a set of contrasts selected by the user
#'
#' @return user_cont a reactive data frame with the contrast selected
#'
#' @export
#'

user_fc <- reactive({
fsoubes's avatar
fsoubes committed
264

fsoubes's avatar
fsoubes committed
265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319
  mysel = (subset(adjusted()[[2]],
                  select = choix_cont()))
  return(mysel)
})


output$downloadvenn <- downloadHandler(
  filename = function() {
    paste(basename(file_path_sans_ext(projectname())),
          '_filtered_venn',
          '.csv',
          sep = '')
  },
  content = function(fname) {
    write.table(
      try(myventocsv(vennlist()[[2]]  , user_cont())),
      fname,
      na = "",
      row.names = F,
      col.names = T,
      append = TRUE,
      sep = ";"
    )
  }
)


output$downloadsetven <- downloadHandler(
  filename = function() {
    paste(basename(file_path_sans_ext(projectname())),
          '_inter_venn',
          '.csv',
          sep = '')
  },
  content = function(fname) {
    if(input$dispvenn == "genes")
    write.table(
      try(mysetventocsv(setvglobalvenn(vennlist()[[2]], user_cont(), dll = T))),
      fname,
      na = "",
      row.names = F,
      col.names = T,
      append = TRUE,
      sep = ";"
    )
    else
      write.table(
        try(mysetventocsv(setvglobalvenn(vennlist()[[1]], user_cont(), dll = T))),
        fname,
        na = "",
        row.names = F,
        col.names = T,
        append = TRUE,
        sep = ";"
      )
fsoubes's avatar
fsoubes committed
320

fsoubes's avatar
fsoubes committed
321 322 323 324 325 326 327 328 329 330 331 332
  }
)



################# TO DO commented

#' myindex is a reactive function returning the column indices for which there's more than one significant genes
#'
#' @param adjusted data frame corresponding to the adjusted.pval
#'
#' @return myindex a numeric vector
fsoubes's avatar
fsoubes committed
333
#'
fsoubes's avatar
fsoubes committed
334 335
#' @export
#'
fsoubes's avatar
fsoubes committed
336

fsoubes's avatar
fsoubes committed
337 338

myindex<- reactive({
fsoubes's avatar
fsoubes committed
339

fsoubes's avatar
fsoubes committed
340 341 342
  myl = lapply(seq(ncol(adjusted()[[1]])),function(x)
    #return(which(adjusted()[[1]][[x]] < input$pvalvenn & adjusted()[[3]][[x]]  > log2( input$fcvenn))))
    return(which(adjusted()[[1]][[x]] < 0.05)))
fsoubes's avatar
fsoubes committed
343

fsoubes's avatar
fsoubes committed
344
  indexnull = which( sapply(myl ,length) == 0)
fsoubes's avatar
fsoubes committed
345
  final = colnames(adjusted()[[1]][,-c(indexnull),drop = FALSE])
fsoubes's avatar
fsoubes committed
346
  return(final)
fsoubes's avatar
fsoubes committed
347

fsoubes's avatar
fsoubes committed
348
})