fix #90 - add filter for region scale

inbo · Apr 12, 2024 · e374c8f · e374c8f
1 parent 0933597
commit e374c8f
Show file tree

Hide file tree

Showing 4 changed files with 31 additions and 12 deletions.
diff --git a/alienSpecies/R/plot_trias.R b/alienSpecies/R/plot_trias.R
@@ -124,9 +124,17 @@ plotTriasServer <- function(id, uiText, data, triasFunction, triasArgs = NULL,
 
           if (!is.null(filters)) 
             wellPanel(
-              lapply(filters, function(iFilter) {
-                  checkboxInput(inputId = ns(iFilter), 
-                    label = translate(uiText(), iFilter)$title)
+              lapply(names(filters), function(iFilter) {
+                  if (all(filters[[iFilter]] == "checkbox")) {
+                    checkboxInput(inputId = ns(iFilter), 
+                      label = translate(uiText(), iFilter)$title) 
+                  } else {
+                    choices <- filters[[iFilter]]
+                    names(choices) <- translate(uiText(), choices)$title
+                    fluidRow(column(4, selectInput(inputId = ns(iFilter),
+                      label = translate(uiText(), iFilter)$title,
+                      choices = choices)))
+                  }
                 })
             )
 
@@ -151,9 +159,13 @@ plotTriasServer <- function(id, uiText, data, triasFunction, triasArgs = NULL,
         triasArgs = reactive({
             if (!is.null(triasArgs)) {
               initArgs <- triasArgs()
-              initArgs$eval_years <- min(plotData()$year):max(plotData()$year)
-              if (!is.null(input$correctBias) && input$correctBias)
-                initArgs$baseline_var <- "cobs"
+              if (!is.null(input$correctBias)) {
+                initArgs$eval_years <- min(plotData()$year, na.rm = TRUE):max(plotData()$year, na.rm = TRUE)
+                if (input$correctBias)
+                  initArgs$baseline_var <- "cobs"
+              }
+              if (!is.null(input$regionLevel))
+                initArgs$type <- input$regionLevel
               initArgs
             } else NULL
           }),

diff --git a/alienSpecies/inst/app/serverFiles/serverChecklist.R b/alienSpecies/inst/app/serverFiles/serverChecklist.R
@@ -384,7 +384,6 @@ observeEvent(input$exoten_tabs, {
     req(input$exoten_tabs == "checklist_trend")
     req(!"checklist_trend" %in% results$renderedTabs)
     results$renderedTabs <- c(results$renderedTabs, "checklist_trend")
-    print(input$exoten_tabs)
 
     ## Plot number of species per year
     plotTriasServer(id = "checklist-count",
@@ -432,7 +431,6 @@ observeEvent(input$exoten_tabs, {
     req(input$exoten_tabs == "checklist_pathways")
     req(!"checklist_pathways" %in% results$renderedTabs)
     results$renderedTabs <- c(results$renderedTabs, "checklist_pathways")
-    print(input$exoten_tabs)
 
     plotTriasServer(id = "checklist_tablePathway",
       uiText = reactive(results$translations),
@@ -534,7 +532,6 @@ observeEvent(input$exoten_tabs, {
     req(input$exoten_tabs == "checklist_origin")
     req(!"checklist_origin" %in% results$renderedTabs)
     results$renderedTabs <- c(results$renderedTabs, "checklist_origin")
-    print(input$exoten_tabs)
 
     ## Plot number of species per year by native region
     plotTriasServer(id = "checklist_yearNativeRange",
@@ -546,7 +543,9 @@ observeEvent(input$exoten_tabs, {
             x_lab = translate(results$translations, "year")$title,
             y_lab = translate(results$translations, "number")$title
           )
-        })
+        }),
+      filters = list(
+        regionLevel = c("native_continent", "native_range"))
     )
 
   })
diff --git a/alienSpecies/inst/app/serverFiles/serverSpecies.R b/alienSpecies/inst/app/serverFiles/serverSpecies.R
@@ -181,7 +181,10 @@ dashReport <- plotTriasServer(id = "indicators_gam",
         y_label = translate(results$translations, "observations")$title
       )
     }),
-  filters = c("correctBias", "protectAreas"),
+  filters = list(
+    correctBias = "checkbox", 
+    protectAreas = "checkbox"
+  ),
   dashReport = dashReport
 )
 

diff --git a/alienSpecies/tests/testthat/testChecklist.R b/alienSpecies/tests/testthat/testChecklist.R
@@ -184,7 +184,12 @@ test_that("Grafiek: Mate van verspreiding van de Unielijstsoorten", {
 ## PLOT 4
 test_that("Grafiek: Aantal geïntroduceerde uitheemse soorten per jaar per regio van oorsprong", {
 
-    tmpResult <- trias::indicator_native_range_year(df = exotenData)
+    # Data for single species
+    speciesData <- exotenData[exotenData$degree_of_establishment == "invasive", ]
+
+    tmpResult <- trias::indicator_native_range_year(df = speciesData, 
+      type = "native_continent",  # native_continent or native_range
+      taxon_key_col = "key")
     expect_type(tmpResult, "list")
 
     expect_s3_class(tmpResult$interactive_plot, "plotly")