Fix v1.1.0

alienSpecies/DESCRIPTION

@@ -1,8 +1,8 @@
 Package: alienSpecies
 Type: Package
 Title: Portal for alien and invasive species indicators
-Version: 1.0.1
-Date: 2023-11-30
+Version: 1.1.0
+Date: 2024-04-16
 Author: Machteld Varewyck, Yingjie Zhang, Eva Adriaensen
 Maintainer: Machteld Varewyck <[email protected]>
 Description: INBO shiny application based on the TRIAS package.
@@ -37,13 +37,13 @@ Imports:
 	  testthat (>= 3.0.0),
     tidyr,
 	  tidyverse,
-	  trias (>= 2.0.8),
+	  trias (>= 2.1.0),
 	  webshot2,
 	  xtable
 Suggests:
     shinyjs
 RoxygenNote: 7.3.1
 Remotes: 
     inbo/[email protected],
-    trias-project/trias@v2.0.8
+    trias-project/trias@v2.1.0
 Config/testthat/edition: 3

alienSpecies/NAMESPACE

@@ -16,6 +16,9 @@ export(countOccurrence)
 export(countYearGroup)
 export(countYearGroupServer)
 export(countYearGroupUI)
+export(createBins)
+export(createBinsServer)
+export(createBinsUI)
 export(createCubeData)
 export(createDoubleChoices)
 export(createKeyData)
@@ -34,9 +37,13 @@ export(drawBullet)
 export(filterCombo)
 export(filterSelectServer)
 export(filterSelectUI)
+export(footerSectionServer)
+export(footerSectionUI)
 export(getGbifOccurrence)
 export(getPathLogo)
 export(getRegionNames)
+export(htmlSectionServer)
+export(htmlSectionUI)
 export(loadGbif)
 export(loadMetaData)
 export(loadOccupancyData)
@@ -147,7 +154,9 @@ importFrom(dplyr,summarise)
 importFrom(dplyr,ungroup)
 importFrom(ggplot2,ggsave)
 importFrom(ggspatial,annotation_map_tile)
+importFrom(graphics,barplot)
 importFrom(htmltools,div)
+importFrom(htmltools,includeHTML)
 importFrom(htmlwidgets,saveWidget)
 importFrom(httr,GET)
 importFrom(httr,http_status)
@@ -187,6 +196,7 @@ importFrom(shinycssloaders,withSpinner)
 importFrom(stats,aggregate)
 importFrom(stats,as.formula)
 importFrom(stats,complete.cases)
+importFrom(stats,quantile)
 importFrom(terra,rast)
 importFrom(terra,values)
 importFrom(testthat,test_file)

alienSpecies/R/app_modules.R

@@ -111,7 +111,6 @@ tableModuleUI <- function(id, includeTotal = FALSE) {
 #' @import shiny
 #' @importFrom utils write.table tail
 #' @importFrom DT datatable formatRound renderDT
-#' @importFrom plotly ggplotly layout
 #' @export
 plotModuleServer <- function(id, plotFunction, data, uiText = NULL,
   outputType = NULL, triasFunction = NULL, triasArgs = NULL, groupChoices = NULL,
@@ -156,12 +155,10 @@ plotModuleServer <- function(id, plotFunction, data, uiText = NULL,
 
           timeRange <- range(data()$first_observed, na.rm = TRUE) 
 
-          div(class = "sliderBlank", 
-            sliderInput(inputId = ns("period"), 
+          sliderInput(inputId = ns("period"), 
               label = translate(uiText(), "period")$title,
               min = timeRange[1], max = timeRange[2], value = timeRange,
               step = 1, sep = "", width = "100%")
-          )
 
         })
 

alienSpecies/R/app_sections.R

@@ -48,6 +48,94 @@ welcomeSectionUI <- function(id) {
 }
 
 
+#' Shiny module for creating footer section - server side
+#' @inheritParams welcomeSectionServer
+#' @return reactive for creating the report
+#' 
+#' @author mvarewyck
+#' @import shiny
+#' @export
+footerSectionServer <- function(id, uiText) {
+
+  moduleServer(id, function(input, output, session) {
+
+      ns <- session$ns    
+
+      ## SUBMIT & DOWNLOAD report ##
+
+      observe({
+
+          updateActionButton(inputId = "createReport", 
+            label = translate(data = uiText, id = "createReport")$title)
+
+        })
+
+
+      ## REPORT missing and CONTACT ##
+      observeEvent(input$contact, {
+
+          showModal(
+            modalDialog(
+              title = "Contact",
+              footer = modalButton(label = NULL, icon = icon("xmark")),
+              easyClose = TRUE,
+
+              tags$h5(translate(data = uiText, "contactMissing"), ":"),
+              tags$a(href = "https://waarnemingen.be/fieldwork/observations/create/", target="_blank", 
+                "https://waarnemingen.be/fieldwork/observations/create/"),
+              tags$br(),
+              tags$a(href = "https://www.inaturalist.org/observations/upload", target = "_blank",
+                "https://www.inaturalist.org/observations/upload"),
+              tags$h5(translate(data = uiText, "contactApp"), ":"),
+              tags$a(href="mailto:[email protected]?subject=Alien%20species%20web%20applicatie&body=**Describe%20the%20bug**%0AA%20clear%20and%20concise%20description%20of%20what%20the%20bug%20is.%0A%0A**To%20Reproduce**%0ASteps%20to%20reproduce%20the%20behavior%3A%0A1.%20Go%20to%20%27...%27%0A2.%20Click%20on%20%27....%27%0A3.%20Scroll%20down%20to%20%27....%27%0A4.%20See%20error%0A%0A**Expected%20behavior**%0AA%20clear%20and%20concise%20description%20of%20what%20you%20expected%20to%20happen.%0A%0A**Screenshots**%0AIf%20applicable%2C%20add%20screenshots%20to%20help%20explain%20your%20problem.%0A%0A**Desktop%20%28please%20complete%20the%20following%20information%29%3A**%0A%20-%20OS%3A%20%5Be.g.%20iOS%5D%0A%20-%20Browser%20%5Be.g.%20chrome%2C%20safari%5D%0A%20-%20Version%20%5Be.g.%2022%5D%0A%0A**Smartphone%20%28please%20complete%20the%20following%20information%29%3A**%0A%20-%20Device%3A%20%5Be.g.%20iPhone6%5D%0A%20-%20OS%3A%20%5Be.g.%20iOS8.1%5D%0A%20-%20Browser%20%5Be.g.%20stock%20browser%2C%20safari%5D%0A%20-%20Version%20%5Be.g.%2022%5D%0A%0A**Additional%20context**%0AAdd%20any%20other%20context%20about%20the%20problem%20here.", target="_blank", 
+                "[email protected]")              
+            )
+          )
+
+
+        })
+
+      return(reactive(input$createReport))
+
+
+    })
+
+}
+
+#' #' Shiny module for creating footer section - UI side
+#' @param id character, unique identifier
+#' @param showReport boolean, whether to show a button to download report
+#' @return no return value
+#' 
+#' @author mvarewyck
+#' @import shiny
+#' @export
+footerSectionUI <- function(id, showReport = FALSE) {
+
+  ns <- NS(id)
+
+  tags$div(style = "margin-bottom: 70px;",
+
+    tags$div(class = "footer",
+      tags$div(class = "footer-content",
+
+        actionButton(inputId = ns("contact"), label = "Contact", 
+          icon = icon("envelope")),
+
+        if (showReport)
+          tagList(
+            singleton(
+              tags$head(tags$script(src = "triggerDownload.js"))
+            ),
+            actionButton(inputId = ns("createReport"), label = "Create report", 
+              icon = icon("file-pdf")),
+            downloadLink(ns("downloadReport"), " ", class = "invisible")
+          )
+      )
+    )
+  )
+
+}
 
 #' Replace {{fields}} in title/description translations
 #' @param text character, input from translation
@@ -64,8 +152,8 @@ decodeText <- function(text, params) {
   for (iParam in names(params)) {
 
     newText <- if (iParam == "period")
-      paste(newText, yearToTitleString(params[[iParam]])) else
-      gsub(paste0("\\{\\{", iParam, "\\}\\}"), params[[iParam]], newText)
+        paste(newText, yearToTitleString(params[[iParam]])) else
+        gsub(paste0("\\{\\{", iParam, "\\}\\}"), params[[iParam]], newText)
 
   }
 
@@ -129,3 +217,54 @@ versionServer <- function(id, uiText) {
 
     })
 }
+
+
+#' Shiny module for including html file - server side
+#' @param id character, unique identifier
+#' @param species reactive object, taxonkey for the selected species
+#' @param language reactive object, language for UI content
+#' @param url character, url to be displayed
+#' @return no return value
+#' 
+#' @author mvarewyck
+#' @importFrom htmltools includeHTML
+#' @export
+htmlSectionServer <- function(id, species, language, url) {
+
+  moduleServer(id, function(input, output, session) {
+
+      output$addLinks <- renderUI({
+
+          dataPath <- file.path("https://raw.githubusercontent.com/inbo/aspbo",
+            if (Sys.getenv("R_CONFIG_ACTIVE") == "production") "main" else "uat",
+            "HTML_pages/HTML")
+          dataFile <- file.path(dataPath, paste0(species(), "_", language(), ".html"))
+
+          tagList(
+            if (!is.na(url))
+              tags$a(href = url, target = "_blank", url),
+            if (httr::http_status(httr::GET(dataFile))$category != "Client error")
+              includeHTML(dataFile)
+          )
+
+        })
+
+    })
+}
+
+
+#' Shiny module for including html file - UI side
+#' @inherit welcomeSectionUI
+#' 
+#' @author mvarewyck
+#' @export
+htmlSectionUI <- function(id) {
+
+  ns <- NS(id)
+
+  tags$div(style = "margin-top: 20px;",
+    uiOutput(ns("addLinks"))
+  )
+
+}
+

alienSpecies/R/data_create.R

@@ -160,7 +160,7 @@ createTimeseries <- function(
 
 
   # For R CMD check
-  df_ts <- taxonKey <- NULL
+  df_ts <- taxonKey <- eea_cell_code <- NULL
 
   # created from https://github.com/inbo/aspbo/blob/uat/src/05_occurrence_indicators_preprocessing.Rmd
   ## Data at 1km x 1km grid level
@@ -307,14 +307,14 @@ createTaxaChoices <- function(exotenData) {
 #' }
 #' @return data.table, loaded indicator/unionlist data; 
 #' and attribute 'Date', the date that this data file was created
-#' @importFrom data.table fread := as.data.table
+#' @importFrom data.table fread := as.data.table setnames
 #' @importFrom utils tail
 #' @importFrom stats complete.cases
 #' @importFrom arrow write_parquet
 #' @importFrom dplyr filter
 #' @export
 createTabularData <- function(
-    dataDir = "~/git/alien-species-portal/dataS3",
+    dataDir = "~/git/aspbo/data/output/UAT_processing",
     bucket = config::get("bucket", file = system.file("config.yml", package = "alienSpecies")),
     type = c("indicators", "unionlist", "occurrence")) {
 
@@ -324,6 +324,7 @@ createTabularData <- function(
   i.scientificName <- NULL
   i.classKey <- NULL
   taxonKey <- variable <- eea_cell_code <- NULL
+  obs <- NULL
 
   warningMessage <- NULL
 
@@ -379,12 +380,9 @@ createTabularData <- function(
     ## convert english names to names recognized by the translation file
     rawData$locality <- getRegionNames(rawData$locality)
 
-    ## Extract hyperlinks 
-
-    ### Extract gbif link
-    rawData$gbifLink <- sapply(strsplit(rawData$source, split = ": "), function(x) x[1])
-    rawData$gbifLink <- paste0("<a href='", rawData$gbifLink, "' target = '_blank'>", 
-                               sapply(strsplit(rawData$gbifLink, split = "/"), function(x) tail(x, n = 1)), "</a>")
+    ## Construct gbif link
+    rawData$gbifLink <- paste0("<a href='https://www.gbif.org/species/", rawData$nubKey, "' target = '_blank'>", 
+                               rawData$nubKey, "</a>")
     # common name and source: https://www.gbif.org/species/157131005
 
     ## recode `source` variable
@@ -471,8 +469,10 @@ createTabularData <- function(
       by.y = c("variable", "taxonKey"), all.x = TRUE)
     rawData$last_observed <- apply(rawData[, c("last_observed", "year")], 1, 
       function(x) if (all(is.na(x))) NA else max(x, na.rm = TRUE))
-
+    rawData$first_observed <- as.numeric(rawData$first_observed)
+    rawData$last_observed <- as.numeric(rawData$last_observed)
 
+
     ## replace missing "species" with "canonicalName" if available
     # then drop "canonicalName"
     ind <- which(is.na(rawData$species) & !is.na(rawData$canonicalName))
@@ -523,8 +523,11 @@ createTabularData <- function(
     rawData$cell_code10 <- gsub(pattern = "1km", replacement = "10km", 
                                 paste0(substr(rawData$eea_cell_code, start = 1, stop = 7),
                                        substr(rawData$eea_cell_code, start = 9, stop = 12)))
-    colnames(rawData)[colnames(rawData) == "eea_cell_code"] <- "cell_code1"
 
+    setnames(rawData, "eea_cell_code", "cell_code1", skip_absent = TRUE)
+    setnames(rawData, "gemeente", "NAAM", skip_absent = TRUE)
+    setnames(rawData, "gewest", "GEWEST", skip_absent = TRUE)
+
   }
 
   attr(rawData, "Date") <- file.mtime(dataFiles)

alienSpecies/R/data_gbif.R

@@ -168,6 +168,8 @@ loadGbif <- function(dataFile,
     rawData[, decimalLongitude := as.numeric(decimalLongitude)]
   if ("decimalLatitude" %in% colnames(rawData))
     rawData[, decimalLatitude := as.numeric(decimalLatitude)]
+  if ("count" %in% colnames(rawData))
+    rawData[, count := as.numeric(count)]
 
 
   attr(rawData, "Date") <- file.mtime(dataFile)

alienSpecies/R/data_load.R

@@ -49,6 +49,8 @@ loadTabularData <- function(
     open_dataset(file.path("s3:/", bucket, dataFile)) else
     read_parquet(file = file.path("s3:/", bucket, dataFile))
 
+  message(attr(rawData, "warning"))
+
   if (type == "indicators")
     attr(rawData, "habitats") <- c("marine", "freshwater", "terrestrial")
 
@@ -62,7 +64,7 @@ loadTabularData <- function(
 #' Load meta data for the UI
 #' @inheritParams loadTabularData 
 #' @param type character, which type of translations should be loaded;
-#' should be one of \code{c("ui","keys")}
+#' should be one of \code{c("ui", "keys", "harmonia")}
 #' @param language character, which language data sheet should be loaded;
 #' should be one of \code{c("nl", "fr", "en")}
 #' @param local boolean, whether to use local translation file in
@@ -73,7 +75,7 @@ loadTabularData <- function(
 #' @importFrom utils read.csv
 #' @export
 
-loadMetaData <- function(type = c("ui", "keys"),
+loadMetaData <- function(type = c("ui", "keys", "harmonia"),
   bucket = config::get("bucket", file = system.file("config.yml", package = "alienSpecies")),
   language = c("nl", "fr", "en"),
   local = FALSE) {
@@ -83,7 +85,8 @@ loadMetaData <- function(type = c("ui", "keys"),
 
   fileNames <- switch(type, 
     ui = paste0("translations", c("", "_simple", "_regions")),
-    keys = "keys"
+    keys = "keys",
+    harmonia = "harmonia_info"
   )
 
   allData <- sapply(fileNames, function(iFile) { 
@@ -92,7 +95,7 @@ loadMetaData <- function(type = c("ui", "keys"),
           if (local)
             read.csv(system.file("extdata", iFile, package = "alienSpecies"),
               sep = if (type == "ui") ";" else ",", encoding = "UTF-8") else
-            readS3(FUN = read.csv, sep = if (type == "ui") ";" else ",", encoding = "UTF-8", 
+            readS3(FUN = read.csv, sep = if (type == "keys") "," else ";", encoding = "UTF-8", 
               file = iFile)
         }, error = function(err) NULL)
     }, simplify = FALSE)
@@ -127,7 +130,8 @@ loadMetaData <- function(type = c("ui", "keys"),
       uiText
 
     },
-    keys = allData$keys
+    keys = allData$keys,
+    harmonia = allData$harmonia[, c("gbif_taxonkey", "harmonia_url")]
   )
 
   if (type == "ui")