fix #63 - vespa velutina if no data (e.g. january)

inbo · Jan 30, 2024 · 67dd77d · 67dd77d
1 parent afa03fd
commit 67dd77d
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 16 deletions.
diff --git a/alienSpecies/R/mapHeat.R b/alienSpecies/R/mapHeat.R
@@ -46,26 +46,26 @@ combineActiveData <- function(activeData, managedData, untreatedData) {
 #' @author mvarewyck
 #' @importFrom dplyr select filter mutate group_by summarise rename
 #' @export
-combineNestenData <- function(pointsData, nestenData) {
+combineNestenData <- function(pointsData, nestenData, currentYear = year(Sys.Date())) {
 
   # For R CMD check
   type <- eventDate <- popup <- institutionCode <- id <- observation_time <- NULL
   geometry <- NULL
 
   points_redux <- pointsData %>% 
-    dplyr::filter(year == year(Sys.Date())) %>%
+    dplyr::filter(year == currentYear) %>%
     dplyr::select(type, eventDate, popup, institutionCode, year) %>%
     mutate(type = "individual")
 
   # punten laag van gemelde nesten
   nesten <- nestenData %>% 
-    dplyr::filter(year == year(Sys.Date())) %>% 
+    dplyr::filter(year == currentYear) %>% 
     mutate(type = "nest",
       popup = paste0("Vespawatch rij ", id),
       institutionCode = "Vespawatch")
 
   nesten_redux <- nesten %>% 
-    dplyr::filter(year == year(Sys.Date())) %>% 
+    dplyr::filter(year == currentYear) %>% 
     dplyr::select(type, eventDate = observation_time, popup, institutionCode, year) 
 
   # Recombine points
@@ -194,7 +194,7 @@ mapHeatServer <- function(id, uiText, species, combinedData, filter, colors,
 
           tmpDescription <- tmpTranslation()$description
           tmpDescription <- gsub("\\{\\{maxDate\\}\\}", format(maxDate(), "%d/%m/%Y"), tmpDescription)
-          tmpDescription <- gsub("\\{\\{maxYear\\}\\}", format(maxDate(), "%Y"), tmpDescription)
+          tmpDescription <- gsub("\\{\\{maxYear\\}\\}", format(Sys.Date(), "%Y"), tmpDescription)
 
           HTML(tmpDescription)
 
@@ -204,6 +204,8 @@ mapHeatServer <- function(id, uiText, species, combinedData, filter, colors,
 
       output$filters <- renderUI({
 
+          validate(need(nrow(combinedData()) > 0, noData()))
+
           if (!is.null(filter()))
             lapply(names(filter()), function(filterName) {
 
@@ -259,21 +261,25 @@ mapHeatServer <- function(id, uiText, species, combinedData, filter, colors,
           input[["global"]]
 
 
-          temp <- combinedData()
+          tmpData <- combinedData()
 
-          for(iFilter in names(filter())[-1]){
+          for (iFilter in names(filter())[-1]){
 
             if (!is.null(input[[iFilter]]) && input[[iFilter]] != "<none>"){
-              index <- !is.na(temp[[iFilter]]) & (temp[[iFilter]] == input[[iFilter]])
-              temp <- temp[index,]
+              index <- !is.na(tmpData[[iFilter]]) & (tmpData[[iFilter]] == input[[iFilter]])
+              tmpData <- tmpData[index,]
             }
           }
-          temp
+
+          tmpData
+
         })
 
       # Send map to the UI
       output$spacePlot <- renderLeaflet({
 
+          validate(need(nrow(combinedDataPostFilter()) > 0, noData()))
+
           myMap <- mapHeat(
             combinedData =  combinedDataPostFilter(),
             colors = colors(),
@@ -371,10 +377,8 @@ mapHeatServer <- function(id, uiText, species, combinedData, filter, colors,
       # Create final map (for download)
       finalMap <- reactive({
 
-        input[[ names(filter())[2] ]]
-
           newMap <- mapHeat(
-            combinedData =combinedDataPostFilter(),
+            combinedData = combinedDataPostFilter(),
             colors = colors(),
             selected = input[[names(filter())[1]]],
             blur = blur, 

diff --git a/alienSpecies/inst/app/serverFiles/serverSpecies.R b/alienSpecies/inst/app/serverFiles/serverSpecies.R
@@ -242,7 +242,7 @@ observe({
     req(results$species_managementData())
 
     if (input$species_choice %in% cubeSpecies) {
-      ## Map + slider barplot
+      ## Map + slider barplot: Oxyura jamaicensis
 
       mapCubeServer(id = "management",
         uiText = reactive(results$translations),
@@ -261,7 +261,7 @@ observe({
       )
 
     } else if (input$species_choice %in% heatSpecies) {
-      ## heatmap
+      ## heatmap: Vespa velutina
 
       ## Actieve haarden
       combinedActive <- combineActiveData(
@@ -286,6 +286,8 @@ observe({
       combinedObserved <- combineNestenData(
         pointsData = results$species_managementData()$points, 
         nestenData = results$species_managementData()$nesten
+      # For testing only: when no observations yet, use latest available year
+#        currentYear = format(max(results$species_managementData()$points$eventDate, na.rm = TRUE), "%Y")
       )
       colorsObserved <- c("blue", "red")
       names(colorsObserved) <- c("individual", "nest")
@@ -378,7 +380,7 @@ observe({
 
 
     } else {
-      ## Map + choices barplot
+      ## Map + choices barplot: Lithobates catesbeianus
 
       mapRegionsServer(
         id = "management3",