Skip to content

Commit 7e9731b

Browse files
gaelsogaelso
committed
Added table first as analysis result.
1 parent 58d3ba7 commit 7e9731b

4 files changed

Lines changed: 140 additions & 9 deletions

File tree

‎DESCRIPTION‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -14,6 +14,7 @@ Imports:
1414
crosstalk,
1515
d3scatter (>= 0.1.0),
1616
datasets,
17+
DT,
1718
dplyr,
1819
ggplot2,
1920
htmltools,

‎R/fct_arenalyse.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -39,8 +39,8 @@ fct_arenalyse <- function(.zip, .entity, .dim, .pb_session = NULL, .pb_id = NULL
3939

4040
## !!! FOR TESTING ONLY
4141
# .zip <- fct_readzip2(.path = "inst/extdata/OLAP_Shiny_demo.zip") ; names(.zip)
42-
# .entity <- .zip$chain_summary$analysis$entity
43-
# .dim <- .zip$chain_summary$analysis$dimensions
42+
# .entity <- .zip$data$chain_summary$analysis$entity
43+
# .dim <- .zip$data$chain_summary$analysis$dimensions
4444
# .dim
4545
# .dim <- c("tree_plant_type", "province", "stratum_calc", "dbh_up100_10cm", "cluster_land_use", "cluster_forest_type", "cluster_forest_status")
4646
# summary(.zip[[paste0("OLAP_", .entity)]])

‎R/mod_tool_UI2.R‎

Lines changed: 41 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -331,14 +331,53 @@ mod_tool_UI2 <- function(id, i18n, .tr){
331331
id = ns("analysis_console"),
332332
style =
333333
"height: 300px; overflow-y: auto; background-color:#f7f7f7; font-family:monospace; font-size: small;"
334+
),
335+
br(),
336+
shinyjs::disabled(
337+
actionButton(
338+
inputId = ns("btn_analysis_results"),
339+
label = "Show analysis results"
340+
)
334341
)
335342
)),
336343

337344
## Results layout - hidden until analysis completes
338345
shinyjs::hidden(div(
339346
id = ns("analysis_results"),
340347

341-
## -- Row 1: main plot controls ----------------------------------
348+
## ++ ##
349+
## -- Row 1: analysis table --------------------------------------
350+
card(
351+
card_header("Analysis data used for figures"),
352+
layout_column_wrap(
353+
width = "220px",
354+
fill = FALSE,
355+
selectInput(
356+
ns("analysis_table_source"),
357+
"Table source",
358+
choices = c("Means (per ha)" = "MEANS", "Totals" = "TOTALS"),
359+
selected = "MEANS"
360+
),
361+
shinyWidgets::pickerInput(
362+
ns("analysis_table_measures"),
363+
"Measures shown in table",
364+
choices = NULL,
365+
selected = NULL,
366+
multiple = TRUE,
367+
options = list(
368+
`actions-box` = TRUE,
369+
`selected-text-format` = "count > 3"
370+
)
371+
),
372+
downloadButton(
373+
ns("analysis_table_download"),
374+
"Download full table (CSV)"
375+
)
376+
),
377+
DT::DTOutput(ns("analysis_table"))
378+
),
379+
380+
## -- Row 2: main plot controls ----------------------------------
342381
card(
343382
layout_column_wrap(
344383
width = "180px",
@@ -361,7 +400,7 @@ mod_tool_UI2 <- function(id, i18n, .tr){
361400
)
362401
## $$$
363402
),
364-
## -- Row 2: extra dimension filters (shown only when >3 dims used) --
403+
## -- Row 3: extra dimension filters (shown only when >3 dims used) --
365404
uiOutput(ns("analysis_extra_filters"))
366405
),
367406

‎R/mod_tool_server2.R‎

Lines changed: 96 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -265,6 +265,7 @@ mod_tool_server2 <- function(id, rv) {
265265
shinyjs::hide("analysis_results")
266266
shinyjs::show("analysis_progress")
267267
shinyjs::html("analysis_console", "")
268+
shinyjs::disable("btn_analysis_results")
268269
shinyWidgets::updateProgressBar(
269270
session = session,
270271
id = "analysis_progress_bar",
@@ -288,6 +289,7 @@ mod_tool_server2 <- function(id, rv) {
288289
}
289290
),
290291
error = function(e) {
292+
shinyjs::disable("btn_analysis_results")
291293
shinyjs::hide("analysis_progress")
292294
shinyjs::toggle("analysis_results", condition = !is.null(rv$analysis$result))
293295
shinyjs::toggle("analysis_no_result", condition = is.null(rv$analysis$result))
@@ -313,11 +315,20 @@ mod_tool_server2 <- function(id, rv) {
313315
rv$analysis$dims <- dims_sel
314316
rv$analysis$entity <- input$analysis_sel_entity
315317

316-
shinyjs::hide("analysis_progress")
318+
shinyjs::enable("btn_analysis_results")
317319
}
318320
})
319321
## ++ ##
320322

323+
## ++ ##
324+
observeEvent(input$btn_analysis_results, {
325+
req(rv$analysis$result)
326+
shinyjs::hide("analysis_progress")
327+
shinyjs::hide("analysis_no_result")
328+
shinyjs::show("analysis_results")
329+
})
330+
## ++ ##
331+
321332
## $$$
322333

323334

@@ -611,6 +622,51 @@ mod_tool_server2 <- function(id, rv) {
611622
p
612623
}
613624

625+
## ++ ##
626+
filtered_analysis_df <- function(source = c("MEANS", "TOTALS")) {
627+
source <- match.arg(source)
628+
629+
req(rv$analysis$result)
630+
631+
df <- rv$analysis$result[[source]]
632+
filters <- tryCatch(get_filter_vals(), error = function(e) NULL)
633+
634+
if (is.null(filters)) {
635+
return(df)
636+
}
637+
638+
for (nm in names(filters)) {
639+
vals <- filters[[nm]]
640+
if (length(vals) > 0) {
641+
df <- dplyr::filter(df, .data[[nm]] %in% vals)
642+
}
643+
}
644+
645+
df
646+
}
647+
648+
table_display_df <- function(source = c("MEANS", "TOTALS")) {
649+
source <- match.arg(source)
650+
651+
df <- filtered_analysis_df(source)
652+
measure_names <- rv$analysis$measures_meta |> dplyr::pull("name")
653+
selected_measures <- input$analysis_table_measures %||% measure_names
654+
655+
measure_cols <- names(df)[
656+
purrr::map_lgl(
657+
names(df),
658+
\(col) any(stringr::str_detect(col, paste0("^", selected_measures, "($|_)")))
659+
)
660+
]
661+
662+
keep_cols <- unique(c(setdiff(names(df), unlist(
663+
purrr::map(measure_names, \(m) names(df)[stringr::str_detect(names(df), paste0("^", m, "($|_)"))])
664+
)), measure_cols))
665+
666+
dplyr::select(df, dplyr::all_of(keep_cols))
667+
}
668+
## ++ ##
669+
614670
## . + Update plot selectors when a new result arrives ------
615671
observeEvent(rv$analysis$result, {
616672
req(rv$analysis$result, rv$analysis$dim_meta, rv$analysis$measures_meta)
@@ -631,11 +687,46 @@ mod_tool_server2 <- function(id, rv) {
631687
updateSelectInput(session, "plot_measure", choices = meas_choices, selected = meas_choices[1])
632688
updateSelectInput(session, "plot_fill", choices = optional_choices, selected = "")
633689
updateSelectInput(session, "plot_facet", choices = optional_choices, selected = "")
690+
shinyWidgets::updatePickerInput(
691+
session = session,
692+
inputId = "analysis_table_measures",
693+
choices = meas_choices,
694+
selected = meas_meta$name
695+
)
696+
})
634697

635-
shinyjs::hide("analysis_no_result")
636-
shinyjs::show("analysis_results")
698+
## ++ ##
699+
output$analysis_table <- DT::renderDT({
700+
req(rv$analysis$result, input$analysis_table_source)
701+
702+
DT::datatable(
703+
table_display_df(input$analysis_table_source),
704+
rownames = FALSE,
705+
filter = "top",
706+
extensions = "Buttons",
707+
options = list(
708+
scrollX = TRUE,
709+
pageLength = 10,
710+
dom = "Bfrtip",
711+
buttons = c("copy")
712+
)
713+
)
637714
})
638715

716+
output$analysis_table_download <- downloadHandler(
717+
filename = function() {
718+
paste0("analysis_", tolower(input$analysis_table_source %||% "means"), ".csv")
719+
},
720+
content = function(file) {
721+
utils::write.csv(
722+
filtered_analysis_df(input$analysis_table_source %||% "MEANS"),
723+
file,
724+
row.names = FALSE
725+
)
726+
}
727+
)
728+
## ++ ##
729+
639730
## $$$
640731
## . + Dimension filters -------------------------------------------------
641732
## One multi-select per dimension used in the analysis (all dims, regardless
@@ -699,7 +790,7 @@ mod_tool_server2 <- function(id, rv) {
699790
output$analysis_plot_means <- renderPlot({
700791
req(rv$analysis$result, input$plot_dim, input$plot_measure)
701792
make_bar_plot(
702-
df = rv$analysis$result$MEANS,
793+
df = filtered_analysis_df("MEANS"),
703794
x_dim = input$plot_dim,
704795
measure = input$plot_measure,
705796
fill_col = input$plot_fill,
@@ -717,7 +808,7 @@ mod_tool_server2 <- function(id, rv) {
717808
output$analysis_plot_totals <- renderPlot({
718809
req(rv$analysis$result, input$plot_dim, input$plot_measure)
719810
make_bar_plot(
720-
df = rv$analysis$result$TOTALS,
811+
df = filtered_analysis_df("TOTALS"),
721812
x_dim = input$plot_dim,
722813
measure = input$plot_measure,
723814
fill_col = input$plot_fill,

0 commit comments

Comments
 (0)