index.Rmd

---
title: "Dashboard | LAJI.FI"
lang: en
output: 
  flexdashboard::flex_dashboard:
    includes:
      in_header: [plausible.html, navbar.html]
    css: styles.css
    favicon: favicon.ico
    theme:
      version: 4
      bg: "#141B15"
      fg: "#FFFFFF"
      primary: "#55AAE2"
      base_font:
        google:
          family: Roboto
          local: false
    orientation: columns
    vertical_layout: fill
runtime: shiny_prerendered
---

```{r setup, context = "setup", include = FALSE}
suppressPackageStartupMessages({

  library(curl, warn.conflicts = FALSE, quietly = TRUE)
  library(dplyr, warn.conflicts = FALSE, quietly = TRUE)
  library(DT, warn.conflicts = FALSE, quietly = TRUE)
  library(flexdashboard, warn.conflicts = FALSE, quietly = TRUE)
  library(future, warn.conflicts = FALSE, quietly = TRUE)
  library(ggplot2, warn.conflicts = FALSE, quietly = TRUE)
  library(httr2, warn.conflicts = FALSE, quietly = TRUE)
  library(lubridate, warn.conflicts = FALSE, quietly = TRUE)
  library(plotly, warn.conflicts = FALSE, quietly = TRUE)
  library(promises, warn.conflicts = FALSE, quietly = TRUE)
  library(scales, warn.conflicts = FALSE, quietly = TRUE)
  library(sf, warn.conflicts = FALSE, quietly = TRUE)
  library(shiny.i18n, warn.conflicts = FALSE, quietly = TRUE)
  library(shinyjs, warn.conflicts = FALSE, quietly = TRUE)
  library(stats, warn.conflicts = FALSE, quietly = TRUE)
  library(thematic, warn.conflicts = FALSE, quietly = TRUE)
  library(waiter, warn.conflicts = FALSE, quietly = TRUE)

})

plan(multisession)

thematic_shiny(
  font = font_spec("Roboto", install = FALSE),
  bg = "#141B15",
  fg = "#FFFFFF",
  accent = "#55AAE2"
)

api <- Sys.getenv("DASHBOARD_API")

req <- request(api)

finland <- readRDS("finland.rds")

bio_provinces <- readRDS("bio-provinces.rds")

source("collections.R")

enableBookmarking("url")

translator <- Translator$new(translation_json_path = "translation.json")

ggplotly_locale <- function(x, ...) {

  config(ggplotly(x$plot, ...), locale = x$lang)

}

sanitise_lang <- function(lang) {

  switch(lang, fi = "fi", "en")

}
```

```{r resources, context = "render", echo = FALSE}
addResourcePath("shinyjs", system.file("srcjs", package = "shinyjs"))
addResourcePath("robots.txt", "robots.txt")
addResourcePath("favicon.ico", "favicon.ico")
```

<script src="shinyjs/inject.js"></script>

```{js javascript, echo = FALSE}
document.querySelector(".navbar-brand").innerHTML =
  '<a href="https://laji.fi">LAJI.FI</a>';

$("body").on(
  "click",
  "a[href='#share-link']",
  function(e) {
    var url = window.location.href.split('#')[0];
    var hash = document.querySelector("a.nav-link.active").getAttribute("href");
    navigator.clipboard
      .writeText(url + hash)
      .then(() => {
        alert(
          "A link to the current dashboard has been copied to your clipboard"
        );
      })
      .catch(() => {
        alert("Error");
      });
  }
)

$("body").on(
  "click",
  "a[href='#en-lang']",
  function(e) {
    Shiny.setInputValue("lang_link", "en");
    document.documentElement.setAttribute("lang", "en");
    document.documentElement.setAttribute("xml:lang", "en");
  }
)

$("body").on(
  "click",
  "a[href='#fi-lang']",
  function(e) {
    Shiny.setInputValue("lang_link", "fi");
    document.documentElement.setAttribute("lang", "fi");
    document.documentElement.setAttribute("xml:lang", "fi");
  }
)

$("body").on(
  "shown.bs.tab",
  "a[href$='occ-plot']",
  function(e) {
    Shiny.setInputValue(
      "occurrence_tab_link", $(e.target).parent().index()
    );
  }
)

$("body").on(
  "shown.bs.tab",
  "a[href$='col-plot']",
  function(e) {
    Shiny.setInputValue(
      "collections_tab_link", $(e.target).parent().index()
    );
  }
)

$("body").on(
  "shown.bs.tab",
  "a[href$='cit-plot']",
  function(e) {
    Shiny.setInputValue(
      "citsci_tab_link", $(e.target).parent().index()
    );
  }
)
```

```{r server, context = "server"}
message(
  "INFO [", format(Sys.time()), "] ",
  session$request$REMOTE_ADDR, " \"",
  session$request$HTTP_USER_AGENT, "\" ",
  isolate(session$clientData$url_hostname), " ",
  session$request$REQUEST_METHOD, " ",
  isolate(session$clientData$url_pathname)
)

useShinyjs(html = TRUE)

observe({

  inputs <- reactiveValuesToList(input)

  defaults <- c("", "NULL", "0")

  inputs_with_default_values <- names(inputs)[unlist(inputs) %in% defaults]

  includes <- c(
    "lang",
    "source",
    "taxa",
    "restriction",
    "occurrence_tab",
    "collections_tab",
    "citsci_tab",
    "collection_quality",
    "maplevel",
    "institution",
    "discipline",
    "mapinstitution",
    "mapdiscipline",
    "projects"
  )

  excluded_ids <- setdiff(names(inputs), includes)

  setBookmarkExclude(
    c(
      inputs_with_default_values,
      excluded_ids,
      ".clientValue-default-plotlyCrosstalkOpts"
    )
  )

  session$doBookmark()

}) |>
bindEvent(
  input$lang,
  input$source,
  input$taxa,
  input$restriction,
  input$occurrence_tab,
  input$collections_tab,
  input$citsci_tab,
  input$collection_quality,
  input$maplevel,
  input$institution,
  input$discipline,
  input$mapinstitution,
  input$mapdiscipline,
  input$projects,
  ignoreInit = TRUE
)

onBookmarked({
  function(url) {
    updateQueryString(url)
    runjs('
      parent.location.hash =
        document
          .querySelector("a.nav-link.active")
            .getAttribute("href");
    ')
  }
})

onRestored({
  function(state) {
    runjs('
      $.urlParam = function (name) {
        var r = new RegExp(\'[\\?&]\' + name + \'=([^&#]*)\')
                  .exec(window.location.search);
        return (r !== null) ? decodeURI(r[1]).replace(/[\'"]+/g, \'\') || 0 : "";
      }
      Shiny.setInputValue("lang_link",  $.urlParam("lang"));
      Shiny.setInputValue("source_link",  $.urlParam("source"));
      Shiny.setInputValue("taxa_link",  $.urlParam("taxa"));
      Shiny.setInputValue("restriction_link",  $.urlParam("restriction"));
      Shiny.setInputValue("occurrence_tab_link",  $.urlParam("occurrence_tab"));
      Shiny.setInputValue("collections_tab_link",  $.urlParam("collections_tab"));
      Shiny.setInputValue("citsci_tab_link",  $.urlParam("citsci_tab"));
      Shiny.setInputValue("collection_quality_link",  $.urlParam("collection_quality"));
      Shiny.setInputValue("maplevel_link",  $.urlParam("maplevel"));
      Shiny.setInputValue("institution_link",  $.urlParam("institution"));
      Shiny.setInputValue("discipline_link",  $.urlParam("discipline"));
      Shiny.setInputValue("mapinstitution_link",  $.urlParam("mapinstitution"));
      Shiny.setInputValue("mapdiscipline_link",  $.urlParam("mapdiscipline"));
      Shiny.setInputValue("projects_link",  $.urlParam("projects"));
    ')
  }
})

observe(
  updateSelectInput(session, "lang", selected = input[["lang_link"]])
) |>
bindEvent(input$lang_link)

observe(
  updateSelectInput(session, "source", selected = input[["source_link"]])
) |>
bindEvent(input$source_link, ignoreInit = TRUE)

observe(
  updateSelectInput(session, "taxa", selected = input[["taxa_link"]])
) |>
bindEvent(input$taxa_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "restriction", selected = input[["restriction_link"]]
  )
) |>
bindEvent(input$restriction_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "collection_quality", selected = input[["collection_quality_link"]]
  )
) |>
bindEvent(input$collection_quality_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "maplevel", selected = input[["maplevel_link"]]
  )
) |>
bindEvent(input$maplevel_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "institution", selected = input[["institution_link"]]
  )
) |>
bindEvent(input$institution_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "discipline", selected = input[["discipline_link"]]
  )
) |>
bindEvent(input$discipline_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "mapinstitution", selected = input[["mapinstitution_link"]]
  )
) |>
bindEvent(input$mapinstitution_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "mapdiscipline", selected = input[["mapdiscipline_link"]]
  )
) |>
bindEvent(input$mapdiscipline_link, ignoreInit = TRUE)

observe(
  updateSelectInput(
    session, "projects", selected = input[["projects_link"]]
  )
) |>
bindEvent(input$projects_link, ignoreInit = TRUE)

site_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("DASHBOARD")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)
```

```{r waiter, context = "render", echo = FALSE}
autoWaiter(
  c(
    "quality_table", 
    "occurrence_plot",
    "species_plot",
    "annotations_plot",
    "datasets_plot",
    "municipality_map",
    "digitised_percent",
    "imaged_percent",
    "collection_plot",
    "progress_plot",
    "specimen_map", 
    "project_species_plot",
    "project_users_plot",
    "occurrence_cit_plot"
  ),
  html = bs4_spinner(),
  color = "transparent",
  fadeout = TRUE
)
```

`r textOutput("occurrence_title")` {#occurrence-page}
================================================================================

```{r occurrence_page_title_render, context = "server"}
occurrence_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Occurrence Data")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$occurrence_title <- renderText(occurrence_title())
```

Column {data-width=150}
--------------------------------------------------------------------------------

```{r site_title1, context = "render", echo = FALSE}
span(textOutput("site_title1"), class = "site-title")
```

```{r site_title1_render, context = "server"}
output$site_title1 <- renderText(site_title())
```

### {data-height=250}

####

```{r occurrence_page_inputs, context = "render", echo = FALSE}
uiOutput("sources")
uiOutput("taxa")
uiOutput("restriction")
```

```{r source_render, context = "server"}
sources <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c("", "NULL", collections$sources)

    names(choices) <- c(
      paste0(translator$t("Data Source"), "   "),
      translator$t(c("All Sources", names(collections$sources)))
    )

    selectInput(
      "source_link",
      NULL,
      choices,
      input$source,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$sources <- renderUI(sources())
```

```{r taxa_render, context = "server"}
taxa <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c(
      "",
      "NULL",
      "Algae",
      "Bryophytes",
      "Vascular Plants",
      "Fungi and lichens",
      "Worms",
      "Molluscs",
      "Crustaceans",
      "Myriapods",
      "Insects and arachnids",
      "Fishes",
      "Reptiles and amphibians",
      "Birds",
      "Mammals"
    )

    names(choices) <- c(
      paste0(translator$t("Taxa"), "   "),
      translator$t(
        c(
          "All Taxa",
          "Algae",
          "Bryophytes",
          "Vascular Plants",
          "Fungi & Lichens",
          "Worms",
          "Molluscs",
          "Crustaceans",
          "Myriapods",
          "Insects & Arachnids",
          "Fishes",
          "Reptiles & Amphibians",
          "Birds",
          "Mammals"
        )
      )
    )

    selectInput(
      "taxa_link",
      NULL,
      choices,
      input$taxa,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$taxa <- renderUI(taxa())
```

```{r restriction_render, context = "server"}
restriction <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c(
      "",
      "NULL",
      "true",
      "false"
    )

    names(choices) <- c(
      paste0(translator$t("Data Restriction"), "   "),
      translator$t(
        c(
          "All Data",
          "Restricted Only",
          "Unrestricted Only"
        )
      )
    )

    selectInput(
      "restriction_link",
      NULL,
      choices,
      input$restriction,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$restriction <- renderUI(restriction())
```

####

```{r reset1, context = "render", echo = FALSE}
uiOutput("reset1")
```

```{r reset_render1, context = "server"}
reset1 <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    actionButton(
      "reset1",
      translator$t("Reset"),
      width = "100%",
      class = "btn-primary"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$reset1 <- renderUI(reset1())

observe(
  {
    updateSelectInput(session, "source_link", selected = "")
    updateSelectInput(session, "taxa_link", selected = "")
    updateSelectInput(session, "restriction_link", selected = "")
    updateSelectInput(session, "collection_quality_link", selected = "")
    updateSelectInput(session, "maplevel_link", selected = "NULL")
  }
) |>
bindEvent(input$reset1)
```

#### {.invisible}

```{r hidden_inputs1, context = "render", echo = FALSE}
selectInput("lang", NULL, choices = c("en", "fi"))
selectInput("occurrence_tab", NULL, choices = 0:3)
selectInput("collections_tab", NULL, choices = 0:1)
selectInput("citsci_tab", NULL, choices = 0:2)
selectInput("source", NULL, choices = c("", "NULL", collections$sources))
selectInput(
  "taxa",
  NULL,
  choices = c(
    "",
    "NULL",
    "Algae",
    "Bryophytes",
    "Vascular Plants",
    "Fungi and lichens",
    "Worms",
    "Molluscs",
    "Crustaceans",
    "Myriapods",
    "Insects and arachnids",
    "Fishes",
    "Reptiles and amphibians",
    "Birds",
    "Mammals"
  )
)
selectInput("restriction", NULL, choices = c("", "NULL", "true", "false"))
selectInput(
  "collection_quality",
  NULL, 
  choices = c("", "NULL", "professional", "hobbyist", "amateur")
)
selectInput(
  "maplevel", NULL, choices = c("NULL", "bioprovince", "municipality")
)
```

Column {data-width=200}
--------------------------------------------------------------------------------

### `r textOutput("record_count_title")`

```{r fb_record_count_output, context = "render", echo = FALSE}
valueBoxOutput("record_count")
```

```{r fb_record_count_render, context = "server"}
record_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Records")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$record_count_title <- renderText(record_count_title())

output$record_count <- renderValueBox({
  quality_table() %...>%
  slice_tail %...>%
  pull %...>%
  valueBox(icon = "fa-pen", color = "#55AAE2")
})
```

### `r textOutput("species_count_title")`

```{r fb_species_count_output, context = "render", echo = FALSE}
valueBoxOutput("species_count")
```

```{r fb_species_count_render, context = "server"}
species_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Species")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$species_count_title <- renderText(species_count_title())

species_count <-
  reactive({

    req <-
      req_url_path(req, "species-count") |>
      req_url_query(
        restriction = input$restriction,
        taxa = input$taxa, 
        source = input$source
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      valueBox(icon = "fa-dove", color = "#55AAE2")

    }, seed = TRUE)

  }) |>
  bindCache(input$restriction, input$taxa, input$source, cache = "session") |>
  bindEvent(input$restriction, input$taxa, input$source)

output$species_count <- renderValueBox(species_count())
```

### `r textOutput("collection_count_title")`

```{r fb_collection_count_output, context = "render", echo = FALSE}
valueBoxOutput("collection_count")
```

```{r fb_collection_count_render, context = "server"}
collection_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Datasets")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$collection_count_title <- renderText(collection_count_title())

collection_count <-
  reactive({

    req <-
      req_url_path(req, "collection-count") |>
      req_url_query(
        restriction = input$restriction,
        taxa = input$taxa, 
        source = input$source
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      valueBox(icon = "fa-database", color = "#55AAE2")

    }, seed = TRUE)

  }) |>
  bindCache(input$restriction, input$taxa, input$source, cache = "session") |>
  bindEvent(input$restriction, input$taxa, input$source)

output$collection_count <- renderValueBox(collection_count())
```

###

```{r quality_table_ui_output, context = "render", echo = FALSE}
uiOutput("collection_quality", inline = TRUE)
```

```{r quality_table_render_ui, context = "server"}
collection_quality <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c(
      "",
      "NULL",
      "professional",
      "hobbyist",
      "amateur"
    )

    names(choices) <- c(
      paste0(translator$t("Dataset Quality Level"), "   "),
      translator$t(
        c(
          "All Levels",
          "Professionals",
          "Specialists",
          "Citizen Scientists"
        )
      )
    )

    selectInput(
      "collection_quality_link",
      NULL,
      choices,
      input$collection_quality,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$collection_quality <- renderUI(collection_quality())
```

```{r quality_table_output, context = "render", echo = FALSE}
dataTableOutput("quality_table")
```

```{r quality_table_render, context = "server"}
quality_table <-
  reactive({

    req <-
      req_url_path(req, "quality-table") |>
      req_url_query(
        collection_quality = input$collection_quality,
        restriction = input$restriction,
        taxa = input$taxa,
        source = input$source,
        lang = sanitise_lang(input$lang)
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize()

    }, seed = TRUE)

  }) |>
  bindCache(
    input$collection_quality,
    input$restriction,
    input$taxa,
    input$source,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$collection_quality,
    input$restriction,
    input$taxa,
    input$source,
    input$lang
  )

output$quality_table <- renderDataTable({

  quality_table() %...>%
  datatable(
    rownames = FALSE,
    options = list(
      bPaginate = FALSE,
      searching = FALSE,
      info = FALSE,
      ordering = FALSE,
      processing = FALSE
    ),
    fillContainer = TRUE,
    callback = JS("$.fn.dataTable.ext.errMode = 'throw';")
  )

})
```

Column {#occurrence-data-plots data-width=250 .tabset .tabset-fade}
--------------------------------------------------------------------------------

```{r occurrence_plot_observers, context = "server"}
observeEvent(
  input$occurrence_tab_link,
  {
    updateSelectInput(
      session,
      "occurrence_tab",
      selected = input[["occurrence_tab_link"]]
    )
  }
)

observe({

  removeCssClass(
    class = "active", selector = "#section-occurrence-data-plots li"
  )

  removeCssClass(
    class = "active", 
    selector = "#section-occurrence-data-plots .tab-content div"
  )

  removeCssClass(
    class = "in", selector = "#section-occurrence-data-plots .tab-content div"
  )

  addCssClass(
    class = "active",
    selector = sprintf(
      "#section-occurrence-data-plots li:nth-child(%s)",
      as.integer(input$occurrence_tab) + 1L
    )
  )

  addCssClass(
    class = "active",
    selector = sprintf(
      "#section-occurrence-data-plots .tab-content div:nth-child(%s)",
      as.integer(input$occurrence_tab) + 1L
    )
  )

  addCssClass(
    class = "in",
    selector = sprintf(
      "#section-occurrence-data-plots .tab-content div:nth-child(%s)",
      as.integer(input$occurrence_tab) + 1L
    )
  )

})
```

### `r textOutput("occ_occ_plot_title", inline = TRUE)` {#occurrences-occ-plot}

```{r occ_occ_plot_title_render, context = "server"}
occ_occ_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Occurrences")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$occ_occ_plot_title <- renderText(occ_occ_plot_title())
```

```{r occurrence_plot_output, context = "render", echo = FALSE}
plotlyOutput("occurrence_plot")
```

```{r occurrence_plot_render, context = "server"}
occurrence_plot <-
  reactive({

    req <-
      req_url_path(req, "occurrence-plot") |>
      req_url_query(
        restriction = input$restriction,
        taxa = input$taxa,
        source = input$source,
        lang = sanitise_lang(input$lang)
      )

    future_promise(
      {

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        translator$set_translation_language(lang)

        date <- translator$t("Date")

        records <- translator$t("Records")

        type <- translator$t("Type")

        res[[date]] <- as_date(res[[date]])

        big_mark <- switch(lang, fi = ".", ",")

        dec_mark <-switch(lang, fi = ",", ".")

        gg <-
          ggplot(res) +
          aes(x = .data[[date]], y = .data[[records]]) +
          geom_line() +
          facet_wrap(~.data[[type]], 2) +
          scale_y_continuous(
            label = label_comma(big.mark = big_mark, decimal.mark = dec_mark)
          ) +
          labs(x = NULL, y = NULL) +
          theme(plot.margin = unit(c(20, 0, 0, 10), "points"))

        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "lubridate", "scales", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$restriction,
    input$taxa,
    input$source,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$restriction,
    input$taxa,
    input$source,
    input$lang
  )

output$occurrence_plot <- renderPlotly({

  occurrence_plot() %...>%
  ggplotly_locale(dynamicTicks = TRUE)

})
```

### `r textOutput("sp_occ_plot_title", inline = TRUE)` {#species-occ-plot}

```{r sp_occ_plot_title_render, context = "server"}
sp_occ_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Species")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$sp_occ_plot_title <- renderText(sp_occ_plot_title())
```

```{r species_plot_output, context = "render", echo = FALSE}
plotlyOutput("species_plot")
```

```{r species_plot_render, context = "server"}
species_plot <-
  reactive({

    req <-
      req_url_path(req, "species-plot") |>
      req_url_query(
        restriction = input$restriction,
        taxa = input$taxa,
        source = input$source,
        lang = sanitise_lang(input$lang)
      )

    future_promise(
      {

        translator$set_translation_language(lang)

        records <- translator$t("Records")

        species <- translator$t("Species")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        gg <-
          ggplot(res) +
          aes(.data[[species]], .data[[records]]) +
          geom_bar(stat = "identity") +
          coord_flip() +
          labs(x = NULL, y = records)
        
        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$restriction,
    input$taxa,
    input$source,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$restriction,
    input$taxa,
    input$source,
    input$lang
  )

output$species_plot <- renderPlotly(

  species_plot() %...>%
  ggplotly_locale(dynamicTicks = TRUE)

)
```

### `r textOutput("ann_occ_plot_title", inline = TRUE)` {#annotations-occ-plot}

```{r ann_occ_plot_title_render, context = "server"}
ann_occ_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Annotations")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$ann_occ_plot_title <- renderText(ann_occ_plot_title())
```

```{r annotations_plot_output, context = "render", echo = FALSE}
plotlyOutput("annotations_plot")
```

```{r annotations_plot_render, context = "server"}
annotations_plot <-
  reactive({

    req <-
      req_url_path(req, "annotations-plot") |>
      req_url_query(
        restriction = input$restriction,
        taxa = input$taxa,
        source = input$source,
        lang = sanitise_lang(input$lang)
      )

    future_promise(
      {

        translator$set_translation_language(lang)

        date <- translator$t("Date")

        annotations <- translator$t("Annotations")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        res[[date]] <- as_date(res[[date]])

        big_mark <- switch(lang, fi = ".", ",")

        dec_mark <-switch(lang, fi = ",", ".")

        gg <-
          ggplot(res) +
          aes(x = .data[[date]], y = .data[[annotations]]) +
          geom_line() +
          scale_y_continuous(
            label = label_comma(big.mark = big_mark, decimal.mark = dec_mark)
          ) +
          labs(x = NULL, y = NULL)

        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "lubridate", "scales", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$restriction,
    input$taxa,
    input$source,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$restriction,
    input$taxa,
    input$source,
    input$lang
  )

output$annotations_plot <- renderPlotly(

  annotations_plot() %...>%
  ggplotly_locale(dynamicTicks = TRUE)

)
```

### `r textOutput("data_occ_plot_title", inline = TRUE)` {#datasets-occ-plot}

```{r data_occ_plot_title_render, context = "server"}
data_occ_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Datasets")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$data_occ_plot_title <- renderText(data_occ_plot_title())
```

```{r datasets_plot_output, context = "render", echo = FALSE}
plotlyOutput("datasets_plot")
```

```{r datasets_plot_render, context = "server"}
datasets_plot <-
  reactive({

    req <-
      req_url_path(req, "datasets-plot") |>
      req_url_query(
        restriction = input$restriction,
        taxa = input$taxa,
        source = input$source,
        lang = sanitise_lang(input$lang)
      )

    future_promise(

      {

        translator$set_translation_language(lang)

        dataset <- translator$t("Dataset")

        records <- translator$t("Records")

        type <- translator$t("Type")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        gg <-
          ggplot(res) +
          aes(
            x = .data[[dataset]], y = .data[[records]], fill = .data[[type]]
          ) +
          geom_bar(stat = "identity") +
          coord_flip() +
          scale_fill_viridis_d() +
          labs(x = NULL, y = NULL)

        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$restriction,
    input$taxa,
    input$source,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$restriction,
    input$taxa,
    input$source,
    input$lang
  )

output$datasets_plot <- renderPlotly({

  datasets_plot() %...>%
  ggplotly_locale(dynamicTicks = TRUE) %...>%
  layout(
    legend = list(
      x = 0, xanchor = "left", yanchor = "bottom", orientation = "h"
    )
  )

})
```

Column {data-width=300}
--------------------------------------------------------------------------------

### 

```{r municipality_map_output, context = "render", echo = FALSE}
fillCol(
  height = "100%",
  flex = c(NA, 1),
  uiOutput("maplevel"),
  plotlyOutput("municipality_map")
)
```

```{r municipality_map_render, context = "server"}
maplevel <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c("NULL", "bioprovince", "municipality")

    names(choices) <- translator$t(
      c("Region", "Biogeographical Province", "Municipality")
    )

    selectInput(
      "maplevel_link",
      NULL,
      choices,
      input$maplevel,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$maplevel <- renderUI(maplevel())

municipality_map <-
  reactive({

    level <- input$maplevel

    level <- switch(
      level,
      bioprovince = "MAAKUNTA_FI",
      municipality = "municipality_name_fi",
      paste0("maakunta_name_", sanitise_lang(input$lang))
    )

    endpoint <- switch(
      level, MAAKUNTA_FI = "bio-province-map", "municipality-map"
    )

    req <-
      req_url_path(req, endpoint) |>
      req_url_query(
        restriction = input$restriction,
        taxa = input$taxa,
        source = input$source
      )

    future_promise(
      {

        translator$set_translation_language(lang)

        records <- translator$t("Records")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        res <-
          switch(
            level,
            MAAKUNTA_FI = left_join(
              bio_provinces, res, by = join_by(MAAKUNTA_FI)
            ),
            left_join(finland, res, by = join_by(municipality_name_fi))
          ) |>
          group_by(.data[[level]]) |>
          summarise(Records = sum(n_records, na.rm = TRUE)) |>
          mutate(text = paste0(.data[[level]], ": " , Records)) |>
          st_cast("MULTIPOLYGON")

        names(res)[names(res) == "Records"] <- records

        big_mark <- switch(lang, fi = ".", ",")

        dec_mark <-switch(lang, fi = ",", ".")

        gg <-
          ggplot(res) +
          aes(fill = .data[[records]], text = text) +
          geom_sf(lwd = .1) +
          scale_fill_viridis_c(
            label = label_comma(big.mark = big_mark, decimal.mark = dec_mark)
          )

        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator,
        req = req,
        bio_provinces = bio_provinces,
        finland = finland,
        lang = sanitise_lang(input$lang),
        level = level
      ),
      packages = c("dplyr", "ggplot2", "httr2", "scales", "sf", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$maplevel,
    input$restriction,
    input$taxa,
    input$source,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$maplevel,
    input$restriction,
    input$taxa, 
    input$source,
    input$lang
  )

output$municipality_map <- renderPlotly({

  municipality_map() %...>%
  ggplotly_locale(tooltip = "text")

})
```

`r textOutput("specimen_collection_title")` {#specimen-collection-page}
================================================================================

```{r specimen_collection_page_title_render, context = "server"}
specimen_collection_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Specimen Collections/Digitisation")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$specimen_collection_title <- renderText(specimen_collection_title())
```

Column {data-width=150}
--------------------------------------------------------------------------------

```{r site_title2, context = "render", echo = FALSE}
span(textOutput("site_title2"), class = "site-title")
```

```{r site_title2_render, context = "server"}
output$site_title2 <- renderText(site_title())
```

### {data-height=250}

####

```{r specimen_collection_page_inputs, context = "render", echo = FALSE}
uiOutput("institution")
uiOutput("discipline")
```

```{r institution_render, context = "server"}
institution <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c("", "NULL", collections$institutions)

    names(choices) <- c(
      paste0(translator$t("Institution"), "   "),
      translator$t(c("All Institutions", names(collections$institutions)))
    )

    selectInput(
      "institution_link",
      NULL,
      choices,
      input$institution,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$institution <- renderUI(institution())
```

```{r discipline_render, context = "server"}
discipline <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c(
      "",
      "NULL",
      "botany",
      "zoology",
      "geology"
    )

    names(choices) <- c(
      paste0(translator$t("Discipline"), "   "),
      translator$t(c("All Disciplines", "Botany", "Zoology", "Geology"))
    )

    selectInput(
      "discipline_link",
      NULL,
      choices,
      input$discipline,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$discipline <- renderUI(discipline())
```

####

```{r reset2, context = "render", echo = FALSE}
uiOutput("reset2")
```

```{r reset_render2, context = "server"}
reset2 <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    actionButton(
      "reset2",
      translator$t("Reset"),
      width = "100%",
      class = "btn-primary"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$reset2 <- renderUI(reset2())

observe(
  {
    updateSelectInput(session, "institution_link", selected = "")
    updateSelectInput(session, "discipline_link", selected = "")
  }
) |>
bindEvent(input$reset2)
```

#### {.invisible}

```{r hidden_inputs2, context = "render", echo = FALSE}
selectInput(
  "institution", NULL, choices = c("", "NULL", collections$institutions)
)
selectInput(
  "discipline", NULL, choices = c("", "NULL", "botany", "zoology", "geology")
)
```

Column {data-width=200}
--------------------------------------------------------------------------------

### `r textOutput("specimen_collection_count_title")`

```{r fb_specimen_collection_count_output, context = "render", echo = FALSE}
valueBoxOutput("specimen_collection_count")
```

```{r fb_specimen_collection_count_render, context = "server"}
specimen_collection_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Collections")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$specimen_collection_count_title <- renderText(
  specimen_collection_count_title()
)

specimen_collection_count <-
  reactive({

    req <-
      req_url_path(req, "specimen-collections") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      valueBox(icon = "fa-database", color = "#55AAE2")

    }, seed = TRUE)

  }) |>
  bindCache(input$discipline, input$institution, cache = "session") |>
  bindEvent(input$discipline, input$institution)

output$specimen_collection_count <- renderValueBox(specimen_collection_count())
```

### `r textOutput("specimen_count_title")`

```{r fb_specimen_count_output, context = "render", echo = FALSE}
valueBoxOutput("specimen_count")
```

```{r fb_specimen_count_render, context = "server"}
specimen_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Specimens")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$specimen_count_title <- renderText(specimen_count_title())

specimen_count <-
  reactive({

    req <-
      req_url_path(req, "specimen-collections") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution,
        stat = "n_specimens"
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      valueBox(icon = "fa-mosquito", color = "#55AAE2")

    }, seed = TRUE)

  }) |>
  bindCache(input$discipline, input$institution, cache = "session") |>
  bindEvent(input$discipline, input$institution)

output$specimen_count <- renderValueBox(specimen_count())
```

### `r textOutput("digitised_count_title")`

```{r fb_digitised_count_output, context = "render", echo = FALSE}
valueBoxOutput("digitised_count")
```

```{r fb_digitised_count_render, context = "server"}
digitised_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Digitised")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$digitised_count_title <- renderText(digitised_count_title())

digitised_count <-
  reactive({

    req <-
      req_url_path(req, "specimen-collections") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution,
        stat = "n_specimens_digitised"
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      valueBox(icon = "fa-computer", color = "#55AAE2")

    }, seed = TRUE)

  }) |>
  bindCache(input$discipline, input$institution, cache = "session") |>
  bindEvent(input$discipline, input$institution)

output$digitised_count <- renderValueBox(digitised_count())
```

### `r textOutput("digitised_percent_title")`

```{r fb_digitised_percent_output, context = "render", echo = FALSE}
gaugeOutput("digitised_percent")
```

```{r fb_digitised_percent_render, context = "server"}
digitised_percent_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Percent Digitised")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$digitised_percent_title <- renderText(digitised_percent_title())

digitised_percent <-
  reactive({

    req <-
      req_url_path(req, "specimen-collections") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution,
        stat = "percent_digitised"
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      gauge(min = 0, max = 100, symbol = "%")

    }, seed = TRUE)

  }) |>
  bindCache(input$discipline, input$institution, cache = "session") |>
  bindEvent(input$discipline, input$institution)

output$digitised_percent <- renderGauge(digitised_percent())
```

### `r textOutput("imaged_count_title")`

```{r fb_imaged_count_output, context = "render", echo = FALSE}
valueBoxOutput("imaged_count")
```

```{r fb_imaged_count_render, context = "server"}
imaged_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Imaged")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$imaged_count_title <- renderText(imaged_count_title())

imaged_count <-
  reactive({

    req <-
      req_url_path(req, "specimen-collections") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution,
        stat = "n_specimens_imaged"
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      valueBox(icon = "fa-camera", color = "#55AAE2")

    }, seed = TRUE)

  }) |>
  bindCache(input$discipline, input$institution, cache = "session") |>
  bindEvent(input$discipline, input$institution)

output$imaged_count <- renderValueBox(imaged_count())
```

### `r textOutput("imaged_percent_title")`

```{r fb_imaged_percent_output, context = "render", echo = FALSE}
gaugeOutput("imaged_percent")
```

```{r fb_imaged_percent_render, context = "server"}
imaged_percent_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Percent Imaged")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$imaged_percent_title <- renderText(imaged_percent_title())

imaged_percent <-
  reactive({

    req <-
      req_url_path(req, "specimen-collections") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution,
        stat = "percent_imaged"
      )

    future_promise({

      req_perform(req) |>
      resp_body_raw() |>
      unserialize() |>
      gauge(min = 0, max = 100, symbol = "%")

    }, seed = TRUE)

  }) |>
  bindCache(input$discipline, input$institution, cache = "session") |>
  bindEvent(input$discipline, input$institution)

output$imaged_percent <- renderGauge(imaged_percent())
```

Column {#collection-data-plots data-width=550 .tabset .tabset-fade}
--------------------------------------------------------------------------------

```{r collections_plot_observers, context = "server"}
observeEvent(
  input$collections_tab_link,
  {
    updateSelectInput(
      session, 
      "collections_tab",
      selected = input[["collections_tab_link"]]
    )
  }
)

observe({

  removeCssClass(
    class = "active", selector = "#section-collection-data-plots li"
  )

  removeCssClass(
    class = "active", 
    selector = "#section-collection-data-plots .tab-content div"
  )

  removeCssClass(
    class = "in", selector = "#section-collection-data-plots .tab-content div"
  )

  addCssClass(
    class = "active",
    selector = sprintf(
      "#section-collection-data-plots li:nth-child(%s)",
      as.integer(input$collections_tab) + 1L
    )
  )

  addCssClass(
    class = "active",
    selector = sprintf(
      "#section-collection-data-plots .tab-content div:nth-child(%s)",
      as.integer(input$collections_tab) + 1L
    )
  )

  addCssClass(
    class = "in",
    selector = sprintf(
      "#section-collection-data-plots .tab-content div:nth-child(%s)",
      as.integer(input$collections_tab) + 1L
    )
  )

})
```

### `r textOutput("col_col_plot_title", inline = TRUE)` {#collections-col-plot}

```{r col_col_plot_title_render, context = "server"}
col_col_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Collections")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$col_col_plot_title <- renderText(col_col_plot_title())
```

```{r collection_plot_output, context = "render", echo = FALSE}
plotlyOutput("collection_plot")
```

```{r collection_plot_render, context = "server"}
collection_plot <-
  reactive({

    req <-
      req_url_path(req, "specimen-collections") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution,
        stat = "table",
        lang = sanitise_lang(input$lang)
      )

    future_promise(
      {

        translator$set_translation_language(lang)

        collection <- translator$t("Collection")

        specimens <- translator$t("Specimens")

        status <- translator$t("Status")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        gg <-
          ggplot(res) +
          aes(.data[[collection]], .data[[specimens]], fill = .data[[status]]) +
          geom_bar(stat = "identity") +
          coord_flip() +
          scale_fill_viridis_d() +
          labs(x = NULL)

        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$discipline,
    input$institution,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$discipline,
    input$institution,
    input$lang
  )

output$collection_plot <- renderPlotly({

  collection_plot() %...>%
  ggplotly_locale(dynamicTicks = TRUE) %...>%
  layout(
    legend = list(
      x = 0, xanchor = "left", yanchor = "bottom", orientation = "h"
    )
  )

})
```

### `r textOutput("prog_col_plot_title", inline = TRUE)` {#progress-col-plot}

```{r prog_col_plot_title_render, context = "server"}
prog_col_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Progress")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$prog_col_plot_title <- renderText(prog_col_plot_title())
```

```{r progress_plot_output, context = "render", echo = FALSE}
plotlyOutput("progress_plot")
```

```{r progress_plot_render, context = "server"}
progress_plot <-
  reactive({

    req <-
      req_url_path(req, "progress-plot") |>
      req_url_query(
        discipline = input$discipline,
        institution = input$institution,
        lang = sanitise_lang(input$lang)
      )

    future_promise(
      {

        translator$set_translation_language(lang)

        date <- translator$t("Date")

        specimens <- translator$t("Specimens")
  
        status <- translator$t("Status")
  
        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        res[[date]] <- as_date(res[[date]])

        big_mark <- switch(lang, fi = ".", ",")

        dec_mark <-switch(lang, fi = ",", ".")

        gg <-
          ggplot(res) +
          aes(x = .data[[date]], y = .data[[specimens]]) +
          geom_line() +
          facet_wrap(~.data[[status]], 2) +
          scale_y_continuous(
            label = label_comma(big.mark = big_mark, decimal.mark = dec_mark)
          ) +
          labs(x = NULL, y = NULL) +
          theme(plot.margin = unit(c(20, 0, 0, 10), "points"))
        
        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "lubridate", "scales", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$discipline,
    input$institution,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$discipline,
    input$institution,
    input$lang
  )

output$progress_plot <- renderPlotly({

  progress_plot() %...>%
  ggplotly_locale(dynamicTicks = TRUE)

})
```

`r textOutput("specimen_map_title")` {#specimen-map-page}
================================================================================

```{r specimen_map_page_title_render, context = "server"}
specimen_map_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Specimens Map")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$specimen_map_title <- renderText(specimen_map_title())
```

Column {data-width=150}
--------------------------------------------------------------------------------

```{r site_title3, context = "render", echo = FALSE}
span(textOutput("site_title3"), class = "site-title")
```

```{r site_title3_render, context = "server"}
output$site_title3 <- renderText(site_title())
```

### {data-height=250}

####

```{r specimen_map_page_inputs, context = "render", echo = FALSE}
uiOutput("mapinstitution")
uiOutput("mapdiscipline")
```

```{r mapinstitution_render, context = "server"}
mapinstitution <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c("", "NULL", collections$institutions)

    names(choices) <- c(
      paste0(translator$t("Institution"), "   "),
      translator$t(c("All Institutions", names(collections$institutions)))
    )

    selectInput(
      "mapinstitution_link",
      NULL,
      choices,
      input$mapinstitution,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$mapinstitution <- renderUI(mapinstitution())
```

```{r mapdiscipline_render, context = "server"}
mapdiscipline <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c(
      "",
      "NULL",
      "botany",
      "zoology",
      "geology"
    )

    names(choices) <- c(
      paste0(translator$t("Discipline"), "   "),
      translator$t(c("All Disciplines", "Botany", "Zoology", "Geology"))
    )

    selectInput(
      "mapdiscipline_link",
      NULL,
      choices,
      input$mapdiscipline,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$mapdiscipline <- renderUI(mapdiscipline())
```

####

```{r reset3, context = "render", echo = FALSE}
uiOutput("reset3")
```

```{r reset_render3, context = "server"}
reset3 <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    actionButton(
      "reset3",
      translator$t("Reset"),
      width = "100%",
      class = "btn-primary"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$reset3 <- renderUI(reset3())

observe(
  {
    updateSelectInput(session, "mapinstitution_link", selected = "")
    updateSelectInput(session, "mapdiscipline_link", selected = "")
  }
) |>
bindEvent(input$reset3)
```

#### {.invisible}

```{r hidden_inputs3, context = "render", echo = FALSE}
selectInput(
  "mapinstitution", NULL, choices = c("", "NULL", collections$institutions)
)
selectInput(
  "mapdiscipline", NULL, choices = c("", "NULL", "botany", "zoology", "geology")
)
```

Column {data-width=750}
--------------------------------------------------------------------------------

###

```{r specimen_map_output, context = "render", echo = FALSE}
fillCol(plotlyOutput("specimen_map"))
```

```{r specimen_map_render, context = "server"}
specimen_map <-
  reactive({

    req <-
      req_url_path(req, "specimen-map") |>
      req_url_query(
        mapinstitution = input$mapinstitution,
        mapdiscipline = input$mapdiscipline,
        lang = sanitise_lang(input$lang)
      )

    future_promise(
      {

        translator$set_translation_language(lang)

        specimens <- translator$t("Specimens")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        big_mark <- switch(lang, fi = ".", ",")

        dec_mark <-switch(lang, fi = ",", ".")

        gg <-
          ggplot(res) +
          aes(fill = .data[[specimens]], text = text) +
          geom_sf(lwd = .1) +
          scale_fill_viridis_c(
            label = label_comma(big.mark = big_mark, decimal.mark = dec_mark),
            trans = "pseudo_log"
          )
        
        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "scales", "sf", "shiny.i18n")
    )

  }) |>
  bindCache(
    input$mapinstitution,
    input$mapdiscipline,
    input$lang,
    cache = "session"
  ) |>
  bindEvent(
    input$mapinstitution,
    input$mapdiscipline,
    input$lang
  )

output$specimen_map <- renderPlotly({

  specimen_map() %...>%
  ggplotly_locale(tooltip = "text")

})
```

`r textOutput("citsci_title")` {#citsci-page}
================================================================================

```{r citsci_title_render, context = "server"}
citsci_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Citizen Science")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$citsci_title <- renderText(citsci_title())
```

Column {data-width=150}
--------------------------------------------------------------------------------

```{r site_title4, context = "render", echo = FALSE}
span(textOutput("site_title4"), class = "site-title")
```

```{r site_title4_render, context = "server"}
output$site_title4 <- renderText(site_title())
```

### {data-height=250}

####

```{r citsci_page_inputs, context = "render", echo = FALSE}
uiOutput("projects")
```

```{r projects_render, context = "server"}
projects <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    choices <- c("", "NULL", collections$cit_sci_projects)

    names(choices) <- c(
      paste0(translator$t("Project"), "   "),
      translator$t(c("All Projects", names(collections$cit_sci_projects)))
    )

    selectInput(
      "projects_link",
      NULL,
      choices,
      input$projects,
      width = "100%"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$projects <- renderUI(projects())
```

####

```{r reset4, context = "render", echo = FALSE}
uiOutput("reset4")
```

```{r reset_render4, context = "server"}
reset4 <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    actionButton(
      "reset4",
      translator$t("Reset"),
      width = "100%",
      class = "btn-primary"
    )

  }) |>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$reset4 <- renderUI(reset4())

observe(
  {
    updateSelectInput(session, "projects_link", selected = "")
  }
) |>
bindEvent(input$reset4)
```

#### {.invisible}

```{r hidden_inputs4, context = "render", echo = FALSE}
selectInput(
  "projects", NULL, choices = c("", "NULL", collections$cit_sci_projects)
)
```

Column {data-width=200}
--------------------------------------------------------------------------------

### `r textOutput("project_count_title")`

```{r fb_project_count_output, context = "render", echo = FALSE}
valueBoxOutput("project_count")
```

```{r fb_project_count_render, context = "server"}
project_count_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Projects")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$project_count_title <- renderText(project_count_title())

project_count <-
  reactive({

    translator$set_translation_language(sanitise_lang(input$lang))

    n <- length(collections$cit_sci_projects)

    caption <- translator$t("Projects")

    if (!input$projects %in% c("", "NULL")) {
  
      n <- 1L

      caption <- translator$t("Project")

    }

    future_promise({

      valueBox(
        n, icon = "fa-clipboard-list", color = "#55AAE2", caption = caption
      )

    }, seed = TRUE)

  }) |>
  bindCache(input$projects, input$lang, cache = "session") |>
  bindEvent(input$projects, input$lang)

output$project_count <- renderValueBox(project_count())
```

Column {#citsci-data-plots data-width=550 .tabset .tabset-fade}
--------------------------------------------------------------------------------

```{r citsci_data_plot_observers, context = "server"}
observeEvent(
  input$citsci_tab_link,
  {
    updateSelectInput(
      session, 
      "citsci_tab",
      selected = input[["citsci_tab_link"]]
    )
  }
)

observe({

  removeCssClass(
    class = "active", selector = "#section-citsci-data-plots li"
  )

  removeCssClass(
    class = "active", 
    selector = "#section-citsci-data-plots .tab-content div"
  )

  removeCssClass(
    class = "in", selector = "#section-citsci-data-plots .tab-content div"
  )

  addCssClass(
    class = "active",
    selector = sprintf(
      "#section-citsci-data-plots li:nth-child(%s)",
      as.integer(input$citsci_tab) + 1L
    )
  )

  addCssClass(
    class = "active",
    selector = sprintf(
      "#section-citsci-data-plots .tab-content div:nth-child(%s)",
      as.integer(input$citsci_tab) + 1L
    )
  )

  addCssClass(
    class = "in",
    selector = sprintf(
      "#section-citsci-data-plots .tab-content div:nth-child(%s)",
      as.integer(input$citsci_tab) + 1L
    )
  )

})
```

### `r textOutput("sp_cit_plot_title", inline = TRUE)` {#species-cit-plot}

```{r sp_cit_plot_title_render, context = "server"}
sp_cit_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Species")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$sp_cit_plot_title <- renderText(sp_cit_plot_title())
```

```{r project_species_plot_output, context = "render", echo = FALSE}
plotlyOutput("project_species_plot")
```

```{r project_species_plot_render, context = "server"}
project_species_plot <-
  reactive({

    req <-
      req_url_path(req, "cit-sci-species-count") |>
      req_url_query(projects = input$projects, lang = sanitise_lang(input$lang))

    future_promise(
      {

        translator$set_translation_language(lang)

        year <- translator$t("Year")

        species <- translator$t("Species")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        gg <-
          ggplot(res) +
          aes(.data[[year]], .data[[species]]) +
          geom_bar(stat = "identity") +
          labs(x = NULL, y = NULL)

        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "shiny.i18n")
    )

  }) |>
  bindCache(input$projects, input$lang, cache = "session") |>
  bindEvent(input$projects, input$lang)

output$project_species_plot <- renderPlotly({

  project_species_plot() %...>%
  ggplotly_locale()

})
```

### `r textOutput("users_cit_plot_title", inline = TRUE)` {#users-cit-plot}

```{r users_cit_plot_title_render, context = "server"}
users_cit_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Users")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$users_cit_plot_title <- renderText(users_cit_plot_title())
```

```{r project_users_plot_output, context = "render", echo = FALSE}
plotlyOutput("project_users_plot")
```

```{r project_users_plot_render, context = "server"}
project_users_plot <-
  reactive({

    req <-
      req_url_path(req, "cit-sci-user-count") |>
      req_url_query(projects = input$projects, lang = sanitise_lang(input$lang))

    future_promise(
      {

        translator$set_translation_language(lang)

        year <- translator$t("Year")

        users <- translator$t("Users")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()
        
        gg <-
          ggplot(res) +
          aes(.data[[year]], .data[[users]]) +
          geom_bar(stat = "identity") +
          labs(x = NULL, y = NULL)

        list(plot = gg, lang = lang)
  
      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "shiny.i18n")
    )

  }) |>
  bindCache(input$projects, input$lang, cache = "session") |>
  bindEvent(input$projects, input$lang)

output$project_users_plot <- renderPlotly({

  project_users_plot() %...>%
  ggplotly_locale()

})
```

### `r textOutput("occ_cit_plot_title", inline = TRUE)` {#occurrences-cit-plot}

```{r occ_cit_plot_title_render, context = "server"}
occ_cit_plot_title <-
  reactive({
    translator$set_translation_language(sanitise_lang(input$lang))
    translator$t("Occurrences")
  })|>
  bindCache(input$lang, cache = "session") |>
  bindEvent(input$lang)

output$occ_cit_plot_title <- renderText(occ_cit_plot_title())
```

```{r occurrence_cit_plot_output, context = "render", echo = FALSE}
plotlyOutput("occurrence_cit_plot")
```

```{r occurrence_cit_plot_render, context = "server"}
occurrence_cit_plot <-
  reactive({

    req <-
      req_url_path(req, "occurrence-citsci") |>
      req_url_query(projects = input$projects, lang = sanitise_lang(input$lang))

    future_promise(
      {

        translator$set_translation_language(lang)

        project <- translator$t("Project")

        occurrences <- translator$t("Occurrences")

        res <-
          req_perform(req) |>
          resp_body_raw() |>
          unserialize()

        gg <-
          ggplot(res) +
          aes(.data[[project]], .data[[occurrences]]) +
          geom_bar(stat = "identity") +
          coord_flip() +
          labs(x = NULL, y = NULL)

        list(plot = gg, lang = lang)

      },
      seed = TRUE,
      globals = list(
        translator = translator, req = req, lang = sanitise_lang(input$lang)
      ),
      packages = c("ggplot2", "httr2", "shiny.i18n")
    )

  }) |>
  bindCache(input$projects, input$lang, cache = "session") |>
  bindEvent(input$projects, input$lang)

output$occurrence_cit_plot <- renderPlotly({

  occurrence_cit_plot() %...>%
    ggplotly_locale(dynamicTicks = TRUE)

})
```