pcago/widgetGeneAnnotationImporter.R at master · rnajena/pcago · GitHub

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
65
66
67
68
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
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
#'
#' Widget that is used for importing/generating conditions
#'

library(shiny)
source("widgetGenericImporter.R")
source("geneAnnotation.R")
source("geneAnnotationBioMart.R")
source("geneAnnotationGRanges.R")
source("geneAnnotationHub.R")
source("uiHelper.R")
source("environment.R")

#' Creates a widget that allows the user to select a method of extracting gene annotations
#'
#' @param id
#'
#' @return Shiny UI element
#' @export
#'
#' @examples
geneAnnotationImporterUI <- function(id) {

  if(!is.character(id)) {
    stop("Invalid arguments!")
  }

  ns <- NS(id)

  return(tagList(
    genericImporterInput(ns("importer")))
  )

}

#' Extracts the gene annotation based on the user input.
#' This function is supposed to be called by callModule. Use the one without an underscore for easier access.
#'
#' @param input
#' @param output
#' @param session
#' @param readcounts
#'
#' @return
#' @export
#'
#' @examples
geneAnnotationImporterValue_ <- function(input, output, session, dataset) {

  readcounts <- reactive({
    validate(need(dataset(), "No preprocessed read counts available!"))
    return(dataset()$readcounts.preprocessed)
  })

  annotation <- (genericImporterData("importer",
                             importers = reactive(supportedGeneAnnotationImporters),
                             samples = reactive(availableGeneAnnotationSamples),
                             generators = reactive(supportedGeneAnnotationGenerators),
                             parallel = parallelized.gene.annotation.importer,
                             exprimport = function(con, importer, parameters) {
                               return(importGeneInformationFromAnnotation(con, importer, dataset(), parameters))
                             },
                             exprsample = function(sample, parameters) {
                               return(importSampleGeneInformation(sample, dataset(), parameters))
                             },
                             exprgenerator = function(generator, parameters) {
                               return(generateGeneInformation(generator, dataset(), parameters))
                             },
                             exprintegrate = function(data, callback) {
                               output <- GeneAnnotation()
                               genes <- rownames(readcounts())

                               # Merge data into output
                               for(current.data in data) {
                                 if(!is.null(data)) {
                                   output <- mergeGeneAnnotation(output, current.data)
                                 }
                               }

                               # Build our callback for the user
                               choices = GeneAnnotationEntryNames
                               selected <- c()

                               for(annotation.type in choices) {
                                 covered.genes <- intersect(geneAnnotationAnnotatedGenes(output, annotation.type), genes)

                                 if(length(covered.genes) > 0) {
                                   names(choices)[choices == annotation.type] <- sprintf("%s (%d/%d)",
                                                                                         names(choices)[choices == annotation.type],
                                                                                         length(covered.genes),
                                                                                         length(genes))
                                   selected <- c(selected, annotation.type)
                                 }

                               }


                               callback(choices, selected)
                               return(output)
                             }))

  return(reactive({
    dataset <- dataset()
    dataset$gene.annotation <- annotation()
    return(dataset)
  }))

}

#' Extracts the gene annotation based on the user input.
#'
#' @param id
#' @param readcounts
#'
#' @return
#' @export
#'
#' @examples
geneAnnotationImporterValue <- function(id, dataset) {

  return(callModule(geneAnnotationImporterValue_, id, dataset = dataset))

}