/
happy_hour.R
316 lines (294 loc) · 11.4 KB
/
happy_hour.R
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
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
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
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
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
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
# nocov start
#' Check whether `pandoc` and `pandoc-citeproc` are available
#'
#' @details Credits to the original implementation proposed by Charlotte Soneson,
#' upon which this function is **heavily** inspired.
#'
#' @param ignore_pandoc Logical. If TRUE, just give a warning if one of pandoc or
#' pandoc-citeproc is not available. If FALSE, an error is thrown.
#'
#' @return No value is returned. If `pandoc` or `pandoc-citeproc` are missing,
#' either warning or error messages are triggered.
#'
.check_pandoc <- function(ignore_pandoc) {
if (Sys.which("pandoc") == "") {
if (ignore_pandoc) {
## If ignore_pandoc is TRUE, just give a warning
warning(
"pandoc is not available! ",
"The final report will not be generated."
)
} else {
## If ignore_pandoc is FALSE, stop
stop("pandoc is not available!")
}
}
if (Sys.which("pandoc-citeproc") == "") {
if (ignore_pandoc) {
## If ignore_pandoc is TRUE, just give a warning
warning(
"pandoc-citeproc is not available! ",
"The final report will not be generated."
)
} else {
## If ignore_pandoc is FALSE, stop
stop("pandoc-citeproc is not available!")
}
}
}
#' Happy hour!
#'
#' Start the happy hour, creating a report containing a document full of goodies
#' derived from the provided objects.
#'
#' @details When `happy_hour` is called, a RMarkdown template file will be copied
#' into the output directory, and [rmarkdown::render()] will be called to
#' generate the final report.
#'
#' As a default template, `happy_hour` uses the one delivered together with the
#' `GeneTonic` package, which provides a comprehensive overview of what the user
#' can extract. Experienced users can take that as a starting point to further
#' edit and customize.
#'
#' If there is already a .Rmd file with the same name in the output directory,
#' the function will raise an error and stop, to avoid overwriting the existing
#' file. The reason for this behaviour is that the copied template in the output
#' directory will be deleted once the report is generated.
#'
#' Credits to the original implementation proposed by Charlotte Soneson,
#' upon which this function is **heavily** inspired.
#'
#' @param dds A `DESeqDataSet` object, normally obtained after running your data
#' through the `DESeq2` framework.
#' @param res_de A `DESeqResults` object. As for the `dds` parameter, this is
#' also commonly used in the `DESeq2` framework.
#' @param res_enrich A `data.frame` object, storing the result of the functional
#' enrichment analysis. See [GeneTonic()] for the formatting requirements.
#' @param annotation_obj A `data.frame` object with the feature annotation
#' information, with at least two columns, `gene_id` and `gene_name`. See
#' [GeneTonic()] for the formatting requirements.
#' @param gtl A `GeneTonic`-list object, containing in its slots the arguments
#' specified above: `dds`, `res_de`, `res_enrich`, and `annotation_obj` - the names
#' of the list _must_ be specified following the content they are expecting
#' @param project_id A character string, which can be considered as an identifier
#' for the set/session, and will be e.g. used in the title of the report created
#' via [happy_hour()]
#' @param mygenesets A vector of character strings, containing the genesets to
#' focus on in the report - for each geneset, e.g. a signature heatmap can be
#' created.
#' @param mygenes A vector of character strings, containing the genes to focus on
#' in the report - for each gene, the plot of the expression values is included.
#' @param mygroup A character string, or a vector thereof. Contains the experimental
#' variables to be used to split into groups the expression data, and color
#' accordingly.
#' @param usage_mode A character string, which controls the behavior of the Rmd
#' document, based on whether the rendering is triggered while using the app
#' ("shiny_mode"), or offline, in batch mode. Defaults to "batch_mode".
#' @param input_rmd Character string with the path to the RMarkdown (.Rmd) file
#' that will be used as the template for generating the report. Defaults to NULL,
#' which will then use the one provided with the `GeneTonic` package.
#' @param output_file Character string, specifying the file name of the output
#' report. The file name extension must be either `.html` or `.pdf`, and consistent
#' with the value of `output_format`.
#' @param output_dir Character, defining the path to the output directory where
#' the report will be generated. Defaults to the temp directory (`tempdir()`).
#' @param output_format The format of the output report. Either `html_document`
#' or `pdf_document`. The file name extension of `output_file` must be consistent
#' with this choice. Can also be left empty and determined accordingly.
#' @param force_overwrite Logical, whether to force overwrite an existing report
#' with the same name in the output directory. Defaults to FALSE.
#' @param knitr_show_progress Logical, whether to display the progress of `knitr`
#' while generating the report. Defaults to FALSE.
#' @param ignore_pandoc Logical, controlling how the report generation function
#' will behave if `pandoc` or `pandoc-citeproc` are missing.
#' @param open_after_creating Logical, whether to open the report in the default
#' browser after being generated. Defaults to TRUE.
#' @param ... Other arguments that will be passed to [rmarkdown::render()].
#'
#' @seealso [GeneTonic()], [shake_topGOtableResult()], [shake_enrichResult()]
#'
#' @return Generates a fully fledged report in the `output_dir` directory, called
#' `output_file` and returns (invisibly) the name of the generated report.
#' @export
#'
#' @examples
#' library("macrophage")
#' library("DESeq2")
#' library("org.Hs.eg.db")
#' library("AnnotationDbi")
#'
#' # dds object
#' data("gse", package = "macrophage")
#' dds_macrophage <- DESeqDataSet(gse, design = ~ line + condition)
#' rownames(dds_macrophage) <- substr(rownames(dds_macrophage), 1, 15)
#' dds_macrophage <- estimateSizeFactors(dds_macrophage)
#'
#' # annotation object
#' anno_df <- data.frame(
#' gene_id = rownames(dds_macrophage),
#' gene_name = mapIds(org.Hs.eg.db,
#' keys = rownames(dds_macrophage),
#' column = "SYMBOL",
#' keytype = "ENSEMBL"
#' ),
#' stringsAsFactors = FALSE,
#' row.names = rownames(dds_macrophage)
#' )
#'
#' # res object
#' data(res_de_macrophage, package = "GeneTonic")
#' res_de <- res_macrophage_IFNg_vs_naive
#'
#' # res_enrich object
#' data(res_enrich_macrophage, package = "GeneTonic")
#' res_enrich <- shake_topGOtableResult(topgoDE_macrophage_IFNg_vs_naive)
#' res_enrich <- get_aggrscores(res_enrich, res_de, anno_df)
#' \dontrun{
#' happy_hour(
#' dds = dds_macrophage,
#' res_de = res_de,
#' res_enrich = res_enrich,
#' annotation_obj = anno_df,
#' project_id = "examplerun",
#' mygroup = "condition",
#' # mygroup = "line", # alternatively
#' mygenesets = res_enrich$gs_id[c(1:5, 11, 31)],
#' mygenes = c(
#' "ENSG00000125347",
#' "ENSG00000172399",
#' "ENSG00000137496"
#' )
#' )
#' }
happy_hour <- function(dds,
res_de,
res_enrich,
annotation_obj,
gtl = NULL,
project_id,
mygenesets,
mygenes,
mygroup = NULL,
usage_mode = "batch_mode",
input_rmd = NULL,
output_file = "my_first_GeneTonic_happyhour.html",
output_dir = tempdir(),
output_format = NULL,
force_overwrite = FALSE,
knitr_show_progress = FALSE,
ignore_pandoc = FALSE,
open_after_creating = TRUE,
...) {
# generates a nice number of outputs, plots, and so on, placed in a report. Boom :)
if (!is.null(gtl)) {
checkup_gtl(gtl)
dds <- gtl$dds
res_de <- gtl$res_de
res_enrich <- gtl$res_enrich
annotation_obj <- gtl$annotation_obj
}
# Check if pandoc and pandoc-citeproc are available
.check_pandoc(ignore_pandoc)
# If possible, set output format based on the extension of output_file, if the output format is not provided
if (is.null(output_format)) {
if (tools::file_ext(output_file) == "pdf") {
output_format <- "pdf_document"
} else {
output_format <- "html_document"
}
}
# Raise an error if output_format is not one of the allowed
if (!(output_format %in% c("pdf_document", "html_document"))) {
stop("The provided output_format is currently not supported. Please ",
"use either 'html_document' or 'pdf_document'.",
call. = FALSE
)
}
# Raise an error if the output format and file name extension don't match
if (output_format != paste0(tools::file_ext(output_file), "_document")) {
stop("File name extension of output_file (.",
tools::file_ext(output_file),
") doesn't agree with the ",
"output_format, should be .",
gsub("_document$", "", output_format),
call. = FALSE
)
}
# Check that all required input files are available and correctly formatted
checkup_GeneTonic(
dds,
res_de,
res_enrich, # or directly get_aggrscores(res_enrich, res_de, annotation_obj)
annotation_obj
)
# checking that a group is provided, otherwise assign the first column
if (is.null(mygroup)) {
# defaults to first column name in the colData
mygroup <- colnames(colData(dds))[1]
}
# output files
output_report <- file.path(output_dir, basename(output_file)) # no need of normalizePath?
output_rmd <- file.path(
output_dir,
paste0(tools::file_path_sans_ext(basename(output_file)), ".Rmd")
)
# report
if (file.exists(output_report)) {
if (!force_overwrite) {
stop("The file ", output_report,
" already exists. Please remove or rename the file, provide ",
"another value of output_file, or set force_overwrite = TRUE.",
call. = FALSE
)
} else {
warning("The file ", output_report,
" already exists and will be overwritten, since ",
"force_overwrite = TRUE.",
immediate. = TRUE,
call. = FALSE
)
}
}
# Rmd template
if (is.null(input_rmd)) {
template_rmd <- system.file("extdata",
"cocktail_recipe.Rmd",
package = "GeneTonic"
)
} else {
template_rmd <- input_rmd
}
if (file.exists(template_rmd)) {
if (file.exists(output_rmd)) {
stop("There is already an .Rmd file called ", output_rmd,
". Please remove or rename this file, or choose another ",
"output_file name.",
call. = FALSE
)
} else {
# another possible thought: work in a tempdir, that is probably even more elegant
file.copy(from = template_rmd, to = output_rmd, overwrite = FALSE)
}
} else {
stop("The Rmd template file ", template_rmd, " does not exist.",
call. = FALSE
)
}
# Process the arguments
args <- list(...)
args$input <- output_rmd
args$output_format <- output_format
args$output_file <- output_file
args$quiet <- !knitr_show_progress
# Render the report
output_file <- do.call("render", args = args)
# Remove temporary file
file.remove(output_rmd)
# Open up in a browser
if (open_after_creating) {
browseURL(output_file)
}
message("Report created in ", output_file)
invisible(output_file)
}
# nocov end