map vespa velutina #27 + test S3 connection

Dockerfile

@@ -158,45 +158,46 @@ RUN R -q -e "remotes::install_version('tidyselect', version = '1.2.0', upgrade =
     R -q -e "remotes::install_version('covr', version = '3.6.2', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('gargle', version = '1.5.2', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('progress', version = '1.2.2', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('reshape2', version = '1.4.4', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('roxygen2', version = '7.2.3', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('selectr', version = '0.4-2', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('sf', version = '1.0-14', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('tibble', version = '3.2.1', upgrade = FALSE)"
-RUN R -q -e "remotes::install_version('cellranger', version = '1.1.0', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('sf', version = '1.0-14', upgrade = FALSE)"
+RUN R -q -e "remotes::install_version('tibble', version = '3.2.1', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('cellranger', version = '1.1.0', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('dplyr', version = '1.1.3', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('forcats', version = '1.0.0', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('ggplot2', version = '3.4.3', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('googledrive', version = '2.1.1', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('oai', version = '0.4.0', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('rematch2', version = '2.1.2', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('rmarkdown', version = '2.24', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('rvest', version = '1.0.3', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('shiny', version = '1.7.5', upgrade = FALSE)"
-RUN R -q -e "remotes::install_version('vroom', version = '1.6.3', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('rvest', version = '1.0.3', upgrade = FALSE)"
+RUN R -q -e "remotes::install_version('shiny', version = '1.7.5', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('vroom', version = '1.6.3', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('dtplyr', version = '1.3.1', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('googlesheets4', version = '1.1.1', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('htmlwidgets', version = '1.6.2', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('readr', version = '2.1.4', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('readxl', version = '1.4.3', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('reprex', version = '2.0.2', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('rgbif', version = '3.7.7', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('shinycssloaders', version = '1.0.0', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('shinyjs', version = '2.1.0', upgrade = FALSE)"
-RUN R -q -e "remotes::install_version('tidyr', version = '1.3.0', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('shinycssloaders', version = '1.0.0', upgrade = FALSE)"
+RUN R -q -e "remotes::install_version('shinyjs', version = '2.1.0', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('tidyr', version = '1.3.0', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('viridis', version = '0.6.4', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('waldo', version = '0.5.1', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('broom', version = '1.0.5', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('dbplyr', version = '2.3.3', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('DT', version = '0.29', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('haven', version = '2.5.3', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('leaflet', version = '2.2.0', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('plotly', version = '4.10.2', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('testthat', version = '3.1.10', upgrade = FALSE)"
-RUN R -q -e "remotes::install_version('leaflet.extras', version = '1.0.0', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('plotly', version = '4.10.2', upgrade = FALSE)"
+RUN R -q -e "remotes::install_version('testthat', version = '3.1.10', upgrade = FALSE)" && \
+    R -q -e "remotes::install_version('leaflet.extras', version = '1.0.0', upgrade = FALSE)" && \
     R -q -e "remotes::install_version('modelr', version = '0.1.11', upgrade = FALSE)" && \
-    R -q -e "remotes::install_version('tidyverse', version = '2.0.0', upgrade = FALSE)"
-
-RUN R -q -e "remotes::install_github('trias-project/trias')"
+    R -q -e "remotes::install_version('tidyverse', version = '2.0.0', upgrade = FALSE)" && \
+    R -q -e "remotes::install_github('inbo/INBOtheme')" && \
+    R -q -e "remotes::install_github('trias-project/trias')"
 
 # Specific version INBOtheme
 RUN R -q -e "remotes::install_github('inbo/INBOtheme@v0.5.9')"

alienSpecies/DESCRIPTION

@@ -20,6 +20,7 @@ Imports:
     leaflet,
     leaflet.extras,
     plotly,
+    reshape2,
     rgbif,
 	shiny,
 	shinycssloaders,

alienSpecies/NAMESPACE

@@ -122,6 +122,7 @@ importFrom(leaflet.extras,addHeatmap)
 importFrom(plotly,ggplotly)
 importFrom(plotly,layout)
 importFrom(plotly,plotlyOutput)
+importFrom(reshape2,dcast)
 importFrom(rgbif,name_usage)
 importFrom(rgbif,occ_download)
 importFrom(rgbif,occ_download_get)

alienSpecies/R/mapRegions.R

@@ -7,12 +7,14 @@
 #' @param year integer, year of interest
 #' @param unit character, should be one of \code{c("cpue", "absolute")},
 #' catch per unit of effort or absolute count
+#' @param groupingVariable character, split the number of counts per group value
 #' 
 #' @return data.frame
 #' 
 #' @author mvarewyck
 #' @import tidyverse
 #' @importFrom data.table copy
+#' @importFrom reshape2 dcast
 #' @export
 createSummaryRegions <- function(data, shapeData, 
   regionLevel = c("communes", "provinces", "gewest"),
@@ -71,7 +73,10 @@ createSummaryRegions <- function(data, shapeData,
 
     if (!is.null(groupingVariable)) {
 
-      summaryData <- reshape2::dcast(data, region + year ~ get(groupingVariable), value.var = "count", fun.aggregate = sum)
+      summaryData <- data %>%
+        filter(year %in% myYear, !is.na(region), region != "NA", region != "")
+      summaryData <- reshape2::dcast(summaryData, region + year ~ get(groupingVariable), 
+        value.var = "count", fun.aggregate = sum)
       summaryData$n <- apply(summaryData[, -(1:2), drop = FALSE], 1, sum, na.rm = TRUE)     
 
     } else {
@@ -220,9 +225,13 @@ mapRegions <- function(managementData, occurrenceData = NULL, shapeData, uiText
 #' @inheritParams createCubeData
 #' @inheritParams mapCubeServer
 #' @inheritParams mapCubeUI
+#' @inheritParams createSummaryRegions
 #' @param species reactive character, readable name of the selected species
 #' @param df reactive data.frame, data as loaded by \code{\link{loadGbif}}
 #' @param occurrenceData data.table, as obtained by \code{loadTabularData(type = "occurrence")}
+#' @param sourceChoices character vector, choices for the data source;
+#' default value is NULL then no choices are shown
+#' 
 #' @return no return value
 #' 
 #' @author mvarewyck
@@ -232,7 +241,8 @@ mapRegions <- function(managementData, occurrenceData = NULL, shapeData, uiText
 #' @importFrom webshot webshot
 #' @importFrom sf st_drop_geometry
 #' @export
-mapRegionsServer <- function(id, uiText, species, df, occurrenceData, shapeData) {
+mapRegionsServer <- function(id, uiText, species, df, occurrenceData, shapeData,
+  sourceChoices = NULL) {
 
   moduleServer(id,
     function(input, output, session) {
@@ -327,6 +337,17 @@ mapRegionsServer <- function(id, uiText, species, df, occurrenceData, shapeData)
 
         })
 
+      output$bronMap <- renderUI({
+
+          req(sourceChoices)
+
+          selectInput(inputId = ns("bronMap"),
+            label = translate(uiText(), "source")$title,
+            choices = sourceChoices, selected = sourceChoices,
+            multiple = TRUE)
+
+        })
+
       # Filter on gewest
       output$gewest <- renderUI({
 
@@ -385,10 +406,19 @@ mapRegionsServer <- function(id, uiText, species, df, occurrenceData, shapeData)
 
           req(inherits(df(), "data.frame"))
 
-          createSummaryRegions(data = df(), 
+          subData <- df()
+          if (!is.null(sourceChoices)) {
+            req(input$bronMap)
+            subData <- subData[subData$type %in% input$bronMap, ]
+          }
+
+          createSummaryRegions(data = subData, 
             shapeData = shapeData,
             regionLevel = req(input$regionLevel),
-            year = req(input$year), unit = input$unit)
+            year = req(input$year), 
+            unit = input$unit,
+            groupingVariable = if (!is.null(sourceChoices)) "type"
+          )
 
         })
 
@@ -424,18 +454,24 @@ mapRegionsServer <- function(id, uiText, species, df, occurrenceData, shapeData)
 
           validate(need(nrow(req(summaryData())) > 0, noData()))
 
-          textPopup <- paste0("<h4>", summaryData()$region, "</h4>",
+          paste0("<h4>", summaryData()$region, "</h4>",
             "<strong>", translate(uiText(), "year")$title, "</strong>: ", input$year, "<br>",
             if (!is.null(input$unit)) 
               paste0("<strong>", translate(uiText(), input$unit)$title, "</strong>: "), 
+            if (!is.null(input$bronMap)) {
+              availableBron <- input$bronMap[input$bronMap %in% colnames(summaryData())]
+              names(availableBron) <- sapply(availableBron, function(x) translate(uiText(), x)$title)
+              if (length(availableBron) > 1)
+                paste0(apply(do.call(cbind, Map(paste, names(availableBron), summaryData()[, availableBron], sep = ": ")), 1, function(x)
+                      paste("</br>", paste(x, collapse = "</br>"))),
+                  "</br><em>", translate(uiText(), "total")$title, "</em>: ") else
+                paste0(names(availableBron), ": ")
+            },
             if (!is.null(input$unit) && input$unit == "cpue") 
                 round(summaryData()$effort, 2) else
                 round(summaryData()$n, 2)
           )
-
-
-          return(textPopup)
-
+
         })
 
       # Add popups
@@ -760,7 +796,8 @@ mapRegionsUI <- function(id, plotDetails = NULL, showUnit = TRUE) {
       fixedRow(
         column(6, uiOutput(ns("legend"))),
         if (showUnit)
-          column(6, uiOutput(ns("unit")))
+          column(6, uiOutput(ns("unit"))),
+        column(6, uiOutput(ns("bronMap")))
       ),
       if ("region" %in% plotDetails)
         checkboxInput(inputId = ns("combine"), 

alienSpecies/R/plot_nesten.R

@@ -81,7 +81,7 @@ countNesten <- function(df, uiText = NULL) {
 tableNesten <- function(df, uiText = NULL) {
 
   # For R CMD check
-  NAAM <- NULL
+  NAAM <- provincie <- NULL
 
 
   total_per_year <- df %>% 

alienSpecies/inst/app/serverFiles/serverSpecies.R

@@ -304,7 +304,10 @@ observe({
         uiText = reactive(results$translations),
         species = reactive(input$species_choice),
         df = reactive({
+
+            ## Individual data
             vespaPoints <- results$species_managementData()$points
+            vespaPoints$type <- "individual"
             # Columns
             regionVariables <- list(level3Name = "NAAM", level2Name = "provincie", level1Name = "GEWEST")
             for (iName in names(regionVariables))
@@ -320,9 +323,18 @@ observe({
                   ifelse(vespaPoints$provincie == "Brabant Wallon", "Waals-Brabant",
                     ifelse(vespaPoints$provincie == "Hainaut", "Henegouwen", vespaPoints$provincie)))))
             vespaPoints
+
+            ## Nest data
+            vespaNesten <- results$species_managementData()$nesten
+            vespaNesten$type <- "nest"
+
+            keepColumns <- c("year", "type", "NAAM", "provincie", "GEWEST", "geometry")
+            rbind(vespaPoints[, keepColumns], vespaNesten[, keepColumns])
+
           }),
         occurrenceData = NULL,
-        shapeData = allShapes
+        shapeData = allShapes,
+        sourceChoices = c("individual", "nest")
       )
 
       # Aantal lente nesten
@@ -333,7 +345,7 @@ observe({
         uiText = reactive(results$translations)
       )
 
-      # Aantal nesten per provincie
+      # Aantal nesten per provincie - figuur
       plotTriasServer(
         id = "management2_province",
         triasFunction = "countNesten",
@@ -342,6 +354,7 @@ observe({
         maxDate = reactive(max(results$species_managementData()$nesten$observation_time, na.rm = TRUE))
       )
 
+      # Aantal nesten per provincie - tabel
       plotTriasServer(
         id = "management2_provinceTable",
         triasFunction = "tableNesten",

alienSpecies/tests/testthat/testData.R

@@ -58,3 +58,34 @@ test_that("Tools", {
 
   })
 
+
+test_that("S3 bucket connection", {
+
+    skip("under development")
+
+    awsFile <- "~/.aws/credentials"
+
+    # credentials are in ~/.aws/credentials OR manually copy/paste OR using aws.signature::
+    x <- rawToChar(readBin(awsFile, "raw", n = 1e5L))
+#    profile <- Sys.getenv("AWS_PROFILE")
+    profile <- "inbo-alien"
+    credentials <- strsplit(x, profile)[[1]][2]
+
+    Sys.setenv(
+      AWS_DEFAULT_REGION = eval(parse(text = config::get("credentials", file = system.file("config.yml", package = "reportingGrofwild"))$region)),
+      AWS_ACCESS_KEY_ID = strsplit(strsplit(credentials, "aws_access_key_id = ")[[1]][2], "\n")[[1]][1], 
+      AWS_SECRET_ACCESS_KEY = strsplit(strsplit(credentials, "aws_secret_access_key = ")[[1]][2], "\n")[[1]][1],
+      AWS_SESSION_TOKEN = strsplit(strsplit(credentials, "aws_session_token = ")[[1]][2], "\n")[[1]][1]
+    )
+
+#      bucket = config::get("bucket", file = system.file("config.yml", package = "reportingGrofwild")))
+    bucket <- "inbo-exotenportaal-uat-eu-west-1-default"
+
+    # List all available files on the S3 bucket
+    tmpTable <- aws.s3::get_bucket_df(bucket = bucket)
+
+    s3read_using(FUN = read.table, object = basename("myfile.txt"), bucket = bucket)
+    put_object(file = "myfile.txt", object = "myfile.txt", bucket = bucket, multipart = TRUE)
+
+  })
+