-
Notifications
You must be signed in to change notification settings - Fork 42
/
iSEE-main.R
695 lines (636 loc) · 30.4 KB
/
iSEE-main.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
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
#' iSEE: interactive SummarizedExperiment Explorer
#'
#' Interactive and reproducible visualization of data contained in a
#' \linkS4class{SummarizedExperiment} object, using a Shiny interface.
#'
#' @param se A \linkS4class{SummarizedExperiment} object, ideally with named assays.
#' If missing, an app is launched with a landing page generated by the \code{landingPage} argument.
#' @param initial A list of \linkS4class{Panel} objects specifying the initial state of the app.
#' The order of panels determines the sequence in which they are laid out in the interface.
#' Defaults to one instance of each panel class available from \pkg{iSEE}.
#' @param extra A list of additional \linkS4class{Panel} objects that might be added after the app has started.
#' Defaults to one instance of each panel class available from \pkg{iSEE}.
#' @param landingPage A function that renders a landing page when \code{iSEE} is started without any specified \code{se}.
#' Ignored if \code{se} is supplied.
#' @param colormap An \linkS4class{ExperimentColorMap} object that defines custom colormaps to apply to individual \code{assays}, \code{colData} and \code{rowData} covariates.
#' @param tour A data.frame with the content of the interactive tour to be displayed after starting up the app.
#' Ignored if \code{se} is not supplied.
#' @param appTitle A string indicating the title to be displayed in the app.
#' If not provided, the app displays the version info of \code{\link{iSEE}}.
#' @param runLocal A logical indicating whether the app is to be run locally or remotely on a server, which determines how documentation will be accessed.
#' @param voice A logical indicating whether the voice recognition should be enabled.
#' @param bugs Set to \code{TRUE} to enable the bugs Easter egg.
#' Alternatively, a named numeric vector control the respective number of each bug type (e.g., \code{c(bugs=3L, spiders=1L)}).
#' @param saveState A function that accepts a single argument containing the current application state and saves it to some appropriate location.
#' @param ... Further arguments to pass to \code{\link{shinyApp}}.
#'
#' @details
#' Configuring the initial state of the app is as easy as passing a list of \linkS4class{Panel} objects to \code{initial}.
#' Each element represents one panel and is typically constructed with a command like \code{\link{ReducedDimensionPlot}()}.
#' Panels are filled from left to right in a row-wise manner depending on the available width.
#' Each panel can be easily customized by modifying the parameters in each object.
#'
#' The \code{extra} argument should specify \linkS4class{Panel} classes that might not be shown during initialization
#' but can be added interactively by the user after the app has started.
#' The first instance of each new class in \code{extra} will be used as a template when the user adds a new panel of that class.
#' Note that \code{initial} will automatically be appended to \code{extra} to form the final set of available panels,
#' so it is not strictly necessary to re-specify instances of those initial panels in \code{extra}.
#' (unless we want the parameters of newly created panels to be different from those at initialization).
#'
#' @section Setting up a tour:
#' The \code{tour} argument allows users to specify a custom tour to walk their audience through various panels.
#' This is useful for describing different aspects of the dataset and highlighting interesting points in an interactive manner.
#'
#' We use the format expected by the \code{rintrojs} package - see \url{https://github.com/carlganz/rintrojs#usage} for more information.
#' There should be two columns, \code{element} and \code{intro}, with the former describing the element to highlight and the latter providing some descriptive text.
#' The \code{\link{defaultTour}} also provides the default tour that is used in the Examples below.
#'
#' @section Creating a landing page:
#' If \code{se} is not supplied, a landing page is generated that allows users to upload their own RDS file to initialize the app.
#' By default, the maximum request size for file uploads defaults to 5MB
#' (\url{https://shiny.rstudio.com/reference/shiny/0.14/shiny-options.html}).
#' To raise the limit (e.g., 50MB), run \code{options(shiny.maxRequestSize=50*1024^2)}.
#'
#' The \code{landingPage} argument can be used to alter the landing page, see \code{\link{createLandingPage}} for more details.
#' This is useful for creating front-ends that can retrieve \linkS4class{SummarizedExperiment}s from a database on demand for interactive visualization.
#'
#' @section Saving application state:
#' If users want to record the application state, they can download an RDS file containing a list with the entries:
#' \itemize{
#' \item \code{memory}, a list of \linkS4class{Panel} objects containing the current state of the application.
#' This can be directly re-used as the \code{initial} argument in a subsequent \code{\link{iSEE}} call.
#' \item \code{se}, the \linkS4class{SummarizedExperiment} object of interest.
#' This is optional and may not be present in the list, depending on the user specifications.
#' \item \code{colormap}, the \linkS4class{ExperimentColorMap} object being used.
#' This is optional and may not be present in the list, depending on the user specifications.
#' }
#'
#' We can also provide a custom function in \code{saveState} that accepts a single argument containing this list.
#' This is most useful when \code{\link{iSEE}} is deployed in an enterprise environment where sessions can be saved in a persistent location;
#' combined with a suitable \code{landingPage} specification, this allows users to easily reload sessions of interest.
#' The idea is very similar to Shiny bookmarks but is more customizable and can be used in conjunction with URL-based bookmarking.
#'
#' @return A Shiny app object is returned for interactive data exploration of \code{se},
#' either by simply printing the object or by explicitly running it with \code{\link{runApp}}.
#'
#' @references
#' Rue-Albrecht K, Marini F, Soneson C, Lun ATL.
#' iSEE: Interactive SummarizedExperiment Explorer
#' \emph{F1000Research} 7.
#'
#' Javascript code for \code{bugs} was based on \url{https://github.com/Auz/Bug}.
#'
#' @examples
#' library(scRNAseq)
#'
#' # Example data ----
#' sce <- ReprocessedAllenData(assays="tophat_counts")
#' class(sce)
#'
#' library(scater)
#' sce <- logNormCounts(sce, exprs_values="tophat_counts")
#'
#' sce <- runPCA(sce, ncomponents=4)
#' sce <- runTSNE(sce)
#' rowData(sce)$ave_count <- rowMeans(assay(sce, "tophat_counts"))
#' rowData(sce)$n_cells <- rowSums(assay(sce, "tophat_counts") > 0)
#' sce
#'
#' # launch the app itself ----
#'
#' app <- iSEE(sce)
#' if (interactive()) {
#' shiny::runApp(app, port=1234)
#' }
#'
#' @export
#' @importFrom shinydashboard dashboardBody dashboardHeader dashboardPage
#' dashboardSidebar menuItem tabBox valueBox valueBoxOutput dropdownMenu
#' notificationItem
#' @importFrom utils packageVersion
#' @importFrom shinyjs useShinyjs
#' @importFrom rintrojs introjsUI
#' @importFrom shiny reactiveValues uiOutput actionButton shinyApp
#' HTML icon tags includeCSS isolate showNotification onStop
iSEE <- function(se,
initial=NULL,
extra=NULL,
colormap=ExperimentColorMap(),
landingPage=createLandingPage(),
tour=NULL,
appTitle=NULL,
runLocal=TRUE,
voice=FALSE,
bugs=FALSE,
saveState=NULL,
...)
{
# Save the original name of the input object for renaming in the tracker
if (has_se <- !missing(se)) {
se_name <- deparse(substitute(se))
} else {
se_name <- "se"
}
ecm_name <- deparse(substitute(colormap))
if (is.null(initial) || is.null(extra)) {
all_defaults <- list(
ReducedDimensionPlot(),
RowDataTable(),
FeatureAssayPlot(),
ColumnDataPlot(),
RowDataPlot(),
SampleAssayPlot(),
ColumnDataTable(),
ComplexHeatmapPlot()
)
if (is.null(initial)) {
initial <- all_defaults
}
if (is.null(extra)) {
extra <- all_defaults
}
}
#######################################################################
## UI definition. ----
#######################################################################
iSEE_ui <- dashboardPage(
dashboardHeader(
title = ifelse(is.null(appTitle),
paste0("iSEE - interactive SummarizedExperiment Explorer v", packageVersion("iSEE")),
appTitle),
titleWidth = 750,
dropdownMenu(type = "tasks",
icon = icon("object-group"),
badgeStatus = NULL,
headerText = "Organization",
notificationItem(
text = actionButton(
.generalOrganizePanels,
label="Organize panels",
icon = icon("object-ungroup"),
style=.actionbutton_biocstyle
),
icon = icon(NULL), status = "primary"
),
notificationItem(
text=actionButton(
.generalLinkGraph,
label="Examine panel chart",
icon=icon("link"),
style=.actionbutton_biocstyle
),
icon=icon(NULL), status="primary"
)
),
dropdownMenu(type = "tasks",
icon = icon("download"),
badgeStatus = NULL,
headerText = "Export",
notificationItem(
text=actionButton(
.generalExportOutput,
label="Download panel output",
icon=icon("download"),
style=.actionbutton_biocstyle
),
icon=icon(NULL), status="primary"
),
notificationItem(
text=actionButton(
.generalTrackedCode,
label="Extract the R code",
icon=icon("wand-magic-sparkles"),
style=.actionbutton_biocstyle
),
icon=icon(NULL), status="primary"
),
notificationItem(
text=actionButton(
.generalPanelSettings,
label="Display panel settings",
icon=icon("clipboard"),
style=.actionbutton_biocstyle
),
icon=icon(NULL), status="primary"
)
), # end of dropdownMenu
dropdownMenu(type="tasks",
icon=icon("circle-question"),
badgeStatus=NULL,
headerText="Documentation",
notificationItem(
text=actionButton(
.generalTourSteps,
"Click me for a quick tour",
icon("hand-point-right"),
style=.actionbutton_biocstyle
),
icon=icon(NULL), # tricking it to not have additional icon
status="primary"
),
notificationItem(
text=actionButton(
.generalVignetteOpen,
label="Open the vignette",
icon=icon("book"),
style=.actionbutton_biocstyle,
onclick=ifelse(runLocal, "",
# Use web vignette, with varying paths depending on whether we're release or devel.
sprintf("window.open('http://bioconductor.org/packages/%s/bioc/vignettes/iSEE/inst/doc/basic.html', '_blank')",
ifelse(unlist(packageVersion("iSEE"))[2] %% 2L==0L, "release", "devel")
)
)
),
icon=icon(NULL),
status="primary"
),
notificationItem(
text=actionButton(
.generalDraftTour,
"Draft out a tour",
icon("lightbulb"),
style=.actionbutton_biocstyle
),
icon=icon(NULL), # tricking it to not have additional icon
status="primary"
)
),
dropdownMenu(type="tasks",
icon=icon("info"),
badgeStatus=NULL,
headerText="Additional information",
notificationItem(
text=actionButton(
.generalSessionInfo,
label="About this session",
icon=icon("window-maximize"),
style=.actionbutton_biocstyle
),
icon=icon(NULL), status="primary"
),
notificationItem(
text=actionButton(
.generalCitationInfo,
label="About iSEE",
icon=icon("heart"),
style=.actionbutton_biocstyle
),
icon=icon(NULL),
status="primary"
),
notificationItem(
text=actionButton(
.generalMetadataInfo,
label="About this dataset",
icon=icon("info"),
style=.actionbutton_biocstyle
),
icon=icon(NULL),
status="primary"
)
) # end of dropdownMenu
), # end of dashboardHeader
dashboardSidebar(disable=TRUE),
dashboardBody(
includeCSS(system.file(package="iSEE", "www", "iSEE.css")),
useShinyjs(),
prepareSpeechRecognition(voice),
.prepareBugsEasterEgg(bugs),
introjsUI(), # must be included in UI
# bugfix
# https://github.com/iSEE/iSEE/issues/594
# https://github.com/rstudio/shiny/issues/3125#issuecomment-876787895
htmltools::findDependencies(selectInput("test", "test", NULL)),
# for error message handling
tags$head(
tags$style(id="iSEE-styles",
HTML(".shiny-output-error-validation {
font-size: 15px;
color: forestgreen;
text-align: center;
}
")
)
),
uiOutput("allPanels")
), # end of dashboardBody
skin="black"
) # end of dashboardPage
#######################################################################
## Server definition. ----
#######################################################################
#nocov start
iSEE_server <- function(input, output, session) {
rObjects <- reactiveValues(rerender=1L, rerendered=1L, modified=list())
if (!has_se) {
FUN <- function(SE, INITIAL, TOUR=NULL, COLORMAP=colormap) {
if (is.null(INITIAL)) {
INITIAL <- initial
}
.initialize_server(SE, initial=INITIAL, extra=extra, colormap=COLORMAP,
tour=TOUR, runLocal=runLocal, se_name=se_name, ecm_name=ecm_name, saveState=saveState,
input=input, output=output, session=session, rObjects=rObjects)
rObjects$rerendered <- .increment_counter(isolate(rObjects$rerendered))
}
landingPage(FUN, input=input, output=output, session=session)
} else {
.initialize_server(se, initial=initial, extra=extra, colormap=colormap,
tour=tour, runLocal=runLocal, se_name=se_name, ecm_name=ecm_name, saveState=saveState,
input=input, output=output, session=session, rObjects=rObjects)
}
} # end of iSEE_server
#nocov end
#######################################################################
# Launching the app.
#######################################################################
shinyApp(ui=function(request) iSEE_ui, server=iSEE_server,
# Turning off validity checks in the classes for speed,
# given that we should internally guarantee correctness anyway.
onStart=function() {
# nocov start
old <- check.validity.env$check
check.validity.env$check <- FALSE
onStop(function() {
check.validity.env$check <- old
.deactivateAppOptionRegistry()
.clearSpecificTours()
})
# nocov end
},
# Enable bookmarking to be turned off, if so desired.
...)
}
#' Server-side initialization of the app
#'
#' This function defines the bulk of the server function used in \code{\link{shinyApp}}.
#' We roll it out into a separate function so that it can be run either immediately on the \code{\link{iSEE}} call
#' or upon user interaction with the landing page.
#'
#' @inheritParams iSEE
#' @param se_name String containing the variable name of the SummarizedExperiment object.
#' @param ecm_name String containing the variable name of the ExperimentColorMap object.
#' @param input,output,session The typical Shiny objects to be used in various reactive expressions.
#' @param rObjects A list of reactive variables used throughout the app.
#'
#' @return
#' Observers and reactive expressions for all app elements are defined.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_initialize_server
#' @importFrom shiny showNotification tagList HTML strong br code insertUI
.initialize_server <- function(se, initial, extra, colormap,
tour, runLocal, se_name, ecm_name, saveState,
input, output, session, rObjects)
{
# nocov start
if (grepl("[[:digit:]]+-12-06", Sys.Date())) {
showNotification(ui=HTML(paste0(
"<p style='font-size:500%; text-align:center;'>🎂</p>",
"<p style='font-size:200%; text-align:center;'>Happy Birthday <code>iSEE</code>!</p>", collapse = "")),
type="default", duration = NULL)
}
mod_commands <- "se <- iSEE::cleanDataset(se)"
env <- new.env()
env$se <- se
se <- eval(parse(text=mod_commands), envir=env)
# Activating the app option registry.
.activateAppOptionRegistry(se)
# Display an error notifications if colormap is not compatible with se
# Display one warning notification for each incompatibility issue
errors <- checkColormapCompatibility(colormap, se)
if (!is.null(errors)){
colormap <- ExperimentColorMap()
# Show unknown number of errors first, as they may be pushed out of screen
for (i in seq_along(errors)) {
ui_msg <- tagList(strong("Compatibility error:"), errors[i], ".")
showNotification(ui=ui_msg, type="error", duration=10)
}
# Show overall warning last, so that it is visible at the bottom of the screen
ui_msg <- tagList(
strong("Invalid colormap:"), br(),
"Reverting to default", code("ExperimentColorMap()"), "."
)
showNotification(ui=ui_msg, type="warning", duration=10)
}
# Preparing app state variables.
se <- .prepare_SE(se, colormap, c(initial, extra))
init_out <- .setup_initial_state(se, initial)
memory <- init_out$memory
counter <- init_out$counter
res_out <- .define_reservoir(se, extra, memory, counter)
reservoir <- res_out$reservoir
counter <- res_out$counter
# Validating the multiple selection sources to avoid invalid app state
# downstream. We also clean out the selection sources in the reservoir,
# given that there is no guarantee that the panel is still present.
all_names <- vapply(memory, .getEncodedName, "")
multi_sources <- .get_selection_sources(memory, all_names)
for (x in seq_along(memory)) {
if (!slot(memory[[x]], .selectRowSource) %in% multi_sources$row) {
slot(memory[[x]], .selectRowSource) <- .noSelection
}
if (!slot(memory[[x]], .selectColSource) %in% multi_sources$column) {
slot(memory[[x]], .selectColSource) <- .noSelection
}
}
for (r in seq_along(reservoir)) {
slot(reservoir[[r]], .selectRowSource) <- .noSelection
slot(reservoir[[r]], .selectColSource) <- .noSelection
}
pObjects <- .create_persistent_objects(memory, reservoir, counter)
# Adding CSS classes for all boxes.
class.def <- .define_box_statuses(c(memory, reservoir))
insertUI("#iSEE-styles", where="beforeEnd", HTML(class.def), immediate=TRUE)
# Evaluating certain plots to fill the coordinate list, if there are any
# multiple selections. This is done in topological order so that all
# dependencies between panels are satisfied, allowing downstream observers
# to render any panel in a valid state.
eval_order <- .establish_eval_order(pObjects$selection_links)
eval_extra <- .has_child(pObjects$aesthetics_links)
eval_order <- union(eval_order, eval_extra)
for (panel_name in eval_order) {
p.out <- .generateOutput(pObjects$memory[[panel_name]], se,
all_memory=pObjects$memory, all_contents=pObjects$contents)
pObjects$contents[[panel_name]] <- p.out$contents
}
# Observer set-up.
.create_general_observers(se, runLocal=runLocal, se_name=se_name, ecm_name=ecm_name,
mod_commands=mod_commands, saveState=saveState,
input=input, session=session, pObjects=pObjects, rObjects=rObjects)
.create_tour_observer(se, memory=pObjects$memory, tour=tour, input=input, session=session)
.create_tour_drafter(se, input=input, pObjects=pObjects)
.create_organization_observers(se=se, input=input, output=output, session=session,
pObjects=pObjects, rObjects=rObjects)
.create_child_propagation_observer(se, session=session, pObjects=pObjects, rObjects=rObjects)
for (idx in seq_along(pObjects$memory)) {
instance <- pObjects$memory[[idx]]
.createObservers(instance, se=se, input=input,
session=session, pObjects=pObjects, rObjects=rObjects)
.renderOutput(instance, se=se,
output=output, pObjects=pObjects, rObjects=rObjects)
}
.create_voice_observers(input, output, session, se, pObjects, rObjects)
.create_general_output(se, input, output, session, pObjects, rObjects)
invisible(NULL)
# nocov end
}
#' Prepare the SummarizedExperiment
#'
#' Stores useful information in the \linkS4class{SummarizedExperiment}'s metadata by calling \code{\link{.cacheCommonInfo}}.
#' Also stuffs the \linkS4class{ExperimentColorMap} in there.
#'
#' @param se A SummarizedExperiment object containing the current dataset.
#' @param colormap An ExperimentColorMap object.
#' @param available A list of all available \linkS4class{Panel} objects that might be used in the app.
#'
#' @return A modified \code{se} with extra information in its \code{\link{metadata}}.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_prepare_SE
#' @importFrom S4Vectors metadata metadata<-
.prepare_SE <- function(se, colormap, available) {
se <- .set_colormap(se, colormap)
for (entry in available) {
se <- .cacheCommonInfo(entry, se)
}
se
}
#' Set up the initial app state
#'
#' Set up the initial memory of the application by calling \code{\link{.refineParameters}} and removing invalid panels;
#' also filling in the \code{PanelId} slot for each panel that does not have it set to a positive integer.
#'
#' @param se A \linkS4class{SummarizedExperiment} object after running \code{\link{.prepare_SE}}.
#' @param initial A list of \linkS4class{Panel} objects representing the requested initial state of the application.
#'
#' @return
#' A list containing \code{memory}, a list of \linkS4class{Panel}s that is ready for use as the initial state;
#' and \code{counter}, an integer vector of the current ID counter for each Panel class.
#'
#' @author Aaron Lun
#'
#' @rdname INTERNAL_setup_initial_state
.setup_initial_state <- function(se, initial) {
# Refining the initial panels.
for (idx in seq_along(initial)) {
initial[idx] <- list(.refineParameters(initial[[idx]], se))
}
memory <- initial[!vapply(initial, is.null, TRUE)]
# Assigning names and IDs to each panel.
all_modes <- vapply(memory, .encodedName, "")
all_ids <- vapply(memory, "[[", i=.organizationId, 0L)
by_mode <- split(all_ids, all_modes)
counter <- vapply(by_mode, function(x) max(c(0L, x), na.rm=TRUE), 0L)
for (idx in seq_along(memory)) {
instance <- memory[[idx]]
curid <- slot(instance, .organizationId)
if (is.na(curid)) {
nm <- .encodedName(instance)
curid <- counter[nm] + 1L
slot(memory[[idx]], .organizationId) <- curid
counter[nm] <- curid
}
}
all_names <- vapply(memory, .getEncodedName, "")
if (dup <- anyDuplicated(all_names)) {
stop("panels of same class with duplicated IDs '", all_names[dup], "'")
}
names(memory) <- all_names
list(memory=memory, counter=counter)
}
#' Define the reservoir of available Panels
#'
#' Define a reservoir of available \linkS4class{Panel} classes that can be added interactively by the user.
#'
#' @param se A \linkS4class{SummarizedExperiment} object after running \code{\link{.prepare_SE}}.
#' @param extra A list of \linkS4class{Panel} instances representing the classes that can be added.
#' @param memory A list of \linkS4class{Panel} instances representing the initial app state,
#' generated by \code{\link{.setup_initial_state}}.
#' @param counter An integer vector of the ID counter for each Panel class,
#' generated by \code{\link{.setup_initial_state}}.
#'
#' @author Aaron Lun
#'
#' @return
#' A list containing \code{reservoir}, a list of Panels with one representative instance of each class that can be added;
#' and \code{counter}, an updated version of the input \code{counter} with entries added for new classes in \code{extra}.
#'
#' @rdname INTERNAL_define_reservoir
.define_reservoir <- function(se, extra, memory, counter) {
# Adding a reservoir of extra panel classes.
for (idx in seq_along(extra)) {
extra[idx] <- list(.refineParameters(extra[[idx]], se))
}
extra <- extra[!vapply(extra, is.null, TRUE)]
extra_enc <- vapply(extra, .encodedName, "")
leftovers <- setdiff(extra_enc, names(counter))
empty <- integer(length(leftovers))
names(empty) <- leftovers
counter <- c(counter, empty)
reservoir <- c(extra, memory)
res_names <- c(extra_enc, vapply(memory, .encodedName, ""))
res_nondup <- !duplicated(res_names)
reservoir <- reservoir[res_nondup]
names(reservoir) <- res_names[res_nondup]
list(reservoir=reservoir, counter=counter)
}
#' Create persistent objects
#'
#' Create global persistent objects in an environment that provides pass-by-reference behavior throughout the application.
#'
#' @param memory A list of \linkS4class{Panel}s produced by \code{\link{.setup_initial_state}}.
#' @param reservoir A list of \linkS4class{Panel}s produced by \code{\link{.define_reservoir}}.
#' @param counter An integer vector produced by \code{\link{.define_reservoir}}.
#'
#' @return
#' An environment containing several global variables for use throughout the application.
#'
#' @details
#' The following objects are created:
#' \itemize{
#' \item \code{memory}, a list of Panels representing the current state of the application at any point in time.
#' This may be modified by observers throughout the lifetime of the app.
#' \item \code{reservoir}, a list of Panels representing the available classes that can be added interactively by the user.
#' This should not change throughout the lifetime of the app.
#' \item \code{counter}, an integer vector specifying the largest ID for each class.
#' This will be incremented every time a user adds an instance of that class.
#' \item \code{commands}, a list of lists of character vectors.
#' Each internal list corresponds to a Panel and contains the R commands necessary to produce its output.
#' \item \code{cached}, a list of the panel-specific outputs of \code{\link{.generateOutput}}.
#' This is filled by the observer in \code{\link{.create_child_propagation_observer}}
#' and used by \code{\link{.retrieveOutput}}, usually in \code{\link{.renderOutput}}'s rendering expression.
#' \item \code{contents}, a list of panel-specific contents.
#' This is filled by \code{\link{.create_child_propagation_observer}} and is pulled out by each panel's children.
#' Values are used to cross-reference with that panel's multiple selection structure to determine which points were selected.
#' \item \code{varname}, a list of strings indicating which variable in a panel's \code{commands} represents that panel's \code{contents}.
#' This is used within \code{\link{.track_it_all}} to ensure that the reported code makes sense.
#' \item \code{selection_links}, a \link{graph} containing the links between panels due to transmitted multiple selections.
#' This is constructed by \code{\link{.spawn_multi_selection_graph}} and can be modified by \code{\link{.choose_new_parent}}.
#' \item \code{aesthetics_links}, a \link{graph} containing the links between panels due to transmitted single selections.
#' This is constructed by \code{\link{.spawn_single_selection_graph}} and can be modified by \code{\link{.choose_new_parent}}.
#' \item \code{dynamic_multi_selections}, a list containing the panels participating in the dynamic multiple selection scheme.
#' This is constructed by \code{\link{.spawn_dynamic_multi_selection_list}}.
#' \item \code{dynamic_single_selections}, a list containing the panels participating in the dynamic single selection scheme.
#' This is constructed by \code{\link{.spawn_dynamic_single_selection_list}}.
#' }
#'
#' @author Aaron Lun
#' @rdname INTERNAL_create_persistent_objects
.create_persistent_objects <- function(memory, reservoir, counter) {
pObjects <- new.env()
pObjects$memory <- memory
pObjects$reservoir <- reservoir
pObjects$counter <- counter
pObjects$commands <- list()
pObjects$cached <- list()
pObjects$contents <- list()
pObjects$varname <- list()
pObjects$aesthetics_links <- .spawn_single_selection_graph(memory)
pObjects$selection_links <- .spawn_multi_selection_graph(memory)
pObjects$dynamic_multi_selections <- .spawn_dynamic_multi_selection_list(memory)
pObjects$dynamic_single_selections <- .spawn_dynamic_single_selection_list(memory)
pObjects[[.voiceActivePanel]] <- NA_character_
pObjects
}