/
teal_slices.R
172 lines (159 loc) · 5.67 KB
/
teal_slices.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
#' Filter settings for `teal` applications
#'
#' Specify initial filter states and filtering settings for a `teal` app.
#'
#' Produces a `teal_slices` object.
#' The `teal_slice` components will specify filter states that will be active when the app starts.
#' Attributes (created with the named arguments) will configure the way the app applies filters.
#' See argument descriptions for details.
#'
#' @inheritParams teal.slice::teal_slices
#'
#' @param module_specific (`logical(1)`) optional,
#' - `FALSE` (default) when one filter panel applied to all modules.
#' All filters will be shared by all modules.
#' - `TRUE` when filter panel module-specific.
#' Modules can have different set of filters specified - see `mapping` argument.
#' @param mapping `r lifecycle::badge("experimental")`
#' _This is a new feature. Do kindly share your opinions on
#' [`teal`'s GitHub repository](https://github.com/insightsengineering/teal/)._
#'
#' (named `list`) specifies which filters will be active in which modules on app start.
#' Elements should contain character vector of `teal_slice` `id`s (see [`teal.slice::teal_slice`]).
#' Names of the list should correspond to `teal_module` `label` set in [module()] function.
#' - `id`s listed under `"global_filters` will be active in all modules.
#' - If missing, all filters will be applied to all modules.
#' - If empty list, all filters will be available to all modules but will start inactive.
#' - If `module_specific` is `FALSE`, only `global_filters` will be active on start.
#' @param app_id (`character(1)`)
#' For internal use only, do not set manually.
#' Added by `init` so that a `teal_slices` can be matched to the app in which it was used.
#' Used for verifying snapshots uploaded from file. See `snapshot`.
#'
#' @param x (`list`) of lists to convert to `teal_slices`
#'
#' @return
#' A `teal_slices` object.
#'
#' @seealso [`teal.slice::teal_slices`], [`teal.slice::teal_slice`], [slices_store()]
#'
#' @examples
#' filter <- teal_slices(
#' teal_slice(dataname = "iris", varname = "Species", id = "species"),
#' teal_slice(dataname = "iris", varname = "Sepal.Length", id = "sepal_length"),
#' teal_slice(
#' dataname = "iris", id = "long_petals", title = "Long petals", expr = "Petal.Length > 5"
#' ),
#' teal_slice(dataname = "mtcars", varname = "mpg", id = "mtcars_mpg"),
#' mapping = list(
#' module1 = c("species", "sepal_length"),
#' module2 = c("mtcars_mpg"),
#' global_filters = "long_petals"
#' )
#' )
#'
#' app <- init(
#' data = teal_data(iris = iris, mtcars = mtcars),
#' modules = list(
#' module("module1"),
#' module("module2")
#' ),
#' filter = filter
#' )
#'
#' if (interactive()) {
#' shinyApp(app$ui, app$server)
#' }
#'
#' @export
teal_slices <- function(...,
exclude_varnames = NULL,
include_varnames = NULL,
count_type = NULL,
allow_add = TRUE,
module_specific = FALSE,
mapping,
app_id = NULL) {
shiny::isolate({
checkmate::assert_flag(allow_add)
checkmate::assert_flag(module_specific)
if (!missing(mapping)) checkmate::assert_list(mapping, types = c("character", "NULL"), names = "named")
checkmate::assert_string(app_id, null.ok = TRUE)
slices <- list(...)
all_slice_id <- vapply(slices, `[[`, character(1L), "id")
if (missing(mapping)) {
mapping <- list(global_filters = all_slice_id)
}
if (!module_specific) {
mapping[setdiff(names(mapping), "global_filters")] <- NULL
}
failed_slice_id <- setdiff(unlist(mapping), all_slice_id)
if (length(failed_slice_id)) {
stop(sprintf(
"Filters in mapping don't match any available filter.\n %s not in %s",
toString(failed_slice_id),
toString(all_slice_id)
))
}
tss <- teal.slice::teal_slices(
...,
exclude_varnames = exclude_varnames,
include_varnames = include_varnames,
count_type = count_type,
allow_add = allow_add
)
attr(tss, "mapping") <- mapping
attr(tss, "module_specific") <- module_specific
attr(tss, "app_id") <- app_id
class(tss) <- c("modules_teal_slices", class(tss))
tss
})
}
#' @rdname teal_slices
#' @export
#' @keywords internal
#'
as.teal_slices <- function(x) { # nolint: object_name.
checkmate::assert_list(x)
lapply(x, checkmate::assert_list, names = "named", .var.name = "list element")
attrs <- attributes(unclass(x))
ans <- lapply(x, function(x) if (is.teal_slice(x)) x else as.teal_slice(x))
do.call(teal_slices, c(ans, attrs))
}
#' @rdname teal_slices
#' @export
#' @keywords internal
#'
c.teal_slices <- function(...) {
x <- list(...)
checkmate::assert_true(all(vapply(x, is.teal_slices, logical(1L))), .var.name = "all arguments are teal_slices")
all_attributes <- lapply(x, attributes)
all_attributes <- coalesce_r(all_attributes)
all_attributes <- all_attributes[names(all_attributes) != "class"]
do.call(
teal_slices,
c(
unique(unlist(x, recursive = FALSE)),
all_attributes
)
)
}
#' Deep copy `teal_slices`
#'
#' it's important to create a new copy of `teal_slices` when
#' starting a new `shiny` session. Otherwise, object will be shared
#' by multiple users as it is created in global environment before
#' `shiny` session starts.
#' @param filter (`teal_slices`)
#' @return `teal_slices`
#' @keywords internal
deep_copy_filter <- function(filter) {
checkmate::assert_class(filter, "teal_slices")
shiny::isolate({
filter_copy <- lapply(filter, function(slice) {
teal.slice::as.teal_slice(as.list(slice))
})
attributes(filter_copy) <- attributes(filter)
filter_copy
})
}