Merge beta into main (#20)

* Feature/json and first plot (#6) * json instead of csv * first plot wip * zipm upload * first nc plot * documentation * fix check note * remove outdated json * show alerts for missing informations / wrong file types * add rgpt3 to description file * update dockerfile * dockerfile * Change from base-image:4.2.1 to r-shiny:4.2.3 image * change from r-shiny:4.2.3 to r-shiny:4.2.1 * back to 4.2.3 * add .Rprofile - add drat repo * add drat repo to dockerimage * fix typo * integrate import module from most recent version of DataTools (#11) --------- Co-authored-by: Jan Abel <106665518+jan-abel-inwt@users.noreply.github.com> Co-authored-by: Jan A <jan.abel@inwt-statistics.de> Co-authored-by: Antonia Runge <antonia.runge@inwt-statistics.de> * Update cosign-installer version * Fix/missing zip and function (#12) * fix namespace issues and change Rbuildignore to prevent example data being removed * remove unwanted linebreaks * Feature/plot title (#14) * change plot width and alignment; format code * title and formatting options * fix problem with relative height * inc DataTools, add config (#15) * Feature/13 questionnaire (#16) * changes for questionnaire option * remove image list dependency * update readme * adds questionnaire functionality * test prepareQuestionnaireImage * update readme * reactivate observe enable disable action button * styling * function docu * use fill value from example zip * adjust error message * Vignette (#17) * set up vignette * first draft of vignette * install qpdf * add pandoc installation * adjust dockerfile * fix typo * Update vignettes/how-to-use-MapR.Rmd Co-authored-by: Antonia Runge <antonia.runge@inwt-statistics.de> * Update vignettes/how-to-use-MapR.Rmd Co-authored-by: Antonia Runge <antonia.runge@inwt-statistics.de> * Update README.md Co-authored-by: Antonia Runge <antonia.runge@inwt-statistics.de> * update vignette and readme * Update README.md Co-authored-by: Jan Abel <106665518+jan-abel-inwt@users.noreply.github.com> * adding little structure into the vignette (#19) * small readme fix --------- Co-authored-by: Antonia Runge <antonia.runge@inwt-statistics.de> Co-authored-by: Jan Abel <106665518+jan-abel-inwt@users.noreply.github.com> --------- Co-authored-by: Jan Abel <106665518+jan-abel-inwt@users.noreply.github.com> Co-authored-by: Jan A <jan.abel@inwt-statistics.de> Co-authored-by: Antonia Runge <antonia.runge@inwt-statistics.de>
Pandora-IsoMemo · Jan 23, 2024 · 9519768 · 9519768
1 parent 768c6d2
commit 9519768
Show file tree

Hide file tree

Showing 82 changed files with 5,325 additions and 138 deletions.
diff --git a/.Rbuildignore b/.Rbuildignore
@@ -13,3 +13,4 @@
 ^deploy\.sh$
 ^\..*$
 ^\.Rproj\.user$
+^inst/data$
diff --git a/.Rprofile b/.Rprofile
@@ -0,0 +1,19 @@
+# When starting a new R session, a specific directory is added to the libPath.
+# It's called libWin resp. libLinux. As it is on the first libPath position,
+# packages are installed into this directory by default. This enables working in
+# a sandbox.
+
+.First <- function() {
+  # Check operating system
+  if (Sys.info()["sysname"] == "Windows") {
+    # Add libWin with the full path to libPaths
+    .libPaths(new = c(paste(getwd(), "libWin", sep = "/"), .libPaths()))
+  } else if (Sys.info()["sysname"] == "Linux") {
+    .libPaths(new = c(paste(getwd(), "libLinux", sep = "/"), .libPaths()))
+  } else if (Sys.info()["sysname"] == "Darwin") {
+    .libPaths(new = c(paste(getwd(), "libMac", sep = "/"), .libPaths()))
+  }
+  options(repos = c(getOption("repos"), PANDORA = "https://Pandora-IsoMemo.github.io/drat/"))
+}
+
+.First()
diff --git a/.gitignore b/.gitignore
@@ -1 +1,3 @@
 .Rproj.user
+.Rhistory
+inst/doc
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,13 +1,28 @@
 Package: MapR
 Title: Display temporal and temperature graphical files for Isomemo
-Version: 22.12.1
+Version: 24.1.0
 Authors@R: c(person("Lukas", "Fuchs", email = "lukas.fuchs@inwt-statistics.de", role = c("aut", "cre")))
 Description: An App to display temporal and temperature graphical files for Isomemo.
 License: GPL (>= 3)
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
+Remotes:
+  github::ben-aaron188/rgpt3
 Imports: 
+    colourpicker,
+    DataTools (>= 23.12.2),
     magrittr,
+    pastclim,
+    rjson,
     shiny,
-    shinyjs
+    shinyjs,
+    shinyWidgets,
+    terra,
+    yaml
+Suggests: 
+    knitr,
+    rmarkdown,
+    testthat (>= 3.0.0)
+Config/testthat/edition: 3
+VignetteBuilder: knitr
diff --git a/Dockerfile b/Dockerfile
@@ -1,7 +1,12 @@
-FROM ghcr.io/pandora-isomemo/base-image:latest
+FROM inwt/r-shiny:4.2.3
 
 ADD . .
 
-RUN installPackage
+RUN apt-get update \
+    && apt-get install -y --no-install-recommends \
+    qpdf \
+    pandoc \
+    && echo "options(repos = c(getOption('repos'), PANDORA = 'https://Pandora-IsoMemo.github.io/drat/'))" >> /usr/local/lib/R/etc/Rprofile.site \
+    && installPackage
 
 CMD ["Rscript", "-e", "library(MapR);startApplication(3838)"]
diff --git a/NAMESPACE b/NAMESPACE
@@ -5,5 +5,9 @@ export(mapPanelServer)
 export(mapPanelUI)
 export(startApplication)
 import(shiny)
+importFrom(DataTools,importDataServer)
+importFrom(DataTools,importDataUI)
 importFrom(magrittr,"%>%")
+importFrom(rjson,fromJSON)
 importFrom(stats,setNames)
+importFrom(yaml,read_yaml)
diff --git a/NEWS.md b/NEWS.md
@@ -0,0 +1,67 @@
+# MapR
+
+## 24.1.0
+
+### New Features
+- user can fill out questionnaires and images are displayed depending on the answers
+
+## Version 23.12.1
+
+### New Features
+- _Import from Pandora_: 
+  - display of "About" information that is associated to a selected Pandora Repository
+
+## 23.11.0
+
+### New Features
+- option to add and format a plot title.
+
+## Version: 23.10.1
+
+### New Features
+- option to upload zip files via the import module from `DataTools`. Enables access to files from
+  URL, Pandora Platform, local files, and online examples
+  - Example data is taken from: 
+    ```R
+#> Documentation for the Beyer2020 dataset
+#> 
+#> Description:
+#> 
+#>      This dataset covers the last 120k years, at intervals of 1/2 k
+#>      years, and a resolution of 0.5 degrees in latitude and longitude.
+#> 
+#> Details:
+#> 
+#>      If you use this dataset, make sure to cite the original
+#>      publication:
+#> 
+#>      Beyer, R.M., Krapp, M. & Manica, A. High-resolution terrestrial
+#>      climate, bioclimate and vegetation for the last 120,000 years. Sci
+#>      Data 7, 236 (2020). doi:doi.org/10.1038/s41597-020-0552-1
+#>      <https://doi.org/doi.org/10.1038/s41597-020-0552-1>
+#> 
+#>      The version included in 'pastclim' has the ice sheets masked, as
+#>      well as internal seas (Black and Caspian Sea) removed. The latter
+#>      are based on:
+#> 
+#>      <https://www.marineregions.org/gazetteer.php?p=details&id=4278>
+#> 
+#>      <https://www.marineregions.org/gazetteer.php?p=details&id=4282>
+#> 
+#>      As there is no reconstruction of their depth through time, modern
+#>      outlines were used for all time steps.
+#> 
+#>      Also, for bio15, the coefficient of variation was computed after
+#>      adding one to monthly estimates, and it was multiplied by 100
+#>      following <https://pubs.usgs.gov/ds/691/ds691.pdf>
+#> 
+#>      Changelog
+#> 
+#>      v1.1.0 Added monthly variables. Files can be downloaded from:
+#>      <https://zenodo.org/deposit/7062281>
+#> 
+#>      v1.0.0 Remove ice sheets and internal seas, and use correct
+#>      formula for bio15. Files can be downloaded from:
+#>      doi:doi.org/10.6084/m9.figshare.19723405.v1
+#>      <https://doi.org/doi.org/10.6084/m9.figshare.19723405.v1>
+```
diff --git a/R/00-Namespace.R b/R/00-Namespace.R
@@ -13,6 +13,8 @@
 #' @return The result of calling `rhs(lhs)`.
 
 #' @rawNamespace import(shiny)
+#' @importFrom rjson fromJSON
+#' @importFrom DataTools importDataUI importDataServer
+#' @importFrom yaml read_yaml
 
-utils::globalVariables(c("image_list"))
 NULL
diff --git a/R/00-config.R b/R/00-config.R
@@ -0,0 +1,7 @@
+#' Config
+#'
+#' @return (list) configuration parameters for import of data and models
+config <- function() {
+  config_path <- system.file("config.yaml", package = "MapR")
+  read_yaml(config_path)
+}
diff --git a/R/01-mapPanelModule.R b/R/01-mapPanelModule.R
@@ -9,64 +9,36 @@ mapPanelUI <- function(id) {
   sidebarLayout(
     sidebarPanel(
       width = 2,
-      selectizeInputUI(
-        id = ns("group_name"),
-        label = "Group Name",
-        choices = unique(image_list$Group_name),
-        selected = NULL
-      ),
-      selectizeInputUI(
-        id = ns("variable"),
-        label = "Variable",
-        choices = NULL
-      ),
-      selectizeInputUI(
-        id = ns("measure"),
-        label = "Measure",
-        choices = NULL
-      ),
+      importDataUI(ns("file_import"), label = "Import ZIP file"),
+      createVariableSelectionInputs(id),
       br(),
-      column(12,
-        align = "center",
-        radioButtonsUI(
-          id = ns("time_switch"),
-          choices = setNames(
-            c(1, 2),
-            c(
-              "Single Map",
-              "Time plot"
+      fluidRow(
+        column(12,
+          align = "center",
+          shinyjs::hidden(
+            actionButtonUI(
+              id = ns("display_plot"),
+              label = "Display plot"
             )
           )
         )
       ),
-      # slider years are currently hardcoded and will be replaced later
-      sliderInputUI(
-        id = ns("time"),
-        label = "Time",
-        value = 2015
-      ),
-      # note: it is not possible to update a single value slider to range slider
-      # therefore we create two different sliders and toggle them based on the time_switch selection
-      shinyjs::hidden(
-        sliderInputUI(
-          id = ns("time_range"),
-          label = "Time",
-          value = c(2015, 2017)
+      textFormatUI(ns("title"), label = "Title"),
+    ),
+    mainPanel(
+      width = 10,
+      fluidRow(
+        column(12,
+          align = "center",
+          uiOutput(outputId = ns("plot_title"))
         )
       ),
-      br(),
       fluidRow(
         column(12,
           align = "center",
-          actionButtonUI(
-            id = ns("display_plot"),
-            label = "Display plot"
-          )
+          plotUI(id = ns("mainplot"))
         )
       )
-    ),
-    mainPanel(
-      tags$h3("map placeholder")
     )
   )
 }
@@ -80,79 +52,63 @@ mapPanelServer <- function(id) {
   moduleServer(
     id,
     function(input, output, session) {
-      # fill variable input
-      observe({
-        if (!is.null(input[["group_name-selectize"]])) {
-          choices <- image_list$Variable[image_list$Group_name == input[["group_name-selectize"]]]
-        } else {
-          choices <- ""
-        }
-        updateSelectizeInput(
-          session = session,
-          inputId = "variable-selectize",
-          choices = choices,
-          selected = ""
-        )
-      }) %>%
-        bindEvent(input[["group_name-selectize"]],
-          ignoreNULL = FALSE,
-          ignoreInit = TRUE
-        )
+      image_list <- reactiveVal()
+      questionnaire <- reactiveVal()
 
-      # fill measure input
-      observe({
-        if (!is.null(input[["variable-selectize"]])) {
-          choices <- image_list$Measure[image_list$Group_name == input[["group_name-selectize"]] &
-            image_list$Variable == input[["variable-selectize"]]]
-        } else {
-          choices <- ""
-        }
-        updateSelectizeInput(
-          session = session,
-          inputId = "measure-selectize",
-          choices = choices,
-          selected = ""
-        )
-      }) %>%
-        bindEvent(input[["variable-selectize"]],
-          ignoreNULL = FALSE,
-          ignoreInit = TRUE
-        )
+      # Load zip file
+      uploadedZip <- importDataServer("file_import",
+        importType = "zip",
+        defaultSource = config()[["defaultSource"]],
+        ckanFileTypes = config()[["ckanFileTypes"]],
+        fileExtension = config()[["fileExtension"]],
+        mainFolder = config()[["mainFolder"]],
+        rPackageName = config()[["rPackageName"]]
+        # expectedFileInZip = config()[["expectedFileInZip"]] # currently image list is not required if a questionnaire.json is included
+      )
 
-      # update slider
-      observe({
-        if (input[["time_switch-buttons"]] == 1) {
-          shinyjs::hide(id = "time_range-slider")
-          shinyjs::show(
-            id = "time-slider",
-            anim = TRUE,
-            animType = "fade",
-            time = 1
-          )
-        } else {
-          shinyjs::hide(id = "time-slider")
-          shinyjs::show(
-            id = "time_range-slider",
-            anim = TRUE,
-            animType = "fade",
-            time = 1
-          )
-        }
+      # Show and hide inputs depending on image_list or questionnaire being available
+      observeShowAndHideInputs(
+        input = input,
+        output = output,
+        session = session,
+        uploadedZip = uploadedZip,
+        image_list = image_list,
+        questionnaire = questionnaire,
+        id = id
+      )
+
+      # Fill inputs based on uploaded image list (if image list is available)
+      fillVariableSelectionInputs(input, session, image_list)
+
+      # Enable / disable actionButton
+      observeEnableActionButton(input, image_list, questionnaire)
+
+      # Show plot and plot formatting options when button is clicked
+      observeShowPlot(
+        input = input,
+        output = output,
+        session = session,
+        image_list = image_list,
+        questionnaire = questionnaire
+      )
+
+      # Plot Title
+      output$plot_title <- renderUI({
+        text <- input[["title-text"]]
+        col <- input[["title-color"]]
+        fontsize <- paste0(input[["title-fontsize"]], "px")
+        style <- paste("font-size: ", fontsize, ";", "color: ", col, ";", sep = "")
+        HTML(paste("<span style='", style, "'>", text, "</span>"))
       }) %>%
-        bindEvent(input[["time_switch-buttons"]],
+        bindEvent(
+          c(
+            input[["display_plot-button"]],
+            input[["title-text"]],
+            input[["title-fontsize"]],
+            input[["title-color"]]
+          ),
           ignoreInit = TRUE
         )
-
-      # enable / disable actionButton
-      observe({
-        if (!is.null(input[["group_name-selectize"]]) &&
-          !is.null(input[["variable-selectize"]]) &&
-          !is.null(input[["measure-selectize"]])) {
-          shinyjs::enable(id = "display_plot-button")
-        } else {
-          shinyjs::disable(id = "display_plot-button")
-        }
-      })
     }
   )
 }
diff --git a/R/02-actionButtonModule.R b/R/02-actionButtonModule.R
@@ -5,9 +5,9 @@
 #' @param ... further arguments passed to input
 actionButtonUI <- function(id, label, ...) {
   ns <- NS(id)
-  shinyjs::disabled(actionButton(
+  actionButton(
     inputId = ns("button"),
     label = label,
     ...
-  ))
+  )
 }