generate summary reports in app

DESCRIPTION

@@ -35,6 +35,7 @@ Imports:
     pkgload,
     reactable,
     rgbif,
+    rmarkdown,
     RPostgres,
     sf,
     shiny,

R/conr-server.R

@@ -49,5 +49,17 @@ conr_server <- function() {
       })
     )
 
+    observeEvent(criterion_b(), {
+      bslib::nav_select(id = "navbar", selected = "summary")
+    })
+
+    summary_report_server(
+      id = "report",
+      results_r = criterion_b,
+      data_sf_r = reactive({
+        mapping_l$data_sf()
+      })
+    )
+
   }
 }

R/conr-ui.R

@@ -66,7 +66,8 @@ conr_ui <- function() {
       ),
       nav(
         title = "Summary report",
-        value = "summary"
+        value = "summary",
+        summary_report_ui("report")
       ),
       nav_spacer()
     )

R/module-criterion_b.R

@@ -115,7 +115,17 @@ criterion_b_ui <- function(id) {
             class = "float-end mb-3 disabled"
           ),
           tags$div(class = "clearfix"),
-          reactable::reactableOutput(outputId = ns("results"))
+          reactable::reactableOutput(outputId = ns("results")),
+          actionButton(
+            inputId = ns("go_report"),
+            label = tagList(
+              ph("file-text"),
+              "Go to summary report"
+            ),
+            class = "my-4",
+            width = "100%",
+            class = "btn-outline-primary d-block"
+          )
         )
       )
     )
@@ -267,6 +277,7 @@ criterion_b_server <- function(id,
           rv$categories <- categories
           rv$results <- results
           rv$parameters <- parameters
+          rv$taxa <- input$taxa
         })
       })
 
@@ -291,16 +302,12 @@ criterion_b_server <- function(id,
           )
         )
       })
-
-      return(list(
-        eoo = reactive(rv$eoo_res),
-        aoo = reactive(rv$aoo_res),
-        locations = reactive(rv$locations),
-        categories = reactive(rv$categories),
-        results = reactive(rv$results),
-        parameters = reactive(rv$parameters)
-      ))
 
+      results_r <- eventReactive(input$go_report, {
+        reactiveValuesToList(rv)
+      })
+
+      return(results_r)
     }
   )
 }

R/module-mapping.R

@@ -477,7 +477,8 @@ mapping_server <- function(id, data_r = reactive(NULL)) {
       return(list(
         data = reactive(returned_rv$x),
         spatial_data = reactive(rv$spatial_data),
-        taxa = reactive(input$taxa)
+        taxa = reactive(input$taxa),
+        data_sf = data_map_r
       ))
     }
   )

R/module-report.R

@@ -0,0 +1,88 @@
+
+#' Summary report
+#'
+#' @param id Module's ID.
+#'
+#' @export
+#'
+#' @return
+#'  * UI: HTML tags that can be included in the UI part of the application.
+#'  * Server: a [shiny::reactive()] function returning a `data.frame`.
+
+#'
+#' @name module-report
+#'
+#' @importFrom shiny NS fluidRow column sliderInput actionButton radioButtons
+#' @importFrom htmltools tagList
+summary_report_ui <- function(id) {
+  ns <- NS(id)
+  template_ui(
+    title = "Summary report",
+
+    alert_no_data(id = ns("no-data"), text = "You must perform the criterion b analysis before you can generate the report."),
+
+    downloadButton(
+      outputId = ns("download"),
+      label = "Download results",
+      class = "mb-3 disabled",
+      style = "width: 100%;"
+    ),
+
+    uiOutput(outputId = ns("report"))
+  )
+}
+
+#' @export
+#'
+#' @rdname module-report
+summary_report_server <- function(id, results_r = reactive(NULL), data_sf_r = reactive(NULL)) {
+  moduleServer(
+    id = id,
+    module = function(input, output, session) {
+
+      observeEvent(results_r(), {
+        req(
+          results_r(),
+          length(results_r()) > 0
+        )
+        shinyjs::addClass(id = "no-data", class = "d-none")
+        shinyjs::removeCssClass(id = "download", class = "disabled")
+      })
+
+      output$report <- renderUI({
+        check_data_sf_r <<- data_sf_r()
+        check_results_r <<- results_r()
+        data_sf <- req(data_sf_r())
+        results <- req(results_r())
+        taxa <- results$taxa
+        report_file <- if (identical(taxa, "All") | length(taxa) > 1) {
+          system.file(package = "conrappli", "reports/all_tax_report.Rmd")
+        } else {
+          system.file(package = "conrappli", "reports/species_report.Rmd")
+        }
+
+        tmp <- tempfile(fileext = ".html")
+
+        rmarkdown::render(
+          input = report_file,
+          output_format = rmarkdown::html_fragment(),
+          params = list(
+            tax = results$taxa,
+            data = NULL,
+            data_sf = data_sf,
+            res_aoo = results$aoo_res$AOO_poly,
+            res_eoo = results$eoo_res$spatial,
+            threat_sig = NULL,
+            parameters = results$parameters,
+            res_loc = results$locations,
+            results = results$results
+          ),
+          output_file = tmp
+        )
+        includeHTML(tmp)
+      })
+
+    }
+  )
+}
+

R/utils-shiny.R

@@ -31,7 +31,7 @@ btn_help <- function(text, ...) {
 }
 
 
-alert_no_data <- function(id) {
+alert_no_data <- function(id, text = "You need to import data and select variable before using this tab.") {
   tags$div(
     style = htmltools::css(
       position = "fixed",
@@ -48,7 +48,7 @@ alert_no_data <- function(id) {
     shinyWidgets::alert(
       status = "info",
       class = "mt-5",
-      ph("info"), "You need to import data and select variable before using this tab."
+      ph("info"), text
     )
   )
 }