Merge branch 'develop'

NERC-CEH · Mar 2, 2024 · 472049e · 472049e
2 parents b0581da + 8caf686
commit 472049e
Show file tree

Hide file tree

Showing 240 changed files with 2,723 additions and 154,655 deletions.
diff --git a/Dockerfile b/Dockerfile
@@ -2,19 +2,12 @@
 FROM rocker/shiny:latest
 
 # Install linux packages
-# This needs revising if pseudoMAVIS does not need spatial libraries
 RUN apt-get update -qq && apt-get -y --no-install-recommends install \
     libssl-dev \
     libxml2-dev \
     libudunits2-dev \
     libharfbuzz-dev \
-    libfribidi-dev \
-    libgdal-dev \
-    gdal-bin \
-    libproj-dev \
-    proj-data \
-    proj-bin \
-    libgeos-dev
+    libfribidi-dev
 
 # Update linux packages
 RUN apt-get update && \
@@ -28,6 +21,8 @@ COPY /data /data
 COPY /R /R
 COPY /www /www
 COPY /renv.lock /renv.lock
+COPY /docs /docs
+COPY /report /report
 
 # Install renv & restore packages
 RUN Rscript -e 'install.packages("renv")'

diff --git a/R/create_constants.R b/R/create_constants.R
@@ -107,11 +107,11 @@ matchSpecies_options <- c("No" = "No",
 
 
 # Results to View NVC Assignment ------------------------------------------
-resultsViewNVCAssign_options <- c("Site, Pseudo-quadrat" = "nvcAssignSitePseudo",
-                                  "Group, Pseudo-quadrat" = "nvcAssignGroupPseudo",
-                                  "Quadrat, Pseudo-quadrat" = "nvcAssignQuadratPseudo",
+resultsViewNVCAssign_options <- c(#"Site, Jaccard" = "nvcAssignSiteJaccard",
+                                  #"Group, Jaccard" = "nvcAssignGroupJaccard",
                                   "Site, Czekanowski" = "nvcAssignSiteCzekanowski",
-                                  "Group, Czekanowski" = "nvcAssignGroupCzekanowski"#,
+                                  "Group, Czekanowski" = "nvcAssignGroupCzekanowski",
+                                  "Quadrat, Jaccard" = "nvcAssignQuadratJaccard"#,
                                   # "Quadrat, Czekanowski" = "nvcAssignQuadratCzekanowski"
                                   )
 
@@ -144,6 +144,7 @@ dcaAxisSelection_options <- c("DCA1 vs DCA2" = "dca1dca2",
 dcaVars_options <- c("Survey Quadrats" = "surveyQuadrats",
                      "Pseudo-Quadrats" = "pseudoQuadrats",
                      "Reference Space" = "referenceSpace",
+                     "Reference Centroids" = "referenceCentroids",
                      "Species" = "species",
                      "Unique Survey Species" = "uniqSurveySpecies",
                      "Hill-Ellenberg" = "hillEllenberg",
@@ -181,7 +182,7 @@ ccaVars_options <- c("Moisture (F) x Nitrogen (N)" = "FN",
 
 
 # Global Reference DCA Space Options --------------------------------------
-nationalReferenceSpaces_options <- sort(c(c("A", "CG", "H", "M", "MC", "MG", "OV", "S", "SD", "SM", "U", "W"), setdiff(readRDS(file = "./data/bundled_data/nvc_community_codes.rds"), c("SM1", "SM1a", "SM1b"))))
+nationalReferenceSpaces_options <- sort(c(c("A", "CG", "H", "M", "MC", "MG", "OV", "S", "SD", "SM", "U", "W"), setdiff(readRDS(file = "./data/nvc_community_codes.rds"), c("SM1", "SM1a", "SM1b"))))
 
 
 # DCA Survey Quadrat Options ----------------------------------------------
@@ -197,12 +198,18 @@ selectSurveyQuadrats_options <- c()
 selectSurveyGroups_options <- c()
 
 
+# Group Survey Plots Options ----------------------------------------------
+groupSurveyPlots_options <- c("No" = "no",
+                              "Group" = "group",
+                              "Year" = "year")
+
 # Report Options ----------------------------------------------------------
-reportOptions_options <- list(`NVC Assignment Pseudo-quadrat` = c("Site" = "nvcAssignmentResultsSite",
-                                                                  "Group" = "nvcAssignmentResultsGroup",
-                                                                  "Quadrat" = "nvcAssignmentResultsQuadrat"),
-                              `NVC Assignment Czekanowski` = c("Site" = "nvcAssignmentResultsSite_Czekanowski",
-                                                               "Group" = "nvcAssignmentResultsGroup_Czekanowski"),
+reportOptions_options <- list(#`NVC Assignment Pseudo-quadrat` = c("Site" = "nvcAssignmentResultsSite",
+                              #                                    "Group" = "nvcAssignmentResultsGroup",
+                              #                                    "Quadrat, Jaccard" = "nvcAssignmentResultsQuadrat_Jaccard"),
+                              `NVC Assignment` = c("Site, Czekanowski" = "nvcAssignmentResultsSite_Czekanowski",
+                                                   "Group, Czekanowski" = "nvcAssignmentResultsGroup_Czekanowski",
+                                                   "Quadrat, Jaccard" = "nvcAssignmentResultsQuadrat_Jaccard"),
                               `Floristic Tables` = c("Site" = "composedFloristicTablesSite",
                                                      "Group" = "composedFloristicTablesGroup"),
                               `Species Frequency` = c("Species Frequency" = "speciesFrequencyTable"),

diff --git a/R/load_data.R b/R/load_data.R
@@ -1,47 +1,56 @@
 # Example data ------------------------------------------------------------
-example_data_all <- readRDS(file = "./data/bundled_data/example_data_all.rds")
+example_data_all <- readRDS(file = "./data/example_data_all.rds")
 
 # NVC floristic tables and community codes --------------------------------
-nvc_floristic_tables <- readRDS(file = "./data/bundled_data/nvc_floristic_tables.rds")
-nvc_floristic_tables_numeric <- readRDS(file = "./data/bundled_data/nvc_floristic_tables_numeric.rds")
-nvc_community_codes <- readRDS(file = "./data/bundled_data/nvc_community_codes.rds")
-nvc_community_namesCodes <- readRDS("./data/bundled_data/nvc_community_namesCodes.rds")
+nvc_floristic_tables <- readRDS(file = "./data/nvc_floristic_tables.rds")
+nvc_floristic_tables_numeric <- readRDS(file = "./data/nvc_floristic_tables_numeric.rds")
+nvc_community_codes <- readRDS(file = "./data/nvc_community_codes.rds")
+nvc_community_namesCodes <- readRDS("./data/nvc_community_namesCodes.rds")
 
 
 # Habitat Correspondence --------------------------------------------------
-all_habCor_final <- readRDS(file = "./data/bundled_data/all_habCor_final.rds")
-all_habCor_classifications <- readRDS(file = "./data/bundled_data/all_habCor_classifications.rds")
+all_habCor_final <- readRDS(file = "./data/all_habCor_final.rds")
+all_habCor_classifications <- readRDS(file = "./data/all_habCor_classifications.rds")
 
 
 # Master data -------------------------------------------------------------
-master_data <- readRDS(file = "./data/bundled_data/master_data.rds")
+master_data <- readRDS(file = "./data/master_data.rds")
 
 
 # NVC Pseudo-quadrat data -------------------------------------------------
-nvc_pquads_final <- readRDS(file = "./data/bundled_data/nvc_pquads_final.rds")
+nvc_pquads_final <- readRDS(file = "./data/nvc_pquads_final.rds")
+nvc_pquads_final_wide <- readRDS(file = "./data/nvc_pquads_final_wide.rds")
 
 
+# Accepted Species data ---------------------------------------------------
+# Supplied to the user via download button
+acceptedSpecies <- readRDS(file = "./data/acceptedSpecies.rds")
+
 # Species names -----------------------------------------------------------
-speciesNames <- readRDS(file = "./data/bundled_data/speciesNames.rds")
+speciesNames <- readRDS(file = "./data/speciesNames.rds")
 
 
 # Concordance data --------------------------------------------------------
-concordance_all <- readRDS(file = "./data/bundled_data/concordance_all.rds")
-
-
-# Accepted Species data ---------------------------------------------------
-acceptedSpecies <- readRDS(file = "./data/bundled_data/acceptedSpecies.rds")
-
+concordance_all <- readRDS(file = "./data/concordance_all.rds")
+concordance_plants <- readRDS(file = "./data/concordance_plants.rds")
+concordance_bryophytes <- readRDS(file = "./data/concordance_bryophytes.rds")
 
 # Pseudo-quadrat DCA scores -----------------------------------------------
-nvc_pquads_final_wide <- readRDS(file = "./data/bundled_data/nvc_pquads_final_wide.rds")
-nvc_pquad_dca_all <- readRDS(file = "./data/bundled_data/nvc_pquad_dca_all.rds")
+nvc_pquad_dca_all <- readRDS(file = "./data/nvc_pquad_dca_all.rds")
+nvc_pquad_dca_noBryophytes <- readRDS(file = "./data/nvc_pquad_dca_noBryophytes.rds")
 
 
 # Pseudo-quadrat hulls ----------------------------------------------------
-nvc_pquad_dca_all_hulls <- readRDS(file = "./data/bundled_data/nvc_pquad_dca_all_hulls.rds")
+nvc_pquad_dca_all_hulls <- readRDS(file = "./data/nvc_pquad_dca_all_hulls.rds")
+nvc_pquad_dca_noBryophytes_hulls <- readRDS(file = "./data/nvc_pquad_dca_noBryophytes_hulls.rds")
+
+
+# Pseudo-quadrat centroids ------------------------------------------------
+nvc_pquad_dca_all_centroids <- readRDS(file = "./data/nvc_pquad_dca_all_centroids.rds")
+nvc_pquad_dca_noBryophytes_centroids <- readRDS(file = "./data/nvc_pquad_dca_noBryophytes_centroids.rds")
 
 
 # Pseudo-quadrat mean unweighted EIVs -------------------------------------
-nvc_pquads_mean_unweighted_eivs <- readRDS(file = "./data/bundled_data/nvc_pquads_mean_unweighted_eivs.rds")
+nvc_pquads_mean_unweighted_eivs <- readRDS(file = "./data/nvc_pquads_mean_unweighted_eivs.rds")
+nvc_pquads_mean_unweighted_eivs_noBryophytes <- readRDS(file = "./data/nvc_pquads_mean_unweighted_eivs_noBryophytes.rds")
 
diff --git a/R/load_packages.R b/R/load_packages.R
@@ -0,0 +1,21 @@
+# Shiny-related
+library(shiny)
+library(rhandsontable)
+library(reactable)
+library(bslib)
+library(shinyWidgets)
+library(shinyjs)
+library(shinybusy)
+
+# General
+library(rmarkdown)
+library(bookdown)
+library(tidyverse)
+library(plotly)
+library(kableExtra)
+library(checkmate)
+library(janitor)
+
+# Ecology
+library(assignNVC)
+library(vegan)
diff --git a/R/similarity_functions.R b/R/similarity_functions.R
@@ -12,6 +12,8 @@
 #' @param samp_group_name 
 #' @param comp_group_name 
 #' @param samp_weight_name 
+#' @param downweight_threshold If 0 no downeighting occurs.
+#' @param downweight_value
 #'
 #' @return
 #' @export
@@ -20,7 +22,17 @@
 similarityCzekanowski <- function(samp_df, comp_df, 
                                   samp_species_col, comp_species_col, 
                                   samp_group_name, comp_group_name,
-                                  samp_weight_name, comp_weight_name){
+                                  samp_weight_name, comp_weight_name,
+                                  downweight_threshold = 0.2, downweight_value = 0.1){
+
+  assign(x = "samp_df", value = samp_df, envir = .GlobalEnv)
+  assign(x = "comp_df", value = comp_df, envir = .GlobalEnv)
+  assign(x = "samp_species_col", value = samp_species_col, envir = .GlobalEnv)
+  assign(x = "comp_species_col", value = comp_species_col, envir = .GlobalEnv)
+  assign(x = "samp_group_name", value = samp_group_name, envir = .GlobalEnv)
+  assign(x = "comp_group_name", value = comp_group_name, envir = .GlobalEnv)
+  assign(x = "samp_weight_name", value = samp_weight_name, envir = .GlobalEnv)
+  assign(x = "comp_weight_name", value = comp_weight_name, envir = .GlobalEnv)
 
   # Check argument types are correct
   checkmate::assertDataFrame(samp_df)
@@ -31,6 +43,8 @@ similarityCzekanowski <- function(samp_df, comp_df,
   checkmate::assert_character(comp_group_name, any.missing = FALSE)
   checkmate::assert_character(samp_weight_name, any.missing = FALSE)
   checkmate::assert_character(comp_weight_name, any.missing = FALSE)
+  checkmate::assert_numeric(downweight_threshold)
+  checkmate::assert_numeric(downweight_value)
 
   # Split input data frames into iterable lists
   samp_df_split <- split(samp_df, samp_df[[samp_group_name]])
@@ -60,11 +74,17 @@ similarityCzekanowski <- function(samp_df, comp_df,
 
       eval_table[is.na(eval_table)] <- 0
 
-      eval_table["min"] <- apply(eval_table[c(paste0(samp_weight_name, "_samp"), paste0(comp_weight_name, "_comp"))], 1, min)
+      comp_weight_name_new <- paste0(comp_weight_name, "_comp")
+      samp_weight_name_new <- paste0(samp_weight_name, "_samp")
+
+      # Down-weight species absent in the sample data but present in the comparison data at a constancy of downweight_threshold to downweight_value
+      eval_table[[comp_weight_name_new]][eval_table[[samp_weight_name_new]] == 0 & eval_table[[comp_weight_name_new]] == downweight_threshold] <- downweight_value
+
+      eval_table["min"] <- apply(eval_table[c(samp_weight_name_new, comp_weight_name_new)], 1, min)
 
-      eval_table_sum <- colSums(eval_table[,c(paste0(samp_weight_name, "_samp"), paste0(comp_weight_name, "_comp"), "min")], na.rm = TRUE)
+      eval_table_sum <- colSums(eval_table[,c(samp_weight_name_new, comp_weight_name_new, "min")], na.rm = TRUE)
 
-      similarity <- (2 * eval_table_sum[["min"]]) / (eval_table_sum[[paste0(samp_weight_name, "_samp")]] + eval_table_sum[[paste0(comp_weight_name, "_comp")]])
+      similarity <- (2 * eval_table_sum[["min"]]) / (eval_table_sum[[samp_weight_name_new]] + eval_table_sum[[comp_weight_name_new]])
 
       similarity_list <- list(samp_group_name = samp_id, comp_group_name = comp_id, "Similarity" = similarity)
       names(similarity_list) <- c(samp_group_name , comp_group_name, "Similarity")

diff --git a/README.Rmd b/README.Rmd
@@ -2,8 +2,6 @@
 output: github_document
 ---
 
-<!-- README.md is generated from README.Rmd. Please edit that file -->
-
 ```{r, include = FALSE}
 knitr::opts_chunk$set(
   collapse = TRUE,
@@ -13,42 +11,51 @@ knitr::opts_chunk$set(
 )
 ```
 
-# pseudoMAVIS
+# RMAVIS
 
 <!-- badges: start -->
-[![Generic badge](https://img.shields.io/badge/Version-0.95-green.svg)]()
+[![Generic badge](https://img.shields.io/badge/Version-0.96-green.svg)]()
 [![Project Status: Active – The project has reached a stable, usable state and is being actively developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)
 <!-- badges: end -->
 
-The MAVIS R shiny web application is a tool for..........
+The RMAVIS R shiny web application is a tool to assist in the assignment of vegetation plot
+sample data to UK National Vegetation Classification units, with additional exploratory analysis.
 
 ## Running the app
 
-You can run pseudoMAVIS from [GitHub](https://github.com/ZekeMarshall/pseudoMAVIS) by cloning the 
+You can run RMAVIS from [GitHub](https://github.com/ZekeMarshall/RMAVIS) by cloning the 
 repository, calling `renv::restore()`, and then calling `shiny::runApp("app.R")`.
 
-Future developments may support the release of pseudoMAVIS as an R package.
+If `renv::restore()` fails run `install.packages(unique(renv::dependencies()$Package), dependencies = TRUE)`. 
+
+Future developments may support the release of RMAVIS as an R package.
 
 ## Hosting
 
-pseudoMAVIS is configured to be built with [Docker](https://www.docker.com/).
+### Posit Connect
+
+RMAVIS is currently hosted on the UKCEH Posit Connect server:
+
+### Docker
+
+RMAVIS is configured to be built with [Docker](https://www.docker.com/).
 
 To build and deploy the app on a linux server with Docker pre-installed two approaches may be taken:
 
 ### Using Docker Manually
 
-1. Build the app locally with `docker build --no-cache -t <container registry url>/pseudoMAVIS:<version> .`.
+1. Build the app locally with `docker build --no-cache -t <container registry url>/rmavis:<version> .`.
 2. Log in to the container registry with `docker login <container registry url>`, using a API key.
-3. Push the image to the container registry with `docker push <container registry url>/pseudoMAVIS:<version>`.
+3. Push the image to the container registry with `docker push <container registry url>/rmavis:<version>`.
 One of:
 4a. Log into a container registry UI through a web browser, and navigate to a console button which opens a terminal to the server.
 4b. ssh into the server from a local terminal.
 5. In the server, log in to the container registry with `docker login registry.digitalocean.com`, using a API key.
-6. Pull the image from the container registry with `docker pull <container registry url>/pseudoMAVIS:<version>`.
+6. Pull the image from the container registry with `docker pull <container registry url>/rmavis:<version>`.
 7. Check that the image has been successfully retrieved with `docker images`.
 8. Check whether there is a container currently running with `docker ps -a`.
 9. Stop and remove this instance with `docker rm -f <instance name>`.
-9. Run the Docker container in a new instance with `docker run -d -p 8001:8001 --privileged=true --name <instance name> <container registry url>/pseudoMAVIS:<version>`.
+9. Run the Docker container in a new instance with `docker run -d -p 8001:8001 --privileged=true --name <instance name> <container registry url>/rmavis:<version>`.
 
 ### Using Docker Compose
 

diff --git a/README.md b/README.md
@@ -1,59 +1,65 @@
 
-<!-- README.md is generated from README.Rmd. Please edit that file -->
-
-# pseudoMAVIS
+# RMAVIS
 
 <!-- badges: start -->
 
 [![Generic
-badge](https://img.shields.io/badge/Version-0.95-green.svg)]()
+badge](https://img.shields.io/badge/Version-0.96-green.svg)]()
 [![Project Status: Active – The project has reached a stable, usable
 state and is being actively
 developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.repostatus.org/#active)
 <!-- badges: end -->
 
-The MAVIS R shiny web application is a tool for……….
+The RMAVIS R shiny web application is a tool to assist in the assignment
+of vegetation plot sample data to UK National Vegetation Classification
+units, with additional exploratory analysis.
 
 ## Running the app
 
-You can run pseudoMAVIS from
-[GitHub](https://github.com/ZekeMarshall/pseudoMAVIS) by cloning the
-repository, calling `renv::restore()`, and then calling
+You can run RMAVIS from [GitHub](https://github.com/ZekeMarshall/RMAVIS)
+by cloning the repository, calling `renv::restore()`, and then calling
 `shiny::runApp("app.R")`.
 
-Future developments may support the release of pseudoMAVIS as an R
-package.
+If `renv::restore()` fails run
+`install.packages(unique(renv::dependencies()$Package), dependencies = TRUE)`.
+
+Future developments may support the release of RMAVIS as an R package.
 
 ## Hosting
 
-pseudoMAVIS is configured to be built with
-[Docker](https://www.docker.com/).
+### Posit Connect
+
+RMAVIS is currently hosted on the UKCEH Posit Connect server:
+
+### Docker
+
+RMAVIS is configured to be built with [Docker](https://www.docker.com/).
 
 To build and deploy the app on a linux server with Docker pre-installed
 two approaches may be taken:
 
 ### Using Docker Manually
 
 1.  Build the app locally with
-    `docker build --no-cache -t <container registry url>/pseudoMAVIS:<version> .`.
+    `docker build --no-cache -t <container registry url>/rmavis:<version> .`.
 2.  Log in to the container registry with
     `docker login <container registry url>`, using a API key.
 3.  Push the image to the container registry with
-    `docker push <container registry url>/pseudoMAVIS:<version>`. One
-    of: 4a. Log into a container registry UI through a web browser, and
-    navigate to a console button which opens a terminal to the server.
-    4b. ssh into the server from a local terminal.
+    `docker push <container registry url>/rmavis:<version>`. One of: 4a.
+    Log into a container registry UI through a web browser, and navigate
+    to a console button which opens a terminal to the server. 4b. ssh
+    into the server from a local terminal.
 4.  In the server, log in to the container registry with
     `docker login registry.digitalocean.com`, using a API key.
 5.  Pull the image from the container registry with
-    `docker pull <container registry url>/pseudoMAVIS:<version>`.
+    `docker pull <container registry url>/rmavis:<version>`.
 6.  Check that the image has been successfully retrieved with
     `docker images`.
 7.  Check whether there is a container currently running with
     `docker ps -a`.
 8.  Stop and remove this instance with `docker rm -f <instance name>`.
 9.  Run the Docker container in a new instance with
-    `docker run -d -p 8001:8001 --privileged=true --name <instance name> <container registry url>/pseudoMAVIS:<version>`.
+    `docker run -d -p 8001:8001 --privileged=true --name <instance name> <container registry url>/rmavis:<version>`.
 
 ### Using Docker Compose
 

diff --git a/pseudoMAVIS.Rproj → RMAVIS.Rproj b/pseudoMAVIS.Rproj → RMAVIS.Rproj