Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Attempt to fix Result block don't get updated properly #432 #435

Open
wants to merge 6 commits into
base: main
Choose a base branch
from
Open

Attempt to fix Result block don't get updated properly #432 #435

Show file tree
Hide file tree
Changes from 3 commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
a9330aa
Attempt to fix Result block don't get updated properly #432
DivadNojnarg Oct 14, 2024
6f67cb5
fix issue with parser block since input data isn't a data.frame but a…
DivadNojnarg Oct 14, 2024
38a2f60
wait for input[["select-stack"]]
DivadNojnarg Oct 14, 2024
b4d605a
fix join_block by issue (empty intersection)
DivadNojnarg Oct 14, 2024
8260e59
fix issue with plot blocks, bump version + fix tests
DivadNojnarg Oct 14, 2024
c03f1d5
fix Min version dependency for shinyWidgets #434
DivadNojnarg Oct 14, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 2 additions & 1 deletion .lintr
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2,7 +2,8 @@ linters: linters_with_defaults(
line_length_linter = line_length_linter(100L),
object_name_linter = NULL, # Because we use S3 and end up with is_initialized.field
object_usage_linter = NULL, # When code is WIP this is annoying ...
commented_code_linter = NULL # When code is WIP this is annoying ...
commented_code_linter = NULL, # When code is WIP this is annoying ...
cyclocomp_linter = cyclocomp_linter(complexity_limit = 20)
)
exclusions: list(
"inst/examples/cdisc-plot/example.R",
Expand Down
41 changes: 31 additions & 10 deletions R/server.R
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -44,13 +44,19 @@ generate_server.result_field <- function(x, ...) {
updateSelectInput(
session,
"select-stack",
choices = result_field_stack_opts(session$ns, workspace_stacks()),
choices = result_field_stack_opts(session$ns, names(workspace_stacks())),
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Since we pass the entire stack object in the reactive_stack_directory, we just extract the names to display them in the select choices.

selected = input[["select-stack"]]
)
)

reactive({
get_result(input[["select-stack"]])
req(input[["select-stack"]])
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is needed now as this expression takes dependencies on other reactive element. Avoids to subset when input$select-stack is NULL.

stacks <- workspace_stacks()
blocks <- stacks[[input[["select-stack"]]]]$blocks
all_valid <- lgl_ply(blocks, \(block) {
block$is_valid()
})
if (all(all_valid) == TRUE) get_result(input[["select-stack"]]) else data.frame()
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Overall, we check that the previous stack is valid (otherwise the result block has no way to know about the previous blocks from the linked stack). Note: this will be superseded in the stack validation PR #427.

})
})
}
Expand Down Expand Up @@ -159,6 +165,7 @@ generate_server_block <- function(
obs$update_blk <- observeEvent(c(r_values(), in_dat(), is_prev_valid()),
{
# 1. upd blk,
is_valid$block <- FALSE
b <- update_blk(
b = blk(),
value = r_values(),
Expand Down Expand Up @@ -210,7 +217,7 @@ generate_server_block <- function(
out_dat <- if (attr(x, "submit") > -1) {
eventReactive(input$submit,
{
req(is_valid$block)
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

req was blocking the reactive chain. We just return an empty data.frame if invalid.

if (!is_valid$block) return(data.frame())
if (is.null(in_dat())) {
evaluate_block(blk())
} else {
Expand All @@ -223,10 +230,11 @@ generate_server_block <- function(
)
} else {
reactive({
req(is_valid$block)
if (!is_valid$block) return(data.frame())
if (is.null(in_dat()) && !inherits(x, "transform_block")) {
evaluate_block(blk())
} else {
if (nrow(in_dat()) == 0 && !inherits(x, "parser_block")) return(data.frame())
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

parser_block are an exception as their input isn't rectangular data but a file path.

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I actually replaced this by:

if (inherits(in_dat(), "data.frame") && nrow(in_dat()) == 0) {
              return(data.frame())
            }

as it broke the plots.

evaluate_block(blk(), data = in_dat())
}
})
Expand Down Expand Up @@ -396,10 +404,15 @@ generate_server.stack <- function(x, id = NULL, new_block = NULL,
# Any block change: data or input should be sent
# up to the stack so we can properly serialise.
observeEvent(
c(
get_block_vals(vals$blocks),
get_last_block_data(vals$blocks)()
),
{
lapply(vals$blocks, \(block) {
req(block)
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

a little extra check to prevent this event from triggering when vals$block is a list of NULL elements.

})
c(
get_block_vals(vals$blocks),
get_last_block_data(vals$blocks)()
)
},
{
vals$stack <- set_stack_blocks(
vals$stack,
Expand Down Expand Up @@ -702,9 +715,17 @@ generate_server.workspace <- function(x, id, ...) {
})

attr(x, "reactive_stack_directory") <- reactive({
names(vals$stacks)
vals$stacks
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

We need to pass the stacks to do further check within the result field server logic.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Just for my understanding: why do we need to pass through the entire stacks here? Initially the intention for the reactive_stack_directory was just to give a reactive object for populating result field drop-downs. Where do we need the reactive stack? Sorry, I didn't spot anything relevant in your changes.

Copy link
Collaborator

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I see, it is the validity check for the dependent stack that this is used for. If this is the chase, the result field validator should take care of this, no? Can we extend

blockr/R/fields.R

Lines 298 to 312 in 061ac78

validate_field.result_field <- function(x) {
field <- get_field_value(x, "value")
validate_string(field)
if (!field %in% list_workspace_stacks()) {
validation_failure(
"result fields have to refer to existing stack names",
class = "result_failure"
)
}
NextMethod()
}

to not only check for existence of a stack, but also it's "validity"?

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I played around this idea in 5822c89. However, while it works well for a "static" case, that is, with predefined stacks, it fails in the dynamic case when block are added on the fly:

# works
serve_workspace(
  stack1 = new_stack(new_dataset_block("BOD"), new_select_block()),
  stack2 = new_stack(new_result_block("stack1"))
)

# fails: to replicate, add a new_select_block on the fly and nothing happens.
serve_workspace(
  stack1 = new_stack(new_dataset_block("BOD")),
  stack2 = new_stack(new_result_block("stack1"))
)

Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Actually this just does not work. My workspace was already contaminated by other existing stacks so I though it worked but no ...

}) |> bindEvent(
chr_ply(lapply(vals$stacks, `[[`, "stack"), attr, "title")
c(
chr_ply(lapply(vals$stacks, `[[`, "stack"), attr, "title"),
lapply(vals$stack, \(stack) {
Copy link
Collaborator Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

added an extra trigger each time a block changes and it's validity change, otherwise the result field does not update consistently.

lgl_ply(stack$blocks, \(block) {
block$is_valid()
block$block
})
})
)
)

# Serialize
Expand Down
Loading