Skip to content

Commit

Permalink
following new teal_data class
Browse files Browse the repository at this point in the history
  • Loading branch information
gogonzo committed Oct 4, 2023
1 parent 329f7f9 commit 5c17ccf
Show file tree
Hide file tree
Showing 4 changed files with 42 additions and 41 deletions.
24 changes: 20 additions & 4 deletions R/init.R
Original file line number Diff line number Diff line change
Expand Up @@ -116,7 +116,10 @@ init <- function(data,
logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).")
data <- teal.data::to_relational_data(data = data)

checkmate::assert_class(data, "TealData")
if (!inherits(data, c("TealData", "teal_data"))) {
data <- teal.data::to_relational_data(data = data)
}
checkmate::assert_multi_class(data, c("TealData", "teal_data"))
checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules"))
checkmate::assert_string(title, null.ok = TRUE)
checkmate::assert(
Expand All @@ -138,7 +141,7 @@ init <- function(data,

# resolve modules datanames
datanames <- teal.data::get_dataname(data)
join_keys <- data$get_join_keys()
join_keys <- teal.data::get_join_keys(data)
resolve_modules_datanames <- function(modules) {
if (inherits(modules, "teal_modules")) {
modules$children <- sapply(modules$children, resolve_modules_datanames, simplify = FALSE)
Expand All @@ -147,6 +150,17 @@ init <- function(data,
modules$datanames <- if (identical(modules$datanames, "all")) {
datanames
} else if (is.character(modules$datanames)) {
extra_datanames <- setdiff(modules$datanames, datanames)
if (length(extra_datanames)) {
stop(
sprintf(
"Module %s has datanames that are not available in a 'data':\n %s not in %s",
modules$label,
toString(extra_datanames),
toString(datanames)
)
)
}
datanames_adjusted <- intersect(modules$datanames, datanames)
include_parent_datanames(dataname = datanames_adjusted, join_keys = join_keys)
}
Expand Down Expand Up @@ -212,8 +226,10 @@ init <- function(data,
res <- list(
ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer),
server = function(input, output, session) {
# copy object so that load won't be shared between the session
data <- data$copy(deep = TRUE)
if (inherits(data, "TealDataAbstract")) {
# copy TealData so that load won't be shared between the session
data <- data$copy(deep = TRUE)
}
filter <- deep_copy_filter(filter)
srv_teal_with_splash(id = id, data = data, modules = modules, filter = filter)
}
Expand Down
14 changes: 8 additions & 6 deletions R/module_nested_tabs.R
Original file line number Diff line number Diff line change
Expand Up @@ -314,12 +314,14 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
data,
eventReactive(
trigger_data(),
c(
get_rcode_str_install(),
get_rcode_libraries(),
get_datasets_code(datanames, datasets, hashes),
teal.slice::get_filter_expr(datasets, datanames)
)
{
c(
get_rcode_str_install(),
get_rcode_libraries(),
get_datasets_code(datanames, datasets, hashes),
teal.slice::get_filter_expr(datasets, datanames)
)
}
),
datasets$get_join_keys(),
metadata
Expand Down
27 changes: 4 additions & 23 deletions R/module_teal.R
Original file line number Diff line number Diff line change
Expand Up @@ -162,10 +162,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {

# loading the data -----
env <- environment()
datasets_reactive <- reactive({
if (is.null(raw_data())) {
return(NULL)
}
datasets_reactive <- eventReactive(raw_data(), ignoreNULL = TRUE, {
env$progress <- shiny::Progress$new(session)
env$progress$set(0.25, message = "Setting data")

Expand All @@ -184,25 +181,9 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) {
} else if (isTRUE(attr(filter, "module_specific"))) {
# we should create FilteredData even if modules$datanames is null
# null controls a display of filter panel but data should be still passed
datanames <- if (is.null(modules$datanames)) raw_data()$get_datanames() else modules$datanames
data_objects <- sapply(
datanames,
function(dataname) {
dataset <- raw_data()$get_dataset(dataname)
list(
dataset = dataset$get_raw_data(),
metadata = dataset$get_metadata(),
label = dataset$get_dataset_label()
)
},
simplify = FALSE
)
datasets_module <- teal.slice::init_filtered_data(
data_objects,
join_keys = raw_data()$get_join_keys(),
code = raw_data()$get_code_class(),
check = raw_data()$get_check()
)
datanames <- if (is.null(modules$datanames)) teal.data::get_dataname(raw_data()) else modules$datanames
# todo: subset tdata object to datanames
datasets_module <- teal.slice::init_filtered_data(raw_data())

# set initial filters
slices <- Filter(x = filter, f = function(x) {
Expand Down
18 changes: 10 additions & 8 deletions R/module_teal_with_splash.R
Original file line number Diff line number Diff line change
Expand Up @@ -22,16 +22,16 @@ ui_teal_with_splash <- function(id,
title,
header = tags$p("Add Title Here"),
footer = tags$p("Add Footer Here")) {
checkmate::assert_class(data, "TealDataAbstract")
is_pulled_data <- teal.data::is_pulled(data)
checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data"))
ns <- NS(id)

# Startup splash screen for delayed loading
# We use delayed loading in all cases, even when the data does not need to be fetched.
# This has the benefit that when filtering the data takes a lot of time initially, the
# Shiny app does not time out.
splash_ui <- if (is_pulled_data) {
# blank ui if data is already pulled
splash_ui <- if (inherits(data, "teal_data")) {
div()
} else if (teal.data::is_pulled(data)) {
div()
} else {
message("App was initialized with delayed data loading.")
Expand All @@ -55,7 +55,7 @@ ui_teal_with_splash <- function(id,
#' @return `reactive`, return value of [srv_teal()]
#' @export
srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
checkmate::assert_class(data, "TealDataAbstract")
checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data"))
moduleServer(id, function(input, output, session) {
logger::log_trace(
"srv_teal_with_splash initializing module with data { paste(data$get_datanames(), collapse = ' ')}."
Expand All @@ -65,17 +65,19 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) {
shinyjs::showLog()
}

is_pulled_data <- teal.data::is_pulled(data)
# raw_data contains TealDataAbstract, i.e. R6 object and container for data
# reactive to get data through delayed loading
# we must leave it inside the server because of callModule which needs to pick up the right session
if (is_pulled_data) {
raw_data <- reactiveVal(data) # will trigger by setting it
raw_data <- if (inherits(data, "teal_data")) {
reactiveVal(data)
} else if (teal.data::is_pulled(data)) {
reactiveVal(data) # will trigger by setting it
} else {
raw_data <- data$get_server()(id = "startapp_module")
if (!is.reactive(raw_data)) {
stop("The delayed loading module has to return a reactive object.")
}
raw_data
}

res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data, filter = filter)
Expand Down

0 comments on commit 5c17ccf

Please sign in to comment.