From 1a7398e60f4c9838746b498f9c2d670c48acd03b Mon Sep 17 00:00:00 2001 From: ZekeMarshall Date: Mon, 4 Mar 2024 09:41:52 +0000 Subject: [PATCH 1/3] Removing surveyDataWide module --- R/create_constants.R | 4 +- R/functions.R | 10 +- R/load_packages.R | 1 + R/similarity_functions.R | 9 - R/syntopicTable_functions.R | 6 +- app.R | 22 +- docs/documentation.Rmd | 4 +- docs/documentation.html | 2 +- modules/calcAvgEIVs_server.R | 11 +- modules/diversityAnalysis_server.R | 28 +-- modules/floristicTables_server.R | 23 +- modules/mvaLocalRefRestricted_server.R | 10 +- modules/mvaLocalRefUnrestricted_server.R | 48 ++-- modules/mvaNationalRef_server.R | 10 +- modules/nvcAssignment_server.R | 97 ++++---- modules/nvcAssignment_ui.R | 4 +- modules/report_server.R | 12 +- modules/server.R | 72 +++--- modules/setupData_server.R | 20 +- modules/sidebar_server.R | 28 +-- modules/sidebar_ui.R | 6 +- modules/speciesFreq_server.R | 18 +- ...ry_server.R => surveyDataSummary_server.R} | 56 ++--- ...bleSummary_ui.R => surveyDataSummary_ui.R} | 2 +- ..._server.R => surveyDataValidator_server.R} | 225 +++++++++--------- ...alidator_ui.R => surveyDataValidator_ui.R} | 6 +- ...rveyTable_server.R => surveyData_server.R} | 202 ++++++++++------ modules/{surveyTable_ui.R => surveyData_ui.R} | 4 +- modules/surveyTableWide_server.R | 70 ------ modules/surveyTableWide_ui.R | 15 -- modules/ui.R | 4 +- modules/uploadData_server.R | 2 - report/Report.Rmd | 32 +-- www/documentation.html | 2 +- www/style.css | 2 +- 35 files changed, 519 insertions(+), 548 deletions(-) rename modules/{surveyTableSummary_server.R => surveyDataSummary_server.R} (92%) rename modules/{surveyTableSummary_ui.R => surveyDataSummary_ui.R} (98%) rename modules/{surveyTableValidator_server.R => surveyDataValidator_server.R} (71%) rename modules/{surveyTableValidator_ui.R => surveyDataValidator_ui.R} (98%) rename modules/{surveyTable_server.R => surveyData_server.R} (60%) rename modules/{surveyTable_ui.R => surveyData_ui.R} (88%) delete mode 100644 modules/surveyTableWide_server.R delete mode 100644 modules/surveyTableWide_ui.R diff --git a/R/create_constants.R b/R/create_constants.R index 6b05a95..f331f7c 100644 --- a/R/create_constants.R +++ b/R/create_constants.R @@ -111,7 +111,7 @@ resultsViewNVCAssign_options <- c(#"Site, Jaccard" = "nvcAssignSiteJaccard", #"Group, Jaccard" = "nvcAssignGroupJaccard", "Site, Czekanowski" = "nvcAssignSiteCzekanowski", "Group, Czekanowski" = "nvcAssignGroupCzekanowski", - "Quadrat, Jaccard" = "nvcAssignQuadratJaccard"#, + "Quadrat, Jaccard" = "nvcAssignPlotJaccard"#, # "Quadrat, Czekanowski" = "nvcAssignQuadratCzekanowski" ) @@ -227,6 +227,6 @@ reportOptions_options <- list(#`NVC Assignment Pseudo-quadrat` = c("Site" = "nvc `MVA` = c("National" = "mvaNationalReference", "Local (restricted)" = "mvaLocalReferenceRestricted", "Local (unrestricted)" = "mvaLocalReferenceUnrestricted"), - `Survey Table` = c("Survey Table" = "surveyTable") + `Survey Table` = c("Survey Table" = "surveyData") ) diff --git a/R/functions.R b/R/functions.R index f7a8199..8bc9e16 100644 --- a/R/functions.R +++ b/R/functions.R @@ -1,8 +1,8 @@ # Base R or tidyverse? -# Convert surveyTable to surveyTableWide +# Convert surveyData to surveyDataWide -# Calculate DCA using surveyTableWide and selected nvc_pquad_dca_list DCA results +# Calculate DCA using surveyDataWide and selected nvc_pquad_dca_list DCA results # Produce a DCA plot ggplot2 graph with points only @@ -10,10 +10,10 @@ # Produce a DCA plot ggplot2 graph with sample quadrat points and convex hulls -# Calculate diversity metrics using surveyTable +# Calculate diversity metrics using surveyData -# Calculate mean cover-weighted EIVs using surveyTable +# Calculate mean cover-weighted EIVs using surveyData -# Calculate mean EIVs using surveyTable +# Calculate mean EIVs using surveyData \ No newline at end of file diff --git a/R/load_packages.R b/R/load_packages.R index 71e66dc..f8d80e0 100644 --- a/R/load_packages.R +++ b/R/load_packages.R @@ -8,6 +8,7 @@ library(shinyjs) library(shinybusy) # General +library(R6) library(rmarkdown) library(bookdown) library(tidyverse) diff --git a/R/similarity_functions.R b/R/similarity_functions.R index a370675..5e961bc 100644 --- a/R/similarity_functions.R +++ b/R/similarity_functions.R @@ -25,15 +25,6 @@ similarityCzekanowski <- function(samp_df, comp_df, 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) checkmate::assertDataFrame(comp_df) diff --git a/R/syntopicTable_functions.R b/R/syntopicTable_functions.R index 7a2a5b2..6fb72dd 100644 --- a/R/syntopicTable_functions.R +++ b/R/syntopicTable_functions.R @@ -1,7 +1,7 @@ -# Compose floristic tables from surveyTable -composeSyntopicTables <- function(surveyTable, group_cols, species_col_name = "Species", plot_col_name = "Quadrat"){ +# Compose floristic tables from surveyData +composeSyntopicTables <- function(surveyData, group_cols, species_col_name = "Species", plot_col_name = "Quadrat"){ - syntopicTables <- surveyTable |> + syntopicTables <- surveyData |> tidyr::unite(col = "ID", group_cols, sep = " - ", remove = TRUE) |> dplyr::select(ID, plot_col_name, species_col_name) |> dplyr::mutate("Present" = 1) |> diff --git a/app.R b/app.R index 7803c5b..0a4b478 100644 --- a/app.R +++ b/app.R @@ -11,7 +11,8 @@ source("R/load_data.R", local = TRUE) source("R/create_constants.R", local = TRUE) # Render documentation ---------------------------------------------------- -source("R/render_docs.R", local = TRUE) # This can be disabled if one wishes to pre-render the documentation manually. +# This can be disabled if one wishes to pre-render the documentation manually. +source("R/render_docs.R", local = TRUE) # Source functions -------------------------------------------------------- source("R/syntopicTable_functions.R", local = TRUE) @@ -34,17 +35,17 @@ source("modules/setupData_server.R", local = TRUE) source("modules/uploadData_ui.R", local = TRUE) source("modules/uploadData_server.R", local = TRUE) -source("modules/surveyTable_ui.R", local = TRUE) -source("modules/surveyTable_server.R", local = TRUE) +source("modules/surveyData_ui.R", local = TRUE) +source("modules/surveyData_server.R", local = TRUE) -source("modules/surveyTableValidator_ui.R", local = TRUE) -source("modules/surveyTableValidator_server.R", local = TRUE) +source("modules/surveyDataValidator_ui.R", local = TRUE) +source("modules/surveyDataValidator_server.R", local = TRUE) -source("modules/surveyTableSummary_ui.R", local = TRUE) -source("modules/surveyTableSummary_server.R", local = TRUE) +source("modules/surveyDataSummary_ui.R", local = TRUE) +source("modules/surveyDataSummary_server.R", local = TRUE) -source("modules/surveyTableWide_ui.R", local = TRUE) -source("modules/surveyTableWide_server.R", local = TRUE) +source("modules/floristicTables_ui.R", local = TRUE) +source("modules/floristicTables_server.R", local = TRUE) # source("modules/selectedPquads_server.R", local = TRUE) @@ -54,9 +55,6 @@ source("modules/nvcAssignment_server.R", local = TRUE) source("modules/habCor_ui.R", local = TRUE) source("modules/habCor_server.R", local = TRUE) -source("modules/floristicTables_ui.R", local = TRUE) -source("modules/floristicTables_server.R", local = TRUE) - source("modules/speciesFreq_ui.R", local = TRUE) source("modules/speciesFreq_server.R", local = TRUE) diff --git a/docs/documentation.Rmd b/docs/documentation.Rmd index 0212a4f..caa8fd5 100644 --- a/docs/documentation.Rmd +++ b/docs/documentation.Rmd @@ -81,7 +81,7 @@ reportOptions_options <- list(`NVC Assignment` = c("Site, Czekanowski" = "nvcAss `MVA` = c("National" = "mvaNationalReference", "Local (restricted)" = "mvaLocalReferenceRestricted", "Local (unrestricted)" = "mvaLocalReferenceUnrestricted"), - `Survey Table` = c("Survey Table" = "surveyTable") + `Survey Table` = c("Survey Table" = "surveyData") ) ``` @@ -678,7 +678,7 @@ Marshall, Z., Smart, S., and Harrower, C.. (2024). RMAVIS. - Making survey data availability table searchable. - Changing nomenclature for releve to plot. - Fixes: - - Ensuring report renders correctly using new surveyTableSummary + - Ensuring report renders correctly using new surveyDataSummary object data. - New Features: NA diff --git a/docs/documentation.html b/docs/documentation.html index 5cc8921..17174fe 100644 --- a/docs/documentation.html +++ b/docs/documentation.html @@ -970,7 +970,7 @@

5 Release Log

  • Fixes:
  • New Features: NA
    • diff --git a/modules/calcAvgEIVs_server.R b/modules/calcAvgEIVs_server.R index 7271226..8bbcab2 100644 --- a/modules/calcAvgEIVs_server.R +++ b/modules/calcAvgEIVs_server.R @@ -1,4 +1,4 @@ -calcAvgEIVs <- function(input, output, session, surveyTable, sidebar_options) { +calcAvgEIVs <- function(input, output, session, surveyData, sidebar_options) { ns <- session$ns @@ -268,7 +268,7 @@ calcAvgEIVs <- function(input, output, session, surveyTable, sidebar_options) { observe({ - shiny::req(surveyTable()) + shiny::req(surveyData()) shinybusy::show_modal_spinner( spin = "fading-circle", @@ -279,13 +279,14 @@ calcAvgEIVs <- function(input, output, session, surveyTable, sidebar_options) { # Isolate reactive objects shiny::isolate({ - surveyTable <- surveyTable() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long # Calculate Weighted Mean HE Values --------------------------------------- # By Quadrat - weightedMeanHEValuesQuadrat <- surveyTable |> + weightedMeanHEValuesQuadrat <- surveyData_long |> dplyr::rename("species" = "Species") |> dplyr::left_join(master_data, by = "species", relationship = "many-to-many") |> @@ -340,7 +341,7 @@ calcAvgEIVs <- function(input, output, session, surveyTable, sidebar_options) { # Calculate Unweighted Mean HE Values ------------------------------------- # By Quadrat - unweightedMeanHEValuesQuadrat <- surveyTable |> + unweightedMeanHEValuesQuadrat <- surveyData_long |> dplyr::rename("species" = "Species") |> dplyr::left_join(master_data, by = "species", relationship = "many-to-many") |> diff --git a/modules/diversityAnalysis_server.R b/modules/diversityAnalysis_server.R index b454363..80108a5 100644 --- a/modules/diversityAnalysis_server.R +++ b/modules/diversityAnalysis_server.R @@ -1,4 +1,4 @@ -diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWide, sidebar_options) { +diversityAnalysis <- function(input, output, session, surveyData, sidebar_options) { ns <- session$ns @@ -269,18 +269,18 @@ diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWi text = "Calculating Diversity Metrics" ) - shiny::req(surveyTable()) - shiny::req(surveyTableWide()) + shiny::req(surveyData()) - surveyTable <- surveyTable() - surveyTableWide <- surveyTableWide() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long + surveyData_mat <- surveyData$surveyData_mat isolate({ # Species Richness -------------------------------------------------------- # Species Richness - Quadrat - speciesRichness_quadrat <- surveyTable |> + speciesRichness_quadrat <- surveyData_long |> dplyr::group_by(Year, Group, Quadrat) |> dplyr::summarise("Richness" = dplyr::n_distinct(Species)) |> dplyr::ungroup() @@ -295,7 +295,7 @@ diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWi # Species Richness - Group - speciesRichness_group <- surveyTable |> + speciesRichness_group <- surveyData_long |> dplyr::group_by(Year, Group) |> dplyr::summarise("Richness" = dplyr::n_distinct(Species)) |> dplyr::ungroup() @@ -309,7 +309,7 @@ diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWi tidyr::unite(col = "ID", c(Year, Group), sep = " - ", remove = TRUE) # Species Richness - Site - speciesRichness_site <- surveyTable |> + speciesRichness_site <- surveyData_long |> dplyr::group_by(Year) |> dplyr::summarise("Richness" = dplyr::n_distinct(Species)) |> dplyr::ungroup() @@ -323,7 +323,7 @@ diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWi speciesRichness_site_long <- speciesRichness_site # Summary table concordance - surveyTable_conc <- surveyTable |> + surveyData_conc <- surveyData_long |> tidyr::unite(col = "ID", c(Year, Group, Quadrat), sep = " - ", remove = FALSE) |> dplyr::select(ID, Year, Group, Quadrat) |> dplyr::distinct() @@ -340,19 +340,19 @@ diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWi tibble::as_tibble(rownames = "Metric") # Shannon Diversity - shannonDiversity <- surveyTableWide |> + shannonDiversity <- surveyData_mat |> vegan::diversity(index = "shannon") |> tibble::as_tibble(rownames = "ID") |> dplyr::rename("Shannon.Diversity" = "value") # Simpson Diversity - simpsonDiversity <- surveyTableWide |> + simpsonDiversity <- surveyData_mat |> vegan::diversity(index = "simpson") |> tibble::as_tibble(rownames = "ID") |> dplyr::rename("Simpson.Diversity" = "value") # Inverse Simpson Diversity - inverseSimpsonDiversity <- surveyTableWide |> + inverseSimpsonDiversity <- surveyData_mat |> vegan::diversity(index = "invsimpson") |> tibble::as_tibble(rownames = "ID") |> dplyr::rename("InverseSimpson.Diversity" = "value") @@ -369,7 +369,7 @@ diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWi dplyr::mutate("Simpson.Evenness" = (InverseSimpson.Diversity / Richness), .keep = "unused") # Rényi diversities and Hill Numbers - # vegan::renyi(surveyTableWide) + # vegan::renyi(surveyDataWide) # Diversity Metrics Table diversityIndicesTable <- speciesRichness_quadrat_long |> @@ -378,7 +378,7 @@ diversityAnalysis <- function(input, output, session, surveyTable, surveyTableWi dplyr::left_join(inverseSimpsonDiversity, by = "ID") |> dplyr::left_join(shannonsEvenness, by = "ID") |> dplyr::left_join(simpsonEvenness, by = "ID") |> - dplyr::left_join(surveyTable_conc, by = "ID") |> + dplyr::left_join(surveyData_conc, by = "ID") |> dplyr::select(Year, Group, Quadrat, Richness, Shannon.Diversity, Simpson.Diversity, InverseSimpson.Diversity, Shannon.Evenness, Simpson.Evenness) diff --git a/modules/floristicTables_server.R b/modules/floristicTables_server.R index 11ff5fc..e60f607 100644 --- a/modules/floristicTables_server.R +++ b/modules/floristicTables_server.R @@ -1,4 +1,4 @@ -floristicTables <- function(input, output, session, surveyTable, surveyTableSummary, sidebar_options) { +floristicTables <- function(input, output, session, surveyData, surveyDataSummary, sidebar_options) { ns <- session$ns @@ -53,9 +53,10 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableSumm observe({ - shiny::req(surveyTable()) + shiny::req(surveyData()) - surveyTable <- surveyTable() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long floristicTables_composed_all <- data.frame("ID" = character(), "Species" = character(), @@ -63,12 +64,12 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableSumm # Create composed floristic tables across all groups ---------------------- - floristicTables_composed_year_group <- composeSyntopicTables(surveyTable = surveyTable, + floristicTables_composed_year_group <- composeSyntopicTables(surveyData = surveyData_long, group_cols = c("Year", "Group"), species_col_name = "Species", plot_col_name = "Quadrat") - floristicTables_composed_year <- composeSyntopicTables(surveyTable = surveyTable, + floristicTables_composed_year <- composeSyntopicTables(surveyData = surveyData_long, group_cols = c("Year"), species_col_name = "Species", plot_col_name = "Quadrat") @@ -76,8 +77,6 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableSumm floristicTables_composed_all <- rbind(floristicTables_composed_year, floristicTables_composed_year_group) floristicTables_composed_all_rval(floristicTables_composed_all) - - # assign(x = "floristicTables_composed_all", value = floristicTables_composed_all, envir = .GlobalEnv) }) |> bindEvent(runAnalysis(), @@ -175,10 +174,10 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableSumm observe({ - shiny::req(surveyTableSummary()) + shiny::req(surveyDataSummary()) shiny::req(composedFloristicTable()) - quadratsPerID <- surveyTableSummary()$surveyTableStructure$quadratsPerID + quadratsPerID <- surveyDataSummary()$surveyDataStructure$quadratsPerID composedFloristicTable_n <- quadratsPerID |> dplyr::filter(ID == composedFloristicTable()) |> @@ -195,7 +194,7 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableSumm composedFloristicTableTitle_rval(composedFloristicTableTitle) }) |> - bindEvent(surveyTableSummary(), + bindEvent(surveyDataSummary(), composedFloristicTable(), ignoreInit = TRUE, ignoreNULL = TRUE) @@ -330,7 +329,7 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableSumm observe({ - shiny::req(surveyTableSummary()) + shiny::req(surveyDataSummary()) shiny::req(nvcFloristicTable()) shiny::req(composedFloristicTable()) @@ -341,7 +340,7 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableSumm nvcFloristicTableTitle_rval(nvcFloristicTableTitle) }) |> - bindEvent(surveyTableSummary(), + bindEvent(surveyDataSummary(), nvcFloristicTable(), composedFloristicTable(), ignoreInit = TRUE, ignoreNULL = TRUE) diff --git a/modules/mvaLocalRefRestricted_server.R b/modules/mvaLocalRefRestricted_server.R index 3698bf3..358c7ed 100644 --- a/modules/mvaLocalRefRestricted_server.R +++ b/modules/mvaLocalRefRestricted_server.R @@ -1,4 +1,4 @@ -mvaLocalRefRestricted <- function(input, output, session, setupData, surveyTable, nvcAssignment, sidebar_options) { +mvaLocalRefRestricted <- function(input, output, session, setupData, surveyData, nvcAssignment, sidebar_options) { ns <- session$ns @@ -49,7 +49,7 @@ mvaLocalRefRestricted <- function(input, output, session, setupData, surveyTable observe({ # Require selected objects are not NULL - shiny::req(surveyTable()) + shiny::req(surveyData()) shiny::req(nvcAssignment()) # Start busy spinner @@ -66,6 +66,8 @@ mvaLocalRefRestricted <- function(input, output, session, setupData, surveyTable topNVCCommunities <- nvcAssignment$topNVCCommunities nvc_pquads_final_wide <- nvc_pquads_final_wide() nvc_pquads_mean_unweighted_eivs <- nvc_pquads_mean_unweighted_eivs() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long # Create pattern to subset matrix rows codes_regex <- c() @@ -131,8 +133,8 @@ mvaLocalRefRestricted <- function(input, output, session, setupData, surveyTable dplyr::mutate("NVC.Comm" = stringr::str_extract(string = Quadrat, pattern = ".+?(?=P)"), .before = "Quadrat") - # Calculate the surveyTable DCA results using the pseudo-quadrat species scores - dca_results_sample_site <- surveyTable() |> + # Calculate the surveyData DCA results using the pseudo-quadrat species scores + dca_results_sample_site <- surveyData_long |> tibble::as_tibble() |> dplyr::select(-Cover) |> dplyr::left_join(dca_results_pquads_species, by = "Species") |> diff --git a/modules/mvaLocalRefUnrestricted_server.R b/modules/mvaLocalRefUnrestricted_server.R index 6cceb72..d94a42c 100644 --- a/modules/mvaLocalRefUnrestricted_server.R +++ b/modules/mvaLocalRefUnrestricted_server.R @@ -1,4 +1,4 @@ -mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTableWide, nvcAssignment, avgEIVs, sidebar_options) { +mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyData, nvcAssignment, avgEIVs, sidebar_options) { ns <- session$ns @@ -48,8 +48,7 @@ mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTab mvaResults <- reactiveVal() observe({ - # shiny::req(surveyTable()) - shiny::req(surveyTableWide()) + shiny::req(surveyData()) shiny::req(nvcAssignment()) shinybusy::show_modal_spinner( @@ -58,15 +57,16 @@ mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTab text = "Performing Local Reference, Unrestricted MVA" ) - surveyTableWide <- surveyTableWide() - # Isolate processes to prevent recursion when handling reactive objects not included in bindEvent - shiny::isolate({ + # shiny::isolate({ nvcAssignment <- nvcAssignment() topNVCCommunities <- nvcAssignment$topNVCCommunities nvc_pquads_final_wide <- nvc_pquads_final_wide() nvc_pquads_mean_unweighted_eivs <- nvc_pquads_mean_unweighted_eivs() + surveyData <- surveyData() + surveyData_mat <- surveyData$surveyData_mat + avgEIVs <- avgEIVs() # Create pattern to subset matrix rows codes_regex <- c() @@ -89,13 +89,13 @@ mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTab as.data.frame() # Prepare wide survey table - surveyTableWide_prepped <- surveyTableWide |> + surveyDataWide_prepped <- surveyData_mat |> as.data.frame() |> dplyr::mutate_if(is.numeric, ~1 * (. != 0)) # Combine the pseudo-quadrats and survey data into a single matrix - nvc_pquads_final_wide_prepped_wSurveyTableWide <- nvc_pquads_final_wide_prepped |> - dplyr::bind_rows(surveyTableWide_prepped) |> + nvc_pquads_final_wide_prepped_wsurveyDataWide <- nvc_pquads_final_wide_prepped |> + dplyr::bind_rows(surveyDataWide_prepped) |> dplyr::mutate_all(~replace(., is.na(.), 0)) |> as.matrix() @@ -105,7 +105,7 @@ mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTab tibble::column_to_rownames(var = "Pid3") # Join the sample quadrat un-weighted mean Hill-Ellenberg scores - unweightedMeanHEValuesQuadrat_prepped <- avgEIVs()$unweightedMeanHEValuesQuadrat |> + unweightedMeanHEValuesQuadrat_prepped <- avgEIVs$unweightedMeanHEValuesQuadrat |> tidyr::unite(col = "ID", c(Year, Group, Quadrat), sep = " - ", remove = TRUE) |> tibble::column_to_rownames(var = "ID") |> dplyr::select("F" = "Moisture.F", @@ -118,42 +118,42 @@ mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTab unweightedMeanHEValuesQuadrat_prepped) # Perform a CCA on the selected pseudo-quadrats using selected Hill-Ellenberg scores - nvc_pquads_final_wide_prepped_wSurveyTableWide_cca <- vegan::cca(as.formula(paste0("nvc_pquads_final_wide_prepped_wSurveyTableWide ~ ", paste0(c(ccaVars_vals[[ccaVars()]]), collapse = " + "))), # nvc_pquads_final_wide_prepped_wSurveyTableWide ~ `F` + `L` + `N` - data = all_mean_unweighted_eivs_prepped, - na.action = na.exclude) + nvc_pquads_final_wide_prepped_wsurveyDataWide_cca <- vegan::cca(as.formula(paste0("nvc_pquads_final_wide_prepped_wsurveyDataWide ~ ", paste0(c(ccaVars_vals[[ccaVars()]]), collapse = " + "))), # nvc_pquads_final_wide_prepped_wsurveyDataWide ~ `F` + `L` + `N` + data = all_mean_unweighted_eivs_prepped, + na.action = na.exclude) # Extract CCA scores - nvc_pquads_final_wide_prepped_wSurveyTableWide_cca_scores <- vegan::scores(nvc_pquads_final_wide_prepped_wSurveyTableWide_cca, display = "bp") + nvc_pquads_final_wide_prepped_wsurveyDataWide_cca_scores <- vegan::scores(nvc_pquads_final_wide_prepped_wsurveyDataWide_cca, display = "bp") # Extract CCA multiplier - nvc_pquads_final_wide_prepped_wSurveyTableWide_cca_multiplier <- vegan:::ordiArrowMul(nvc_pquads_final_wide_prepped_wSurveyTableWide_cca_scores) + nvc_pquads_final_wide_prepped_wsurveyDataWide_cca_multiplier <- vegan:::ordiArrowMul(nvc_pquads_final_wide_prepped_wsurveyDataWide_cca_scores) # Create CCA arrow data - CCA_arrowData <- nvc_pquads_final_wide_prepped_wSurveyTableWide_cca_scores #* nvc_pquads_final_wide_prepped_wSurveyTableWide_cca_multiplier + CCA_arrowData <- nvc_pquads_final_wide_prepped_wsurveyDataWide_cca_scores #* nvc_pquads_final_wide_prepped_wsurveyDataWide_cca_multiplier CCA_arrowData <- CCA_arrowData |> tibble::as_tibble(rownames = NA) |> tibble::rownames_to_column(var = "Hill-Ellenberg") # Perform a DCA on the combined pseudo-quadrat and survey data - pquads_surveyTable_dca_results <- vegan::decorana(veg = nvc_pquads_final_wide_prepped_wSurveyTableWide) + pquads_surveyData_dca_results <- vegan::decorana(veg = nvc_pquads_final_wide_prepped_wsurveyDataWide) # Extract the DCA results species axis scores - dca_results_all_species <- vegan::scores(pquads_surveyTable_dca_results, tidy = TRUE) |> + dca_results_all_species <- vegan::scores(pquads_surveyData_dca_results, tidy = TRUE) |> dplyr::filter(score == "species") |> dplyr::select(-score, -weight) |> dplyr::rename("Species" = label) # Determine the unique survey species, i.e. the species present in the survey data but absent in the pseudo-quadrats uniq_survey_species <- dca_results_all_species |> - dplyr::filter(Species %in% setdiff(colnames(surveyTableWide), colnames(nvc_pquads_final_wide_prepped))) + dplyr::filter(Species %in% setdiff(colnames(surveyData_mat), colnames(nvc_pquads_final_wide_prepped))) # Extract the DCA results sample axis scores - pquads_surveyTable_dca_results_quadrats <- vegan::scores(pquads_surveyTable_dca_results, tidy = TRUE) |> + pquads_surveyData_dca_results_quadrats <- vegan::scores(pquads_surveyData_dca_results, tidy = TRUE) |> dplyr::filter(score == "sites") |> dplyr::select(-score, -weight) |> dplyr::rename("Quadrat" = label) - pquads_surveyTable_dca_results_quadrats <- pquads_surveyTable_dca_results_quadrats |> + pquads_surveyData_dca_results_quadrats <- pquads_surveyData_dca_results_quadrats |> dplyr::mutate( "Year" = dplyr::case_when( @@ -181,10 +181,10 @@ mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTab ) - dca_results_pquads_site <- pquads_surveyTable_dca_results_quadrats |> + dca_results_pquads_site <- pquads_surveyData_dca_results_quadrats |> dplyr::filter(NVC.Comm != "Sample") - dca_results_sample_site <- pquads_surveyTable_dca_results_quadrats |> + dca_results_sample_site <- pquads_surveyData_dca_results_quadrats |> dplyr::filter(NVC.Comm == "Sample") |> dplyr::mutate("ID" = Quadrat, .before = "Year") |> dplyr::mutate("Quadrat" = stringr::str_extract(string = Quadrat, pattern = "\\d{4}\\s-\\s.*\\s-\\s(.*)", group = 1)) @@ -253,7 +253,7 @@ mvaLocalRefUnrestricted <- function(input, output, session, setupData, surveyTab dplyr::ungroup() - }) # Close isolate + # }) # Close isolate shinybusy::remove_modal_spinner() diff --git a/modules/mvaNationalRef_server.R b/modules/mvaNationalRef_server.R index bff2920..1aaf167 100644 --- a/modules/mvaNationalRef_server.R +++ b/modules/mvaNationalRef_server.R @@ -1,4 +1,4 @@ -mvaNationalRef <- function(input, output, session, setupData, surveyTable, nvcAssignment, sidebar_options) { +mvaNationalRef <- function(input, output, session, setupData, surveyData, nvcAssignment, sidebar_options) { ns <- session$ns @@ -58,7 +58,7 @@ mvaNationalRef <- function(input, output, session, setupData, surveyTable, nvcAs observe({ # Require selected objects are not NULL - shiny::req(surveyTable()) + shiny::req(surveyData()) shiny::req(runAnalysis() != 0) shiny::req(nvcAssignment()) @@ -74,6 +74,8 @@ mvaNationalRef <- function(input, output, session, setupData, surveyTable, nvcAs nvcAssignment <- nvcAssignment() topNVCCommunities <- nvcAssignment$topNVCCommunities + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long nvc_pquads_final_wide <- nvc_pquads_final_wide() nvc_pquad_dca_all <- nvc_pquad_dca_all() @@ -144,8 +146,8 @@ mvaNationalRef <- function(input, output, session, setupData, surveyTable, nvcAs dplyr::mutate("Group" = "Reference", .before = "Quadrat") |> dplyr::mutate("NVC.Comm" = stringr::str_extract(string = Quadrat, pattern = ".+?(?=P)"), .before = "Quadrat") - # Calculate the surveyTable DCA results using the pseudo-quadrat species scores - dca_results_sample_site <- surveyTable() |> #() + # Calculate the surveyData DCA results using the pseudo-quadrat species scores + dca_results_sample_site <- surveyData_long |> #() tibble::as_tibble() |> dplyr::select(-Cover) |> dplyr::left_join(dca_results_pquads_species, by = "Species") |> diff --git a/modules/nvcAssignment_server.R b/modules/nvcAssignment_server.R index e5eba53..6748d73 100644 --- a/modules/nvcAssignment_server.R +++ b/modules/nvcAssignment_server.R @@ -1,4 +1,4 @@ -nvcAssignment <- function(input, output, session, setupData, surveyTable, surveyTableSummary, floristicTables, sidebar_options) { +nvcAssignment <- function(input, output, session, setupData, surveyData, surveyDataSummary, floristicTables, sidebar_options) { ns <- session$ns @@ -39,7 +39,7 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey # Show/Hide Results ------------------------------------------------------- observe({ - shinyjs::show(id = "nvcAssignmentQuadratTable_Jaccard_div") + shinyjs::show(id = "nvcAssignmentPlot_Jaccard_div") shinyjs::show(id = "nvcAssignmentSiteTable_Czekanowski_div") shinyjs::show(id = "nvcAssignmentGroupTable_Czekanowski_div") @@ -52,10 +52,10 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey observe({ - if("nvcAssignQuadratJaccard" %in% resultsViewNVCAssign()){ - shinyjs::show(id = "nvcAssignmentQuadratTable_div") + if("nvcAssignPlotJaccard" %in% resultsViewNVCAssign()){ + shinyjs::show(id = "nvcAssignmentPlot_Jaccard_div") } else { - shinyjs::hide(id = "nvcAssignmentQuadratTable_div") + shinyjs::hide(id = "nvcAssignmentPlot_Jaccard_div") } if("nvcAssignSiteCzekanowski" %in% resultsViewNVCAssign()){ @@ -87,14 +87,14 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey # Calculate ALL nvcAssignment results ------------------------------------- - nvcAssignmentQuadrat_rval <- reactiveVal() + nvcAssignmentPlot_Jaccard_rval <- reactiveVal() nvcAssignmentSite_Czekanowski_rval <- reactiveVal() nvcAssignmentGroup_Czekanowski_rval <- reactiveVal() observe({ shiny::req(floristicTables()) - shiny::req(surveyTableSummary()) + shiny::req(surveyDataSummary()) # req(isFALSE(runAnalysis() == 0)) @@ -106,22 +106,23 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey shiny::isolate({ - surveyTable <- surveyTable() - surveyTableSummary <- surveyTableSummary() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long + surveyDataSummary <- surveyDataSummary() # Retrieve the site and group ID's for which there are less than the threshold threshold <- 5 - site_group_ids_remove <- surveyTableSummary$surveyTableStructure$quadratsPerID |> + site_group_ids_remove <- surveyDataSummary$surveyDataStructure$quadratsPerID |> dplyr::filter(n < threshold) |> dplyr::pull(ID) # Add an ID column to the survey data table - surveyTable_prepped <- surveyTable |> + surveyData_prepped <- surveyData_long |> tidyr::unite(col = "ID", c("Year", "Group", "Quadrat"), sep = " - ", remove = FALSE) |> dplyr::rename("species" = "Species") # Create a concordance to join back on to the results of nva_average_sim - surveyTable_IDs <- surveyTable_prepped |> + surveyData_IDs <- surveyData_prepped |> dplyr::select(ID, Year, Group, Quadrat) |> dplyr::distinct() @@ -148,11 +149,11 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey } # Calculate NVC Similarity by Quadrat - nvcAssignmentQuadrat <- assignNVC::nvc_average_sim(samp_df = surveyTable_prepped, - comp_df = pquads_to_use, - spp_col = "species", - samp_id = "ID", - comp_id = "Pid3") |> + nvcAssignmentPlot_Jaccard <- assignNVC::nvc_average_sim(samp_df = surveyData_prepped, + comp_df = pquads_to_use, + spp_col = "species", + samp_id = "ID", + comp_id = "Pid3") |> dplyr::select("ID" = FOCAL_ID, "Mean.Similarity" = MEAN_SIM, "Standard.Deviation" = SD, @@ -160,16 +161,16 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey dplyr::group_by(ID) |> dplyr::arrange(ID, dplyr::desc(Mean.Similarity)) |> dplyr::ungroup() |> - dplyr::left_join(surveyTable_IDs, by = "ID") + dplyr::left_join(surveyData_IDs, by = "ID") - nvcAssignmentQuadrat_prepped <- nvcAssignmentQuadrat |> + nvcAssignmentPlot_Jaccard_prepped <- nvcAssignmentPlot_Jaccard |> dplyr::select(Year, Group, Quadrat, NVC.Code, Mean.Similarity, Standard.Deviation)|> dplyr::group_by(Year, Group, Quadrat) |> dplyr::slice(1:10) |> dplyr::ungroup() |> dplyr::arrange(Year, Group, Quadrat, dplyr::desc(Mean.Similarity)) - nvcAssignmentQuadrat_rval(nvcAssignmentQuadrat_prepped) + nvcAssignmentPlot_Jaccard_rval(nvcAssignmentPlot_Jaccard_prepped) }) @@ -232,8 +233,6 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey }) |> bindEvent(runAnalysis(), - # nvc_pquads_final(), - # nvc_floristic_tables_numeric(), ignoreInit = TRUE) @@ -271,7 +270,7 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey # Initialise NVC Assignment Quadrat Table --------------------------------- - nvcAssignmentQuadratTable_init <- data.frame("Year" = integer(), + nvcAssignmentPlot_JaccardTable_init <- data.frame("Year" = integer(), "Group" = character(), "Quadrat" = character(), "Mean.Similarity" = numeric(), @@ -279,11 +278,11 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey "NVC.Code" = character() ) - nvcAssignmentQuadratTable_rval <- reactiveVal(nvcAssignmentQuadratTable_init) + nvcAssignmentPlot_JaccardTable_rval <- reactiveVal(nvcAssignmentPlot_JaccardTable_init) - output$nvcAssignmentQuadratTable <- reactable::renderReactable({ + output$nvcAssignmentPlot_JaccardTable <- reactable::renderReactable({ - nvcAssignmentQuadratTable <- reactable::reactable(data = nvcAssignmentQuadratTable_init, + nvcAssignmentPlot_JaccardTable <- reactable::reactable(data = nvcAssignmentPlot_JaccardTable_init, filterable = FALSE, pagination = FALSE, highlight = TRUE, @@ -302,7 +301,7 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey align = "center" # Needed as alignment is not passing through to header )) - return(nvcAssignmentQuadratTable) + return(nvcAssignmentPlot_JaccardTable) }) @@ -310,16 +309,16 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey # Update NVC Assignment Quadrat Table ------------------------------------- observe({ - req(nvcAssignmentQuadrat_rval()) + req(nvcAssignmentPlot_Jaccard_rval()) - nvcAssignmentQuadrat <- nvcAssignmentQuadrat_rval() |> + nvcAssignmentPlot_Jaccard <- nvcAssignmentPlot_Jaccard_rval() |> dplyr::group_by(Year, Group, Quadrat) |> dplyr::slice(1:nTopResults()) |> dplyr::ungroup() - output$nvcAssignmentQuadratTable <- reactable::renderReactable({ + output$nvcAssignmentPlot_JaccardTable <- reactable::renderReactable({ - nvcAssignmentQuadratTable <- reactable::reactable(data = nvcAssignmentQuadrat, + nvcAssignmentPlot_JaccardTable <- reactable::reactable(data = nvcAssignmentPlot_Jaccard, filterable = FALSE, pagination = FALSE, highlight = TRUE, @@ -365,18 +364,18 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey ) ) - return(nvcAssignmentQuadratTable) + return(nvcAssignmentPlot_JaccardTable) }) }) |> - bindEvent(nvcAssignmentQuadrat_rval(), + bindEvent(nvcAssignmentPlot_Jaccard_rval(), nTopResults(), ignoreInit = TRUE, ignoreNULL = TRUE) - outputOptions(output, "nvcAssignmentQuadratTable", suspendWhenHidden = FALSE) + outputOptions(output, "nvcAssignmentPlot_JaccardTable", suspendWhenHidden = FALSE) # Intialise NVC Assignment Site Czekanowski Table ----------------------- nvcAssignmentSiteTable_Czekanowski_init <- data.frame("Year" = integer(), @@ -572,14 +571,14 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey # Compose All NVC Assignment Results -------------------------------------- - nvcAssignmentAll_rval <- reactiveVal() + nvcAssignment_rval <- reactiveVal() observe({ - shiny::req(nvcAssignmentQuadrat_rval()) + shiny::req(nvcAssignmentPlot_Jaccard_rval()) # Select the top-N fitted commmunities - nvcAssignmentQuadrat <- nvcAssignmentQuadrat_rval() |> + nvcAssignmentPlot_Jaccard <- nvcAssignmentPlot_Jaccard_rval() |> dplyr::group_by(Year, Group, Quadrat) |> dplyr::slice(1:nTopResults()) |> dplyr::ungroup() @@ -605,25 +604,33 @@ nvcAssignment <- function(input, output, session, setupData, surveyTable, survey unique() # Create data frame containing top-fitted NVC subcommunities and communities - NVC_communities_final <- unique(c(NVC_communities_all, NVC_communities_fromSubCom)) + topNVCCommunities <- unique(c(NVC_communities_all, NVC_communities_fromSubCom)) - nvcAssignmentAll_list <- list("nvcAssignmentQuadrat" = nvcAssignmentQuadrat, - "nvcAssignmentSite_Czekanowski" = nvcAssignmentSite_Czekanowski, - "nvcAssignmentGroup_Czekanowski" = nvcAssignmentGroup_Czekanowski, - "topNVCCommunities" = NVC_communities_final) + # Update nvcAssignmentR6 object + # nvcAssignmentR6$nvcAssignmentPlot_Jaccard <- nvcAssignmentPlot_Jaccard + # nvcAssignmentR6$nvcAssignmentGroup_Czekanowski <- nvcAssignmentGroup_Czekanowski + # nvcAssignmentR6$nvcAssignmentSite_Czekanowski <- nvcAssignmentSite_Czekanowski + # nvcAssignmentR6$topNVCCommunities <- topNVCCommunities + # + # nvcAssignment_rval(nvcAssignmentR6) - nvcAssignmentAll_rval(nvcAssignmentAll_list) + nvcAssignment_list <- list("nvcAssignmentPlot_Jaccard" = nvcAssignmentPlot_Jaccard, + "nvcAssignmentSite_Czekanowski" = nvcAssignmentSite_Czekanowski, + "nvcAssignmentGroup_Czekanowski" = nvcAssignmentGroup_Czekanowski, + "topNVCCommunities" = topNVCCommunities) + + nvcAssignment_rval(nvcAssignment_list) }) |> bindEvent(nTopResults(), nvcAssignmentSite_Czekanowski_rval(), nvcAssignmentGroup_Czekanowski_rval(), - nvcAssignmentQuadrat_rval(), + nvcAssignmentPlot_Jaccard_rval(), ignoreInit = TRUE, ignoreNULL = TRUE) # Return NVC Assignment Data ---------------------------------------------- - return(nvcAssignmentAll_rval) + return(nvcAssignment_rval) } diff --git a/modules/nvcAssignment_ui.R b/modules/nvcAssignment_ui.R index 5181b91..4325560 100644 --- a/modules/nvcAssignment_ui.R +++ b/modules/nvcAssignment_ui.R @@ -33,12 +33,12 @@ nvcAssignmentUI <- function(id){ # ), shiny::div( - id = ns("nvcAssignmentQuadratTable_div"), + id = ns("nvcAssignmentPlot_JaccardTable_div"), shiny::h5("Quadrat Similarities"), shiny::div( - reactable::reactableOutput(outputId = ns("nvcAssignmentQuadratTable")) + reactable::reactableOutput(outputId = ns("nvcAssignmentPlot_JaccardTable")) ), shiny::div(shiny::br()) diff --git a/modules/report_server.R b/modules/report_server.R index c43e951..7f67ab7 100644 --- a/modules/report_server.R +++ b/modules/report_server.R @@ -1,8 +1,8 @@ report <- function(input, output, session, sidebar_options, - surveyTable, - surveyTableValidator, - surveyTableSummary, + surveyData, + surveyDataValidator, + surveyDataSummary, nvcAssignment, floristicTables, speciesFreq, @@ -65,9 +65,9 @@ report <- function(input, output, session, params = list( sidebar_options = sidebar_options(), reportAuthorName = sidebar_options()$reportAuthorName, - surveyTable = surveyTable(), - surveyTableValidator = surveyTableValidator(), - surveyTableSummary = surveyTableSummary(), + surveyData = surveyData(), + surveyDataValidator = surveyDataValidator(), + surveyDataSummary = surveyDataSummary(), nvcAssignment = nvcAssignment(), floristicTables = floristicTables(), speciesFreq = speciesFreq(), diff --git a/modules/server.R b/modules/server.R index ebc27c2..ed18363 100644 --- a/modules/server.R +++ b/modules/server.R @@ -3,8 +3,8 @@ server <- function(input, output, session) { sidebar_options <- shiny::callModule(module = sidebar, id = "sidebar_id_1", - surveyTable = surveyTable, - surveyTableValidator = surveyTableValidator, + surveyData = surveyData, + surveyDataValidator = surveyDataValidator, nvcAssignment = nvcAssignment, floristicTables = floristicTables, mvaLocalRefRestrictedResults = mvaLocalRefRestrictedResults) @@ -19,40 +19,35 @@ server <- function(input, output, session) { uploadDataTable <- shiny::callModule(module = uploadData, id = "uploadData_id_1") - surveyTable <- shiny::callModule(module = surveyTable, - id = "surveyTable_id_1", - setupData = setupData, - uploadDataTable = uploadDataTable, - surveyTableValidator = surveyTableValidator, - sidebar_options = sidebar_options) - - surveyTableValidator <- shiny::callModule(module = surveyTableValidator, - id = "surveyTableValidator_id_1", - setupData = setupData, - surveyTable = surveyTable, - sidebar_options = sidebar_options) + surveyData <- shiny::callModule(module = surveyData, + id = "surveyData_id_1", + setupData = setupData, + uploadDataTable = uploadDataTable, + surveyDataValidator = surveyDataValidator, + sidebar_options = sidebar_options) - surveyTableSummary <- shiny::callModule(module = surveyTableSummary, - id = "surveyTableSummary_id_1", - surveyTable = surveyTable) + surveyDataValidator <- shiny::callModule(module = surveyDataValidator, + id = "surveyDataValidator_id_1", + setupData = setupData, + surveyData = surveyData, + sidebar_options = sidebar_options) - surveyTableWide <- shiny::callModule(module = surveyTableWide, - id = "surveyTableWide_id_1", - surveyTable = surveyTable, - sidebar_options = sidebar_options) + surveyDataSummary <- shiny::callModule(module = surveyDataSummary, + id = "surveyDataSummary_id_1", + surveyData = surveyData) floristicTables <- shiny::callModule(module = floristicTables, id = "floristicTables_id_1", # setupData = setupData, # Should use setupData to remove bryophytes from floristic tables? - surveyTable = surveyTable, - surveyTableSummary = surveyTableSummary, + surveyData = surveyData, + surveyDataSummary = surveyDataSummary, sidebar_options = sidebar_options) nvcAssignment <- shiny::callModule(module = nvcAssignment, id = "nvcAssignment_id_1", setupData = setupData, - surveyTable = surveyTable, - surveyTableSummary = surveyTableSummary, + surveyData = surveyData, + surveyDataSummary = surveyDataSummary, floristicTables = floristicTables, sidebar_options = sidebar_options) @@ -63,39 +58,37 @@ server <- function(input, output, session) { speciesFreq <- shiny::callModule(module = speciesFreq, id = "speciesFreq_id_1", - surveyTable = surveyTable, - surveyTableWide = surveyTableWide, + surveyData = surveyData, sidebar_options = sidebar_options) avgEIVs <- shiny::callModule(module = calcAvgEIVs, id = "calcAvgEIVs_id_1", - surveyTable = surveyTable, + surveyData = surveyData, sidebar_options = sidebar_options) diversityAnalysis <- shiny::callModule(module = diversityAnalysis, id = "diversityAnalysis_id_1", - surveyTable = surveyTable, - surveyTableWide = surveyTableWide, + surveyData = surveyData, sidebar_options = sidebar_options) mvaNationalRefResults <- shiny::callModule(module = mvaNationalRef, id = "mvaNationalRef_id_1", setupData = setupData, - surveyTable = surveyTable, + surveyData = surveyData, nvcAssignment = nvcAssignment, sidebar_options = sidebar_options) mvaLocalRefRestrictedResults <- shiny::callModule(module = mvaLocalRefRestricted, id = "mvaLocalRefRestricted_id_1", setupData = setupData, - surveyTable = surveyTable, + surveyData = surveyData, nvcAssignment = nvcAssignment, sidebar_options = sidebar_options) mvaLocalRefUnrestrictedResults <- shiny::callModule(module = mvaLocalRefUnrestricted, id = "mvaLocalRefUnrestricted_id_1", setupData = setupData, - surveyTableWide = surveyTableWide, + surveyData = surveyData, nvcAssignment = nvcAssignment, avgEIVs = avgEIVs, sidebar_options = sidebar_options) @@ -103,9 +96,9 @@ server <- function(input, output, session) { shiny::callModule(module = report, id = "sidebar_id_1", sidebar_options = sidebar_options, - surveyTable = surveyTable, - surveyTableValidator = surveyTableValidator, - surveyTableSummary = surveyTableSummary, + surveyData = surveyData, + surveyDataValidator = surveyDataValidator, + surveyDataSummary = surveyDataSummary, nvcAssignment = nvcAssignment, floristicTables = floristicTables, speciesFreq = speciesFreq, @@ -120,10 +113,9 @@ server <- function(input, output, session) { # observe({ # # assign(x = "sidebar_options", value = sidebar_options(), envir = .GlobalEnv) - # assign(x = "surveyTable", value = surveyTable(), envir = .GlobalEnv) - # assign(x = "surveyTableValidator", value = surveyTableValidator(), envir = .GlobalEnv) - # assign(x = "surveyTableWide", value = surveyTableWide(), envir = .GlobalEnv) - # assign(x = "surveyTableSummary", surveyTableSummary(), envir = .GlobalEnv) + # assign(x = "surveyData", value = surveyData(), envir = .GlobalEnv) + # assign(x = "surveyDataValidator", value = surveyDataValidator(), envir = .GlobalEnv) + # assign(x = "surveyDataSummary", surveyDataSummary(), envir = .GlobalEnv) # assign(x = "nvcAssignment", value = nvcAssignment(), envir = .GlobalEnv) # assign(x = "habCor", value = habCor(), envir = .GlobalEnv) # assign(x = "floristicTables", value = floristicTables(), envir = .GlobalEnv) diff --git a/modules/setupData_server.R b/modules/setupData_server.R index 73677e0..5b372e4 100644 --- a/modules/setupData_server.R +++ b/modules/setupData_server.R @@ -73,23 +73,33 @@ setupData <- function(input, output, session, sidebar_options) { } + # setupDataR6$species_names <- species_names_selected + # setupDataR6$accepted_species <- accepted_species_selected + # setupDataR6$example_data <- example_data_selected + # setupDataR6$nvc_floristic_tables <- nvc_floristic_tables_selected + # setupDataR6$nvc_floristic_tables_numeric <- nvc_floristic_tables_numeric_selected + # setupDataR6$nvc_pquads_final <- nvc_pquads_final_selected + # setupDataR6$nvc_pquads_final_wide <- nvc_pquads_final_wide_selected + # setupDataR6$nvc_pquad_dca_all <- nvc_pquad_dca_all_selected + # setupDataR6$nvc_pquad_dca_all_hulls <- nvc_pquad_dca_all_hulls_selected + # setupDataR6$nvc_pquad_dca_all_centroids <- nvc_pquad_dca_all_centroids_selected + # setupDataR6$nvc_pquads_mean_unweighted_eivs <- nvc_pquads_mean_unweighted_eivs_selected + # + # setupData(setupDataR6) + setupData_list <- list( "species_names" = species_names_selected, - "accepted_species" = accepted_species_selected, "example_data" = example_data_selected, - "nvc_floristic_tables" = nvc_floristic_tables_selected, "nvc_floristic_tables_numeric" = nvc_floristic_tables_numeric_selected, - "nvc_pquads_final" = nvc_pquads_final_selected, "nvc_pquads_final_wide" = nvc_pquads_final_wide_selected, - "nvc_pquad_dca_all" = nvc_pquad_dca_all_selected, "nvc_pquad_dca_all_hulls" = nvc_pquad_dca_all_hulls_selected, "nvc_pquad_dca_all_centroids" = nvc_pquad_dca_all_centroids_selected, "nvc_pquads_mean_unweighted_eivs" = nvc_pquads_mean_unweighted_eivs_selected - ) + ) setupData(setupData_list) diff --git a/modules/sidebar_server.R b/modules/sidebar_server.R index 9066660..dd0d313 100644 --- a/modules/sidebar_server.R +++ b/modules/sidebar_server.R @@ -1,4 +1,4 @@ -sidebar <- function(input, output, session, surveyTable, surveyTableValidator, nvcAssignment, floristicTables, mvaLocalRefRestrictedResults) { +sidebar <- function(input, output, session, surveyData, surveyDataValidator, nvcAssignment, floristicTables, mvaLocalRefRestrictedResults) { ns <- session$ns @@ -179,7 +179,7 @@ sidebar <- function(input, output, session, surveyTable, surveyTableValidator, n shiny::modalDialog( title = "Validate Survey Table Data", - id = "validateSurveyTableDataModal", + id = "validatesurveyDataDataModal", footer = shiny::tagList( shiny::modalButton("Close") ), @@ -187,24 +187,24 @@ sidebar <- function(input, output, session, surveyTable, surveyTableValidator, n easyClose = FALSE, fade = TRUE, - surveyTableValidatorUI(id = "surveyTableValidator_id_1") + surveyDataValidatorUI(id = "surveyDataValidator_id_1") ) ) }) |> - bindEvent(input$validateSurveyTable, + bindEvent(input$validatesurveyData, ignoreInit = TRUE) # Disable selected action buttons if okToProceed == FALSE --------------- observe({ - surveyTableValidator <- surveyTableValidator() + surveyDataValidator <- surveyDataValidator() - okToProceed <- surveyTableValidator$surveyTableValidation$okToProceed + okToProceed <- surveyDataValidator$surveyDataValidation$okToProceed - if(okToProceed == TRUE & nrow(surveyTable()) > 0){ + if(okToProceed == TRUE & nrow(surveyData()$surveyData_long) > 0){ shinyjs::enable(id = "runAnalysis") shinyjs::enable(id = "generateReport") @@ -217,7 +217,7 @@ sidebar <- function(input, output, session, surveyTable, surveyTableValidator, n } }) |> - bindEvent(surveyTableValidator(), + bindEvent(surveyDataValidator(), ignoreInit = TRUE, ignoreNULL = TRUE) @@ -384,19 +384,17 @@ sidebar <- function(input, output, session, surveyTable, surveyTableValidator, n # Reactively update DCA survey quadrat selection options ------------------ observe({ - # print(mvaLocalRefRestrictedResults()) - if(is.null(mvaLocalRefRestrictedResults()) == FALSE){ - uniq_years <- surveyTable() |> + uniq_years <- surveyData() |> dplyr::pull(Year) |> unique() - uniq_quadrats <- surveyTable() |> + uniq_quadrats <- surveyData() |> dplyr::pull(Quadrat) |> unique() - uniq_groups <- surveyTable() |> + uniq_groups <- surveyData() |> dplyr::pull(Group) |> unique() @@ -533,9 +531,9 @@ sidebar <- function(input, output, session, surveyTable, surveyTableValidator, n content = function(file) { - surveyTable <- surveyTable() + surveyData <- surveyData() - write.csv(x = surveyTable, file, row.names = FALSE, fileEncoding = "UTF-8") + write.csv(x = surveyData, file, row.names = FALSE, fileEncoding = "UTF-8") } ) diff --git a/modules/sidebar_ui.R b/modules/sidebar_ui.R index e421275..a5e6b99 100644 --- a/modules/sidebar_ui.R +++ b/modules/sidebar_ui.R @@ -180,7 +180,7 @@ sidebarUI <- function(id){ shiny::div( - id = ns("validateSurveyTable_div"), + id = ns("validatesurveyData_div"), shiny::div(shiny::h6("Validation")), @@ -188,13 +188,13 @@ sidebarUI <- function(id){ col_widths = c(11, 1), - shiny::actionButton(inputId = ns("validateSurveyTable"), + shiny::actionButton(inputId = ns("validatesurveyData"), label = "Validate Survey Data"), bslib::popover( bsicons::bs_icon("info-circle"), title = "Validate Survey Table Data", - id = ns("validateSurveyTableInfo"), + id = ns("validatesurveyDataInfo"), shiny::markdown( " Open a popup window to validate the data present in the Survey Data Table. diff --git a/modules/speciesFreq_server.R b/modules/speciesFreq_server.R index e5d45b6..9986645 100644 --- a/modules/speciesFreq_server.R +++ b/modules/speciesFreq_server.R @@ -1,4 +1,4 @@ -speciesFreq <- function(input, output, session, surveyTable, surveyTableWide, sidebar_options) { +speciesFreq <- function(input, output, session, surveyData, sidebar_options) { ns <- session$ns @@ -65,21 +65,21 @@ speciesFreq <- function(input, output, session, surveyTable, surveyTableWide, si text = "Compiling Frequency Table" ) - shiny::req(surveyTable()) - shiny::req(surveyTableWide()) + shiny::req(surveyData()) - surveyTable <- surveyTable() - surveyTableWide <- surveyTableWide() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long + surveyData_wide <- surveyData$wide isolate({ # I need to find a better way to do this with tidyselect - max_year <- max(surveyTable$Year) |> + max_year <- max(surveyData_long$Year) |> as.character() - min_year <- min(surveyTable$Year) |> + min_year <- min(surveyData_long$Year) |> as.character() - speciesFrequency <- surveyTable |> + speciesFrequency <- surveyData_long |> dplyr::group_by(Year, Species) |> dplyr::summarise(Frequency = dplyr::n()) |> tidyr::pivot_wider(id_cols = Species, @@ -108,7 +108,7 @@ speciesFreq <- function(input, output, session, surveyTable, surveyTableWide, si speciesFrequencyTable_rval(speciesFrequency) - }) + }) # close isolate output$speciesFrequencyTable <- reactable::renderReactable({ diff --git a/modules/surveyTableSummary_server.R b/modules/surveyDataSummary_server.R similarity index 92% rename from modules/surveyTableSummary_server.R rename to modules/surveyDataSummary_server.R index 5246037..afcecfe 100644 --- a/modules/surveyTableSummary_server.R +++ b/modules/surveyDataSummary_server.R @@ -1,24 +1,25 @@ -surveyTableSummary <- function(input, output, session, surveyTable) { +surveyDataSummary <- function(input, output, session, surveyData) { ns <- session$ns # Create Survey Data Structure Table data ------------------------------ - surveyTableStructure_rval <- reactiveVal() + surveyDataStructure_rval <- reactiveVal() observe({ - shiny::req(surveyTable()) + shiny::req(surveyData()) - surveyTable <- surveyTable() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long # Create a list of dataframes containing the number of quadrats, per group, per year - quadratsPerYear <- surveyTable |> + quadratsPerYear <- surveyData_long |> dplyr::select(Year, Group, Quadrat) |> dplyr::distinct() |> dplyr::group_by(Year) |> dplyr::summarise(quadratsPerYear = dplyr::n()) - quadratsPerYearGroup <- surveyTable |> + quadratsPerYearGroup <- surveyData_long |> dplyr::select(Year, Group, Quadrat) |> dplyr::distinct() |> dplyr::group_by(Year, Group) |> @@ -36,14 +37,14 @@ surveyTableSummary <- function(input, output, session, surveyTable) { quadratsPerID <- rbind(quadratsPerYearID, quadratsPerYearGroupID) - surveyTable_quadratsPerYearGroup <- list("quadratsPerYear" = quadratsPerYear, + surveyData_quadratsPerYearGroup <- list("quadratsPerYear" = quadratsPerYear, "quadratsPerYearGroup" = quadratsPerYearGroup, "quadratsPerID" = quadratsPerID) - surveyTableStructure_rval(surveyTable_quadratsPerYearGroup) + surveyDataStructure_rval(surveyData_quadratsPerYearGroup) }) |> - bindEvent(surveyTable(), + bindEvent(surveyData(), ignoreInit = TRUE, ignoreNULL = TRUE) @@ -52,11 +53,12 @@ surveyTableSummary <- function(input, output, session, surveyTable) { observe({ - shiny::req(surveyTable()) + shiny::req(surveyData()) - surveyTable <- surveyTable() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long - speciesDataAvailability <- surveyTable |> + speciesDataAvailability <- surveyData_long |> dplyr::select("Species") |> dplyr::distinct() |> dplyr::mutate( @@ -78,11 +80,11 @@ surveyTableSummary <- function(input, output, session, surveyTable) { speciesDataAvailability_rval(speciesDataAvailability) }) |> - bindEvent(surveyTable(), + bindEvent(surveyData(), ignoreInit = TRUE, ignoreNULL = TRUE) - # Initialise speciesDataAvailability Table ------------------------------ +# Initialise speciesDataAvailability Table ------------------------------ speciesDataAvailabilityTable_init <- data.frame("Species" = integer(), "Hill-Ellenberg" = character(), "NVC" = character() @@ -186,9 +188,9 @@ surveyTableSummary <- function(input, output, session, surveyTable) { # Update quadratsPerYear Table -------------------------------------------- observe({ - req(surveyTableStructure_rval()) + req(surveyDataStructure_rval()) - quadratsPerYear <- surveyTableStructure_rval()$quadratsPerYear |> + quadratsPerYear <- surveyDataStructure_rval()$quadratsPerYear |> dplyr::mutate("n" = quadratsPerYear, .keep = "unused") output$quadratsPerYearTable <- reactable::renderReactable({ @@ -217,7 +219,7 @@ surveyTableSummary <- function(input, output, session, surveyTable) { }) }) |> - bindEvent(surveyTableStructure_rval(), + bindEvent(surveyDataStructure_rval(), ignoreInit = TRUE, ignoreNULL = TRUE) @@ -225,9 +227,9 @@ surveyTableSummary <- function(input, output, session, surveyTable) { # Update quadratsPerYearGroup Table --------------------------------------- observe({ - req(surveyTableStructure_rval()) + req(surveyDataStructure_rval()) - quadratsPerYearGroup <- surveyTableStructure_rval()$quadratsPerYearGroup|> + quadratsPerYearGroup <- surveyDataStructure_rval()$quadratsPerYearGroup|> dplyr::mutate("n" = quadratsPerYearGroup, .keep = "unused") output$quadratsPerYearGroupTable <- reactable::renderReactable({ @@ -256,7 +258,7 @@ surveyTableSummary <- function(input, output, session, surveyTable) { }) }) |> - bindEvent(surveyTableStructure_rval(), + bindEvent(surveyDataStructure_rval(), ignoreInit = TRUE, ignoreNULL = TRUE) @@ -323,23 +325,21 @@ surveyTableSummary <- function(input, output, session, surveyTable) { # Compose Data Object to Return ------------------------------------------- - surveyTableSummary_rval <- reactiveVal() + surveyDataSummary_rval <- reactiveVal() observe({ - surveyTableSummary <- list( - "surveyTableStructure" = surveyTableStructure_rval() + surveyDataSummary <- list( + "surveyDataStructure" = surveyDataStructure_rval() ) - # print(surveyTableValidatorData) - - surveyTableSummary_rval(surveyTableSummary) + surveyDataSummary_rval(surveyDataSummary) }) |> - bindEvent(surveyTableStructure_rval(), + bindEvent(surveyDataStructure_rval(), ignoreInit = TRUE, ignoreNULL = TRUE) - return(surveyTableSummary_rval) + return(surveyDataSummary_rval) } \ No newline at end of file diff --git a/modules/surveyTableSummary_ui.R b/modules/surveyDataSummary_ui.R similarity index 98% rename from modules/surveyTableSummary_ui.R rename to modules/surveyDataSummary_ui.R index 24b575f..bc3dc66 100644 --- a/modules/surveyTableSummary_ui.R +++ b/modules/surveyDataSummary_ui.R @@ -1,4 +1,4 @@ -surveyTableSummaryUI <- function(id){ +surveyDataSummaryUI <- function(id){ ns <- NS(id) diff --git a/modules/surveyTableValidator_server.R b/modules/surveyDataValidator_server.R similarity index 71% rename from modules/surveyTableValidator_server.R rename to modules/surveyDataValidator_server.R index c502988..d9dd958 100644 --- a/modules/surveyTableValidator_server.R +++ b/modules/surveyDataValidator_server.R @@ -1,4 +1,4 @@ -surveyTableValidator <- function(input, output, session, setupData, surveyTable, sidebar_options) { +surveyDataValidator <- function(input, output, session, setupData, surveyData, sidebar_options) { ns <- session$ns @@ -37,21 +37,13 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, col = "Species.Submitted", readOnly = TRUE, ) |> - # rhandsontable::hot_col( - # col = "Species.Adjusted", - # readOnly = FALSE, - # type = "dropdown", - # source = speciesNames, - # strict = TRUE, - # default = as.character(NA_character_) - # ) |> rhandsontable::hot_cols(colWidths = c(200, 200, 200, 200)) |> rhandsontable::hot_context_menu(allowRowEdit = FALSE, allowColEdit = FALSE) |> rhandsontable::hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") |> htmlwidgets::onRender(" function(el, x) { var hot = this.hot - $('a[data-value=\"validateSurveyTable\"').on('click', function(){ + $('a[data-value=\"validatesurveyData\"').on('click', function(){ setTimeout(function() {hot.render();}, 0); }) }") @@ -81,7 +73,7 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, htmlwidgets::onRender(" function(el, x) { var hot = this.hot - $('a[data-value=\"validateSurveyTable\"').on('click', function(){ + $('a[data-value=\"validatesurveyData\"').on('click', function(){ setTimeout(function() {hot.render();}, 0); }) }") @@ -90,8 +82,8 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, }) -# Perform Validation Checks on surveyTable -------------------------------- - surveyTableValidation_rval <- reactiveVal( +# Perform Validation Checks on surveyData -------------------------------- + surveyDataValidation_rval <- reactiveVal( list( "speciesInAccepted" = FALSE, "speciesNotAccepted" = FALSE, @@ -101,25 +93,28 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, "groupComplete" = FALSE, "quadratComplete" = FALSE, "speciesComplete" = FALSE, - "speciesQuadratDuplicates" = FALSE, + "speciesQuadratUnique" = FALSE, "quadratIDUnique" = FALSE, "quadratIDDuplicates" = FALSE, "groupIDUnique" = FALSE, "groupIDDuplicates" = FALSE, + "surveyData_wide_ok" = FALSE, + "surveyData_mat_ok" = FALSE, "okToProceed" = FALSE ) ) observe({ - shiny::req(surveyTable()) + shiny::req(surveyData()) shiny::req(speciesNames()) - surveyTable <- surveyTable() - speciesNames <- speciesNames() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long - # print(rhandsontable::hot_to_r(input$speciesAdjustmentTable)) - + surveyData_wide <- surveyData$surveyData_wide + surveyData_mat <- surveyData$surveyData_mat + speciesNames <- speciesNames() # Check all species are accepted if(!is.null(input$speciesAdjustmentTable)){ @@ -128,55 +123,52 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, dplyr::filter(Species.Ignore == TRUE) |> dplyr::pull(Species.Submitted) - surveyTable_speciesToIgnore <- speciesToIgnore + surveyData_speciesToIgnore <- speciesToIgnore - species_to_check <- setdiff(unique(surveyTable$Species), speciesToIgnore) + species_to_check <- setdiff(unique(surveyData_long$Species), speciesToIgnore) - surveyTable_speciesInAccepted <- isTRUE(all(species_to_check %in% speciesNames)) + surveyData_speciesInAccepted <- isTRUE(all(species_to_check %in% speciesNames)) } else { - surveyTable_speciesToIgnore <- c() + surveyData_speciesToIgnore <- c() - surveyTable_speciesInAccepted <- isTRUE(all(unique(surveyTable$Species) %in% speciesNames)) + surveyData_speciesInAccepted <- isTRUE(all(unique(surveyData_long$Species) %in% speciesNames)) } - # print(surveyTable_speciesInAccepted) - # Check which species are not accepted - surveyTable_speciesNotAccepted <- setdiff(unique(surveyTable$Species), speciesNames) + surveyData_speciesNotAccepted <- setdiff(unique(surveyData_long$Species), speciesNames) # Check whether any cover estimates are supplied - surveyTable_coverSupplied <- isTRUE(!is.na(unique(surveyTable$Cover))) + surveyData_coverSupplied <- isTRUE(!is.na(unique(surveyData_long$Cover))) # Check whether all cover estimates are supplied - surveyTable_coverSuppliedAll <- isTRUE(all(!is.na(surveyTable$Cover))) + surveyData_coverSuppliedAll <- isTRUE(all(!is.na(surveyData_long$Cover))) # Check whether there is any missing data in the Year column - surveyTable_yearComplete <- isTRUE(all(!is.na(surveyTable$Year))) + surveyData_yearComplete <- isTRUE(all(!is.na(surveyData_long$Year))) # Check whether there is any missing data in the Group column - surveyTable_groupComplete <- isTRUE(all(!(surveyTable$Group == ""))) + surveyData_groupComplete <- isTRUE(all(!(surveyData_long$Group == ""))) # Check whether there is any missing data in the Quadrat column - surveyTable_quadratComplete <- isTRUE(all(!(surveyTable$Quadrat == ""))) + surveyData_quadratComplete <- isTRUE(all(!(surveyData_long$Quadrat == ""))) # Check whether there is any missing data in the Species column - surveyTable_speciesComplete <- isTRUE(all(!(surveyTable$Species == ""))) + surveyData_speciesComplete <- isTRUE(all(!(surveyData_long$Species == ""))) # Check whether there are any species-quadrat double-entries - surveyTable_speciesQuadratDuplicates <- surveyTable |> + surveyData_speciesQuadratUnique_df <- surveyData_long |> dplyr::select(Year, Group, Quadrat, Species) |> dplyr::group_by(Year, Group, Quadrat, Species) |> dplyr::filter(dplyr::n() > 1) |> dplyr::ungroup() - surveyTable_speciesQuadratDuplicates <- isTRUE(nrow(surveyTable_speciesQuadratDuplicates) == 0) - surveyTable_speciesQuadratDuplicates <- surveyTable_speciesQuadratDuplicates + surveyData_speciesQuadratUnique <- isTRUE(nrow(surveyData_speciesQuadratUnique_df) == 0) # Check whether each quadrat ID is unique - surveyTable_quadratIDUnique_df <- surveyTable |> + surveyData_quadratIDUnique_df <- surveyData_long |> dplyr::select(Year, Group, Quadrat) |> dplyr::distinct() |> dplyr::select(Group, Quadrat) |> @@ -185,68 +177,71 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, dplyr::filter(dplyr::n() > 1) |> dplyr::ungroup() - surveyTable_quadratIDUnique <- isTRUE(nrow(surveyTable_quadratIDUnique_df) == 0) + surveyData_quadratIDUnique <- isTRUE(nrow(surveyData_quadratIDUnique_df) == 0) - surveyTable_quadratIDDuplicates <- surveyTable_quadratIDUnique_df |> + surveyData_quadratIDDuplicates <- surveyData_quadratIDUnique_df |> dplyr::pull(Quadrat) - # surveyTable_quadratIDUnique <- surveyTable |> - # dplyr::select(Year, Group, Quadrat) |> - # dplyr::distinct() |> - # dplyr::group_by(Year, Group, Quadrat) |> - # dplyr::filter(dplyr::n() > 1) |> - # dplyr::pull(Quadrat) - # - # surveyTable_quadratIDUnique <- isTRUE(length(surveyTable_quadratIDUnique) == 0) - # surveyTable_quadratIDDuplicates <- surveyTable_quadratIDUnique # Check whether each group ID is unique - surveyTable_groupIDUnique <- surveyTable |> + surveyData_groupIDUnique_df <- surveyData_long |> dplyr::select(Year, Group) |> dplyr::distinct() |> dplyr::group_by(Year, Group) |> dplyr::filter(dplyr::n() > 1) |> - dplyr::pull(Group) + dplyr::ungroup() - surveyTable_groupIDUnique <- isTRUE(length(surveyTable_groupIDUnique) == 0) - surveyTable_groupIDDuplicates <- surveyTable_groupIDUnique + surveyData_groupIDDuplicates <- surveyData_groupIDUnique_df + surveyData_groupIDUnique <- isTRUE(nrow(surveyData_groupIDUnique_df) == 0) + + # Check whether it is ok to create the wide and mat surveyData objects + okToCreateWideMat <- isTRUE(all(surveyData_yearComplete, + surveyData_groupComplete, surveyData_quadratComplete, + surveyData_speciesComplete, surveyData_quadratIDUnique, + surveyData_groupIDUnique)) + + # Check whether the survey data wide object is ok + surveyData_wide_ok <- isTRUE(!is.null(surveyData_wide)) + + # Check whether the survey data mat object is ok + surveyData_mat_ok <- isTRUE(!is.null(surveyData_mat)) # Check whether the analysis is ok to proceed - okToProceed <- isTRUE(all(surveyTable_speciesInAccepted, surveyTable_yearComplete, - surveyTable_groupComplete, surveyTable_quadratComplete, - surveyTable_speciesQuadratDuplicates, - surveyTable_speciesComplete, surveyTable_quadratIDUnique, - surveyTable_groupIDUnique)) + okToProceed <- isTRUE(all(surveyData_speciesInAccepted, surveyData_yearComplete, + surveyData_groupComplete, surveyData_quadratComplete, + surveyData_speciesComplete, surveyData_quadratIDUnique, + surveyData_wide_ok, surveyData_mat_ok, + surveyData_groupIDUnique)) # Create list of validation checkes - surveyTableValidation <- list( - "speciesToIgnore" = surveyTable_speciesToIgnore, - "speciesInAccepted" = surveyTable_speciesInAccepted, - "speciesNotAccepted" = surveyTable_speciesNotAccepted, - "coverSupplied" = surveyTable_coverSupplied, - "coverSuppliedAll" = surveyTable_coverSuppliedAll, - "yearComplete" = surveyTable_yearComplete, - "groupComplete" = surveyTable_groupComplete, - "quadratComplete" = surveyTable_quadratComplete, - "speciesComplete" = surveyTable_speciesComplete, - "speciesQuadratDuplicates" = surveyTable_speciesQuadratDuplicates, - "quadratIDUnique" = surveyTable_quadratIDUnique, - "quadratIDDuplicates" = surveyTable_quadratIDDuplicates, - "groupIDUnique" = surveyTable_groupIDUnique, - "groupIDDuplicates" = surveyTable_groupIDDuplicates, + surveyDataValidation <- list( + "speciesToIgnore" = surveyData_speciesToIgnore, + "speciesInAccepted" = surveyData_speciesInAccepted, + "speciesNotAccepted" = surveyData_speciesNotAccepted, + "coverSupplied" = surveyData_coverSupplied, + "coverSuppliedAll" = surveyData_coverSuppliedAll, + "yearComplete" = surveyData_yearComplete, + "groupComplete" = surveyData_groupComplete, + "quadratComplete" = surveyData_quadratComplete, + "speciesComplete" = surveyData_speciesComplete, + "speciesQuadratUnique" = surveyData_speciesQuadratUnique, + "quadratIDUnique" = surveyData_quadratIDUnique, + "quadratIDDuplicates" = surveyData_quadratIDDuplicates, + "groupIDUnique" = surveyData_groupIDUnique, + "groupIDDuplicates" = surveyData_groupIDDuplicates, + "surveyData_wide_ok" = surveyData_wide_ok, + "surveyData_mat_ok" = surveyData_mat_ok, "okToProceed" = okToProceed ) - # print(surveyTableValidation) - - surveyTableValidation_rval(surveyTableValidation) + surveyDataValidation_rval(surveyDataValidation) }) |> - bindEvent(surveyTable(), + bindEvent(surveyData(), speciesNames(), input$adjustSpecies, speciesAdjustmentTable_rval(), - ignoreInit = TRUE, + ignoreInit = FALSE, ignoreNULL = TRUE) # Update Table to Replace Species Not In Accepted List -------------------- @@ -254,22 +249,22 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, observe({ - shiny::req(surveyTableValidation_rval()) + shiny::req(surveyDataValidation_rval()) shiny::req(speciesNames()) - surveyTableValidation <- surveyTableValidation_rval() + surveyDataValidation <- surveyDataValidation_rval() speciesNames <- speciesNames() - if(length(surveyTableValidation$speciesNotAccepted) > 0){ + if(length(surveyDataValidation$speciesNotAccepted) > 0){ - speciesAdjustmentTable <- data.frame("Species.Submitted" = surveyTableValidation$speciesNotAccepted, + speciesAdjustmentTable <- data.frame("Species.Submitted" = surveyDataValidation$speciesNotAccepted, "Species.Adjusted" = as.character(NA_character_), "Species.Ignore" = FALSE, "Species.Remove" = FALSE) |> dplyr::mutate( "Species.Ignore" = dplyr::case_when( - Species.Submitted %in% surveyTableValidation$speciesToIgnore ~ TRUE, + Species.Submitted %in% surveyDataValidation$speciesToIgnore ~ TRUE, TRUE ~ as.logical(FALSE) ) ) @@ -309,7 +304,7 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, htmlwidgets::onRender(" function(el, x) { var hot = this.hot - $('a[data-value=\"validateSurveyTable\"').on('click', function(){ + $('a[data-value=\"validatesurveyData\"').on('click', function(){ setTimeout(function() {hot.render();}, 0); }) }") @@ -322,7 +317,7 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, }) |> bindEvent(input$adjustSpecies, - surveyTableValidation_rval(), + surveyDataValidation_rval(), speciesNames(), ignoreInit = TRUE, ignoreNULL = TRUE) @@ -332,13 +327,15 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, observe({ + shiny::req(!is.null(surveyData()$surveyData_long)) shiny::req(reallocateGroups_rval()) - surveyTable <- surveyTable() + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long reallocateGroups <- reallocateGroups_rval() - reallocateGroupsTable <- surveyTable |> + reallocateGroupsTable <- surveyData_long |> dplyr::select(Quadrat, Group) |> dplyr::distinct() @@ -357,7 +354,7 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, htmlwidgets::onRender(" function(el, x) { var hot = this.hot - $('a[data-value=\"validateSurveyTable\"').on('click', function(){ + $('a[data-value=\"validatesurveyData\"').on('click', function(){ setTimeout(function() {hot.render();}, 0); }) }") @@ -369,7 +366,7 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, reallocateGroupsTable_rval(reallocateGroupsTable) }) |> - bindEvent(surveyTable(), + bindEvent(surveyData(), ignoreInit = FALSE, ignoreNULL = TRUE) @@ -377,22 +374,22 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, # Create Text Validation Outputs ------------------------------------------ observe({ - surveyTableValidation <- surveyTableValidation_rval() + surveyDataValidation <- surveyDataValidation_rval() - speciesInAccepted <- surveyTableValidation$speciesInAccepted - speciesNotAccepted <- surveyTableValidation$speciesNotAccepted - coverSupplied <- surveyTableValidation$coverSupplied - coverSuppliedAll <- surveyTableValidation$coverSuppliedAll - yearComplete <- surveyTableValidation$yearComplete - groupComplete <- surveyTableValidation$groupComplete - quadratComplete <- surveyTableValidation$quadratComplete - speciesComplete <- surveyTableValidation$speciesComplete - speciesQuadratDuplicates <- surveyTableValidation$speciesQuadratDuplicates - quadratIDUnique <- surveyTableValidation$quadratIDUnique - quadratIDDuplicates <- surveyTableValidation$quadratIDDuplicates - groupIDUnique <- surveyTableValidation$groupIDUnique - groupIDDuplicates <- surveyTableValidation$groupIDDuplicates - okToProceed <- surveyTableValidation$okToProceed + speciesInAccepted <- surveyDataValidation$speciesInAccepted + speciesNotAccepted <- surveyDataValidation$speciesNotAccepted + coverSupplied <- surveyDataValidation$coverSupplied + coverSuppliedAll <- surveyDataValidation$coverSuppliedAll + yearComplete <- surveyDataValidation$yearComplete + groupComplete <- surveyDataValidation$groupComplete + quadratComplete <- surveyDataValidation$quadratComplete + speciesComplete <- surveyDataValidation$speciesComplete + speciesQuadratUnique <- surveyDataValidation$speciesQuadratUnique + quadratIDUnique <- surveyDataValidation$quadratIDUnique + quadratIDDuplicates <- surveyDataValidation$quadratIDDuplicates + groupIDUnique <- surveyDataValidation$groupIDUnique + groupIDDuplicates <- surveyDataValidation$groupIDDuplicates + okToProceed <- surveyDataValidation$okToProceed @@ -504,16 +501,16 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, }) # Quadrat Names Unique Text ----------------------------------------------- - output$speciesQuadratDuplicatesText <- shiny::renderText({ + output$speciesQuadratUniqueText <- shiny::renderText({ paste0("No Duplicate Species Within Quadrats: ", ifelse( - as.character(speciesQuadratDuplicates) == TRUE, + as.character(speciesQuadratUnique) == TRUE, paste('', - as.character(speciesQuadratDuplicates), + as.character(speciesQuadratUnique), ''), paste('', - as.character(speciesQuadratDuplicates), + as.character(speciesQuadratUnique), '') ) ) @@ -574,25 +571,25 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, }) }) |> - bindEvent(surveyTableValidation_rval(), + bindEvent(surveyDataValidation_rval(), ignoreInit = TRUE, ignoreNULL = TRUE) # Compose Data Object to Return ------------------------------------------- - surveyTableValidatorData_rval <- reactiveVal() + surveyDataValidatorData_rval <- reactiveVal() observe({ - surveyTableValidatorData <- list( + surveyDataValidatorData <- list( "adjustSpecies" = input$adjustSpecies, "reallocateGroups" = input$reallocateGroups, "combineDuplicates" = input$combineDuplicates, "speciesAdjustmentTable" = rhandsontable::hot_to_r(input$speciesAdjustmentTable), "reallocateGroupsTable" = rhandsontable::hot_to_r(input$reallocateGroupsTable), - "surveyTableValidation" = surveyTableValidation_rval() + "surveyDataValidation" = surveyDataValidation_rval() ) - surveyTableValidatorData_rval(surveyTableValidatorData) + surveyDataValidatorData_rval(surveyDataValidatorData) }) |> bindEvent(input$adjustSpecies, @@ -600,7 +597,7 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, input$combineDuplicates, input$speciesAdjustmentTable, input$reallocateGroupsTable, - surveyTableValidation_rval(), + surveyDataValidation_rval(), ignoreInit = TRUE, ignoreNULL = TRUE) @@ -608,6 +605,6 @@ surveyTableValidator <- function(input, output, session, setupData, surveyTable, outputOptions(output, "speciesAdjustmentTable", suspendWhenHidden = TRUE) - return(surveyTableValidatorData_rval) + return(surveyDataValidatorData_rval) } diff --git a/modules/surveyTableValidator_ui.R b/modules/surveyDataValidator_ui.R similarity index 98% rename from modules/surveyTableValidator_ui.R rename to modules/surveyDataValidator_ui.R index 62b1c2a..46d40eb 100644 --- a/modules/surveyTableValidator_ui.R +++ b/modules/surveyDataValidator_ui.R @@ -1,4 +1,4 @@ -surveyTableValidatorUI <- function(id){ +surveyDataValidatorUI <- function(id){ ns <- NS(id) @@ -223,7 +223,7 @@ surveyTableValidatorUI <- function(id){ bslib::popover( bsicons::bs_icon("info-circle"), title = "Species Quadrat Duplicates", - id = ns("speciesQuadratDuplicatesTextInfo"), + id = ns("speciesQuadratUniqueTextInfo"), shiny::markdown( " If TRUE all species are recorded only once per quadrat. @@ -235,7 +235,7 @@ surveyTableValidatorUI <- function(id){ placement = "bottom" ), - shiny::htmlOutput(outputId = ns("speciesQuadratDuplicatesText")) + shiny::htmlOutput(outputId = ns("speciesQuadratUniqueText")) ), diff --git a/modules/surveyTable_server.R b/modules/surveyData_server.R similarity index 60% rename from modules/surveyTable_server.R rename to modules/surveyData_server.R index 9bda4ca..3a3f5ef 100644 --- a/modules/surveyTable_server.R +++ b/modules/surveyData_server.R @@ -1,4 +1,4 @@ -surveyTable <- function(input, output, session, uploadDataTable, setupData, surveyTableValidator, sidebar_options) { +surveyData <- function(input, output, session, uploadDataTable, setupData, surveyDataValidator, sidebar_options) { ns <- session$ns @@ -16,7 +16,6 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv ignoreInit = FALSE) # Retrieve sidebar options ------------------------------------------------ - inputMethod <- reactiveVal() selectedExampleData <- reactiveVal() runAnalysis <- reactiveVal() @@ -39,44 +38,44 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv speciesAdjustmentTable <- reactiveVal() reallocateGroupsTable <- reactiveVal() combineDuplicates <- reactiveVal() + surveyDataValidation <- reactiveVal() + okToProceed <- reactiveVal() observe({ - adjustSpecies(surveyTableValidator()$adjustSpecies) - reallocateGroups(surveyTableValidator()$reallocateGroups) - combineDuplicates(surveyTableValidator()$combineDuplicates) - speciesAdjustmentTable(surveyTableValidator()$speciesAdjustmentTable) - reallocateGroupsTable(surveyTableValidator()$reallocateGroupsTable) - combineDuplicates(surveyTableValidator()$combineDuplicates) + adjustSpecies(surveyDataValidator()$adjustSpecies) + reallocateGroups(surveyDataValidator()$reallocateGroups) + combineDuplicates(surveyDataValidator()$combineDuplicates) + speciesAdjustmentTable(surveyDataValidator()$speciesAdjustmentTable) + reallocateGroupsTable(surveyDataValidator()$reallocateGroupsTable) + combineDuplicates(surveyDataValidator()$combineDuplicates) + surveyDataValidation(surveyDataValidator()$surveyDataValidation) + okToProceed(surveyDataValidator()$okToProceed) }) |> - bindEvent(surveyTableValidator(), + bindEvent(surveyDataValidator(), ignoreInit = TRUE, ignoreNULL = TRUE) # Initial survey table data ----------------------------------------------- - - surveyTable_init <- data.frame("Year" = as.integer(rep(as.numeric(format(Sys.Date(), "%Y")), 20)), - "Group" = as.character(rep("A", 20)), - "Quadrat" = as.character(rep("1", 20)), - "Species" = as.character(rep("", 20)), - "Cover" = as.numeric(rep(NA, 20))) + surveyData_long_init <- data.frame("Year" = as.integer(rep(as.numeric(format(Sys.Date(), "%Y")), 20)), + "Group" = as.character(rep("A", 20)), + "Quadrat" = as.character(rep("1", 20)), + "Species" = as.character(rep("", 20)), + "Cover" = as.numeric(rep(NA, 20))) # Survey Data Entry Table ------------------------------------------------- - - surveyTable_rval <- reactiveVal(surveyTable_init) - - output$surveyTable <- rhandsontable::renderRHandsontable({ + output$surveyData <- rhandsontable::renderRHandsontable({ - surveyTable <- rhandsontable::rhandsontable(data = surveyTable_init, + surveyData <- rhandsontable::rhandsontable(data = surveyData_long_init, height = 600, rowHeaders = NULL, width = "100%"#, # overflow = "visible" # stretchH = "all" ) |> - rhandsontable::hot_col(col = colnames(surveyTable_init), halign = "htCenter") |> + rhandsontable::hot_col(col = colnames(surveyData_long_init), halign = "htCenter") |> rhandsontable::hot_col( col = "Year", readOnly = FALSE, @@ -117,7 +116,7 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv }) }") - return(surveyTable) + return(surveyData) }) @@ -127,22 +126,22 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv if(inputMethod() == "manual"){ - surveyTable <- rhandsontable::hot_to_r(input$surveyTable) + surveyData <- rhandsontable::hot_to_r(input$surveyData) } else if(inputMethod() == "example"){ - surveyTable <- example_data_all |> # exampleData() + surveyData <- example_data_all |> # exampleData() dplyr::filter(Site == selectedExampleData()) |> dplyr::select(-Site) |> dplyr::arrange(Year, Group, Quadrat) } else if(inputMethod() == "upload"){ - surveyTable <- rhandsontable::hot_to_r(input$surveyTable) + surveyData <- rhandsontable::hot_to_r(input$surveyData) if(!is.null(uploadDataTable())){ - surveyTable <- uploadDataTable() + surveyData <- uploadDataTable() } @@ -150,16 +149,16 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv }) - output$surveyTable <- rhandsontable::renderRHandsontable({ + output$surveyData <- rhandsontable::renderRHandsontable({ - surveyTable <- rhandsontable::rhandsontable(data = surveyTable, + surveyData <- rhandsontable::rhandsontable(data = surveyData, height = 600, rowHeaders = NULL, width = "100%"#, # overflow = "visible", # stretchH = "all" ) |> - rhandsontable::hot_col(col = colnames(surveyTable), halign = "htCenter") |> + rhandsontable::hot_col(col = colnames(surveyData), halign = "htCenter") |> rhandsontable::hot_col( col = "Year", readOnly = FALSE, @@ -191,7 +190,6 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv ) |> rhandsontable::hot_context_menu(allowRowEdit = TRUE, allowColEdit = FALSE) |> rhandsontable::hot_table(highlightCol = TRUE, highlightRow = TRUE, stretchH = "all") |> - # rhandsontable::hot_validate_character(cols = "Species", choices = speciesNames) |> htmlwidgets::onRender(" function(el, x) { var hot = this.hot @@ -200,14 +198,10 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv }) }") - return(surveyTable) + return(surveyData) }) - # surveyTable_rval(rhandsontable::hot_to_r(input$surveyTable)) - # - # print(head(surveyTable_rval())) - }) |> bindEvent(inputMethod(), selectedExampleData(), @@ -220,19 +214,17 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv # Survey Table Validation Actions ----------------------------------------- - surveyTable_corrected_rval <- reactiveVal() + surveyData_corrected_rval <- reactiveVal() ## Adjust Species Names --------------------------------------------------- observe({ req(speciesAdjustmentTable()) - req(input$surveyTable) - - # print(speciesAdjustmentTable()) + req(input$surveyData) isolate({ - surveyTable <- rhandsontable::hot_to_r(input$surveyTable) + surveyData <- rhandsontable::hot_to_r(input$surveyData) if(!is.null(speciesAdjustmentTable())){ @@ -240,7 +232,7 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv dplyr::rename("Species" = Species.Submitted) |> dplyr::select(-Species.Ignore) - surveyTable_corrected <- surveyTable |> + surveyData_corrected <- surveyData |> tibble::as_tibble() |> dplyr::left_join(speciesAdjustmentTable, by = "Species") |> dplyr::mutate( @@ -252,7 +244,7 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv dplyr::filter(Species.Remove != TRUE | is.na(Species.Remove)) |> dplyr::select(-Species.Adjusted, -Species.Remove) - surveyTable_corrected_rval(surveyTable_corrected) + surveyData_corrected_rval(surveyData_corrected) } @@ -267,23 +259,23 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv observe({ req(reallocateGroupsTable()) - req(input$surveyTable) + req(input$surveyData) isolate({ - surveyTable <- rhandsontable::hot_to_r(input$surveyTable) + surveyData <- rhandsontable::hot_to_r(input$surveyData) if(!is.null(reallocateGroupsTable())){ reallocateGroupsTable <- reallocateGroupsTable() - surveyTable_corrected <- surveyTable |> + surveyData_corrected <- surveyData |> tibble::as_tibble() |> dplyr::select(-Group) |> dplyr::left_join(reallocateGroupsTable, by = "Quadrat") |> dplyr::select(Year, Group, Quadrat, Species, Cover) - surveyTable_corrected_rval(surveyTable_corrected) + surveyData_corrected_rval(surveyData_corrected) } @@ -298,24 +290,19 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv ## Combine Duplicates ----------------------------------------------------- observe({ - # req(surveyTable_corrected_rval()) - req(input$surveyTable) + req(input$surveyData) isolate({ - surveyTable <- rhandsontable::hot_to_r(input$surveyTable) - surveyTable_corrected <- surveyTable_corrected_rval() - - # print(surveyTable) + surveyData <- rhandsontable::hot_to_r(input$surveyData) + surveyData_corrected <- surveyData_corrected_rval() - surveyTable_noDuplicates <- surveyTable |> + surveyData_noDuplicates <- surveyData |> dplyr::group_by(Year, Group, Quadrat, Species) |> dplyr::summarise("Cover" = sum(Cover)) |> dplyr::ungroup() - - - surveyTable_corrected_rval(surveyTable_noDuplicates) + surveyData_corrected_rval(surveyData_noDuplicates) }) @@ -326,22 +313,20 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv observe({ - shiny::req(surveyTable_corrected_rval()) - - surveyTable_corrected <- surveyTable_corrected_rval() + shiny::req(surveyData_corrected_rval()) - # print(head(surveyTable_corrected)) + surveyData_corrected <- surveyData_corrected_rval() - output$surveyTable <- rhandsontable::renderRHandsontable({ + output$surveyData <- rhandsontable::renderRHandsontable({ - surveyTable <- rhandsontable::rhandsontable(data = surveyTable_corrected, + surveyData <- rhandsontable::rhandsontable(data = surveyData_corrected, height = 600, rowHeaders = NULL, width = "100%"#, # overflow = "visible", # stretchH = "all" ) |> - rhandsontable::hot_col(col = colnames(surveyTable_corrected), halign = "htCenter") |> + rhandsontable::hot_col(col = colnames(surveyData_corrected), halign = "htCenter") |> rhandsontable::hot_col( col = "Year", readOnly = FALSE, @@ -382,33 +367,108 @@ surveyTable <- function(input, output, session, uploadDataTable, setupData, surv }) }") - return(surveyTable) + return(surveyData) }) }) |> - bindEvent(surveyTable_corrected_rval(), + bindEvent(surveyData_corrected_rval(), ignoreInit = TRUE, ignoreNULL = TRUE) # Save Survey Table to Reactive Val --------------------------------------- + # surveyData_rval <- reactiveVal(surveyDataR6) + surveyData_rval <- reactiveVal(list( + "surveyData_long" = NULL, + "surveyData_wide" = NULL, + "surveyData_mat" = NULL + )) + observe({ + + surveyData_long <- rhandsontable::hot_to_r(input$surveyData) + surveyData <- surveyData_rval() + surveyData$surveyData_long <- surveyData_long + surveyData_rval(surveyData) + + }) |> + bindEvent(input$surveyData, + ignoreInit = TRUE, + ignoreNULL = TRUE) + - # req(nrow(surveyTable_rval()) > 0) +# Save Survey Data Wide and Mat ------------------------------------------- + observe({ - surveyTable_rval(rhandsontable::hot_to_r(input$surveyTable)) + # Require the following conditions to be true to create surveyData_wide and + # surveyData_mat. + # This is to prevent list columns, empty column names, and incomplete row + # names (mat) or incomplete ID columns (wide) when pivoting wide. + shiny::req(isTRUE(surveyDataValidation()$yearComplete)) + shiny::req(isTRUE(surveyDataValidation()$groupComplete)) + shiny::req(isTRUE(surveyDataValidation()$quadratComplete)) + shiny::req(isTRUE(surveyDataValidation()$speciesComplete)) + shiny::req(isTRUE(surveyDataValidation()$quadratIDUnique)) + shiny::req(isTRUE(surveyDataValidation()$groupIDUnique)) + + # Retrieve long survey table + surveyData <- surveyData_rval() + surveyData_long <- surveyData$surveyData_long + + # Check whether there are any cover values supplied + # noCoverValues <- isFALSE(surveyDataValidation()$coverSupplied) + noCoverValues <- isTRUE(surveyData_long$Cover |> unique() |> is.na()) + + if(noCoverValues == TRUE){ + + surveyData_wide <- surveyData_long |> + dplyr::mutate("Cover" = 1) |> + tidyr::pivot_wider(names_from = Species, + values_from = Cover) |> + dplyr::mutate_all(~replace(., is.na(.), 0)) + + surveyData_mat <- surveyData_long |> + tidyr::unite(col = "ID", c(Year, Group, Quadrat), sep = " - ", remove = TRUE) |> + dplyr::mutate("Cover" = 1) |> + tidyr::pivot_wider(names_from = Species, + values_from = Cover) |> + tibble::column_to_rownames(var = "ID") |> + dplyr::mutate_all(~replace(., is.na(.), 0)) |> + as.matrix() + + } else if(noCoverValues == FALSE){ + + surveyData_wide <- surveyData_long |> + tidyr::pivot_wider(names_from = Species, + values_from = Cover) |> + dplyr::mutate_all(~replace(., is.na(.), 0)) + + surveyData_mat <- surveyData_long |> + tidyr::unite(col = "ID", c(Year, Group, Quadrat), sep = " - ", remove = TRUE) |> + tidyr::pivot_wider(names_from = Species, + values_from = Cover) |> + tibble::column_to_rownames(var = "ID") |> + dplyr::mutate_all(~replace(., is.na(.), 0)) |> + as.matrix() + + } + + surveyData$surveyData_wide <- surveyData_wide + surveyData$surveyData_mat <- surveyData_mat + surveyData_rval(surveyData) }) |> - bindEvent(input$surveyTable, + bindEvent(surveyData_rval(), + input$surveyData, ignoreInit = TRUE, ignoreNULL = TRUE) - - outputOptions(output, "surveyTable", suspendWhenHidden = FALSE) + # Ensure table + outputOptions(output, "surveyData", suspendWhenHidden = FALSE) - return(surveyTable_rval) + return(surveyData_rval) } diff --git a/modules/surveyTable_ui.R b/modules/surveyData_ui.R similarity index 88% rename from modules/surveyTable_ui.R rename to modules/surveyData_ui.R index 6b24323..51a7da6 100644 --- a/modules/surveyTable_ui.R +++ b/modules/surveyData_ui.R @@ -1,4 +1,4 @@ -surveyTableUI <- function(id) { +surveyDataUI <- function(id) { ns <- NS(id) # Basic Inputs ------------------------------------------------------------ @@ -9,7 +9,7 @@ surveyTableUI <- function(id) { shiny::h5("Survey Data Table"), shiny::div( - rhandsontable::rHandsontableOutput(outputId = ns("surveyTable")) + rhandsontable::rHandsontableOutput(outputId = ns("surveyData")) ) ) ) diff --git a/modules/surveyTableWide_server.R b/modules/surveyTableWide_server.R deleted file mode 100644 index e853d42..0000000 --- a/modules/surveyTableWide_server.R +++ /dev/null @@ -1,70 +0,0 @@ -surveyTableWide <- function(input, output, session, surveyTable, sidebar_options) { - - ns <- session$ns - -# Retrieve sidebar options ------------------------------------------------ - - runAnalysis <- reactiveVal() - - observe({ - - runAnalysis(sidebar_options()$runAnalysis) - - }) |> - bindEvent(sidebar_options(), ignoreInit = FALSE) - -# Prepare surveyTable ----------------------------------------------------- - - surveyTableWide_rval <- reactiveVal() - - observe({ - - shiny::isolate({ - - req(all(!is.na(surveyTable()$Species)) == TRUE) - - surveyTable <- surveyTable() - - noCoverValues <- isTRUE(surveyTable$Cover |> unique() |> is.na()) - - if(noCoverValues == TRUE){ - - surveyTableWide <- surveyTable |> - tidyr::unite(col = "ID", c(Year, Group, Quadrat), sep = " - ", remove = FALSE) |> - dplyr::mutate("Cover" = 1) |> - dplyr::select(-c(Year, Group, Quadrat)) |> - dplyr::group_by(ID) |> - tidyr::pivot_wider(names_from = Species, - values_from = Cover) |> - tibble::column_to_rownames(var = "ID") |> - dplyr::mutate_all(~replace(., is.na(.), 0)) |> - as.matrix() - - } else if(noCoverValues == FALSE){ - - surveyTableWide <- surveyTable |> - tidyr::unite(col = "ID", c(Year, Group, Quadrat), sep = " - ", remove = FALSE) |> - dplyr::select(-c(Year, Group, Quadrat)) |> - dplyr::group_by(ID) |> - tidyr::pivot_wider(names_from = Species, - values_from = Cover) |> - tibble::column_to_rownames(var = "ID") |> - dplyr::mutate_all(~replace(., is.na(.), 0)) |> - as.matrix() - - } - - }) - - # print(surveyTableWide) - - surveyTableWide_rval(surveyTableWide) - - }) |> - bindEvent(runAnalysis(), - ignoreInit = TRUE, - ignoreNULL = TRUE) - - return(surveyTableWide_rval) - -} diff --git a/modules/surveyTableWide_ui.R b/modules/surveyTableWide_ui.R deleted file mode 100644 index 0e789cf..0000000 --- a/modules/surveyTableWide_ui.R +++ /dev/null @@ -1,15 +0,0 @@ -surveyTableWideUI <- function(id){ - - ns <- NS(id) - - shiny::fluidRow( - shiny::column( - width = 12, - shiny::div( - # rhandsontable::rHandsontableOutput(outputId = ns("surveyTableWide")) - #, style = "margin-right: 5px !important;" - ) - ) - ) - -} diff --git a/modules/ui.R b/modules/ui.R index f035101..5f7274d 100644 --- a/modules/ui.R +++ b/modules/ui.R @@ -60,7 +60,7 @@ ui <- bslib::page_navbar( value = "surveyData_panel", - surveyTableUI(id = "surveyTable_id_1") + surveyDataUI(id = "surveyData_id_1") ), @@ -72,7 +72,7 @@ ui <- bslib::page_navbar( value = "dataStructure_panel", - surveyTableSummaryUI(id = "surveyTableSummary_id_1") + surveyDataSummaryUI(id = "surveyDataSummary_id_1") ), diff --git a/modules/uploadData_server.R b/modules/uploadData_server.R index 37098ce..421aec6 100644 --- a/modules/uploadData_server.R +++ b/modules/uploadData_server.R @@ -148,8 +148,6 @@ uploadData <- function(input, output, session) { # shinyjs::click(id = "confirmUpload") - # print(uploadDataTable_rval) - }) |> bindEvent(input$confirmUpload, ignoreInit = TRUE, diff --git a/report/Report.Rmd b/report/Report.Rmd index 63a7bc6..a2e0487 100644 --- a/report/Report.Rmd +++ b/report/Report.Rmd @@ -7,9 +7,9 @@ output: in_header: "Report.preamble.tex" params: sidebar_options: NULL - surveyTable: NULL - surveyTableValidator: NULL - surveyTableSummary: NULL + surveyData: NULL + surveyDataValidator: NULL + surveyDataSummary: NULL nvcAssignment: NULL floristicTables: NULL speciesFreq: NULL @@ -40,9 +40,9 @@ library(kableExtra) # sys.source("./create_constants.R", envir = knitr::knit_global()) # Retrieve report parameters -surveyTable <- params$surveyTable -surveyTableValidator <- params$surveyTableValidator -surveyTableSummary <- params$surveyTableSummary +surveyData <- params$surveyData +surveyDataValidator <- params$surveyDataValidator +surveyDataSummary <- params$surveyDataSummary nvcAssignment <- params$nvcAssignment sidebar_options <- params$sidebar_options floristicTables <- params$floristicTables @@ -66,12 +66,12 @@ reportAuthorName <- sidebar_options$reportAuthorName reportProjectName <- sidebar_options$reportProjectName # Data Structure -surveyTableStructure <- surveyTableSummary$surveyTableStructure -quadratsPerYear <- surveyTableStructure$quadratsPerYear -quadratsPerYearGroup <- surveyTableStructure$quadratsPerYearGroup +surveyDataStructure <- surveyDataSummary$surveyDataStructure +quadratsPerYear <- surveyDataStructure$quadratsPerYear +quadratsPerYearGroup <- surveyDataStructure$quadratsPerYearGroup # NVC Assignment -nvcAssignmentQuadrat <- nvcAssignment$nvcAssignmentQuadrat +nvcAssignmentPlot_Jaccard <- nvcAssignment$nvcAssignmentPlot_Jaccard nvcAssignmentSite_Czekanowski <- nvcAssignment$nvcAssignmentSite_Czekanowski nvcAssignmentGroup_Czekanowski <- nvcAssignment$nvcAssignmentGroup_Czekanowski @@ -129,7 +129,7 @@ reportOptions_options <- list(`NVC Assignment` = c("Site, Czekanowski" = "nvcAss `MVA` = c("National" = "mvaNationalReference", "Local (restricted)" = "mvaLocalReferenceRestricted", "Local (unrestricted)" = "mvaLocalReferenceUnrestricted"), - `Survey Table` = c("Survey Table" = "surveyTable") + `Survey Table` = c("Survey Table" = "surveyData") ) ``` @@ -310,10 +310,10 @@ if("nvcAssignmentResultsQuadrat_Jaccard" %in% reportOptions){ cat("## NVC Assignment Jaccard, by Quadrat") - nvcAssignmentQuadrat_prepped <- nvcAssignmentQuadrat |> + nvcAssignmentPlot_Jaccard_prepped <- nvcAssignmentPlot_Jaccard |> dplyr::mutate_if(is.numeric, round, digits = 2) - kableExtra::kbl(x = nvcAssignmentQuadrat_prepped, format = "latex", booktabs = TRUE, + kableExtra::kbl(x = nvcAssignmentPlot_Jaccard_prepped, format = "latex", booktabs = TRUE, longtable = TRUE, linesep = "", caption = "The top NVC communities fitted using the pseudo-quadrat method, by quadrat, group, and year") |> kableExtra::kable_styling(latex_options = c("repeat_header", "HOLD_position")) @@ -775,14 +775,14 @@ if("mvaLocalReferenceUnrestricted" %in% reportOptions){ \newpage # Appendix -```{r surveyTable, echo=FALSE, message=FALSE, warning=FALSE, results='asis'} +```{r surveyData, echo=FALSE, message=FALSE, warning=FALSE, results='asis'} -if("surveyTable" %in% reportOptions){ +if("surveyData" %in% reportOptions){ cat("\\newpage") cat("## Survey Data Table") - kableExtra::kbl(x = surveyTable, format = "latex", booktabs = TRUE, + kableExtra::kbl(x = surveyData, format = "latex", booktabs = TRUE, longtable = TRUE, linesep = "", caption = "Survey Data Table") |> kableExtra::kable_styling(latex_options = c("repeat_header", "HOLD_position")) diff --git a/www/documentation.html b/www/documentation.html index 165c823..65be9d0 100644 --- a/www/documentation.html +++ b/www/documentation.html @@ -1026,7 +1026,7 @@

    5 Release Log

  • Fixes:
  • New Features: NA
    • diff --git a/www/style.css b/www/style.css index 68da269..7d1617f 100644 --- a/www/style.css +++ b/www/style.css @@ -20,7 +20,7 @@ Approximate palette retrieved using https://html-color-codes.info/colors-from-im /* Main font */ * {font-family: "Montserrat", sans-serif !important;} -/*#validateSurveyTableDataModal{ +/*#validatesurveyDataDataModal{ opacity: 0 !important; background-color: var(--text-title-color) !important; }*/ From ba2f83ac98fd7428791807ab49113360852dc37f Mon Sep 17 00:00:00 2001 From: ZekeMarshall Date: Mon, 4 Mar 2024 10:11:09 +0000 Subject: [PATCH 2/3] Fixing report MVA DCA axes to 1 and 2 --- modules/server.R | 34 +++++++++++++++++----------------- report/Report.Rmd | 40 +++++++++++++++++++++++++++------------- 2 files changed, 44 insertions(+), 30 deletions(-) diff --git a/modules/server.R b/modules/server.R index ed18363..78c70e4 100644 --- a/modules/server.R +++ b/modules/server.R @@ -110,22 +110,22 @@ server <- function(input, output, session) { # Save module outputs to global environment, uncomment for development only! - # observe({ - # - # assign(x = "sidebar_options", value = sidebar_options(), envir = .GlobalEnv) - # assign(x = "surveyData", value = surveyData(), envir = .GlobalEnv) - # assign(x = "surveyDataValidator", value = surveyDataValidator(), envir = .GlobalEnv) - # assign(x = "surveyDataSummary", surveyDataSummary(), envir = .GlobalEnv) - # assign(x = "nvcAssignment", value = nvcAssignment(), envir = .GlobalEnv) - # assign(x = "habCor", value = habCor(), envir = .GlobalEnv) - # assign(x = "floristicTables", value = floristicTables(), envir = .GlobalEnv) - # assign(x = "speciesFreq", value = speciesFreq(), envir = .GlobalEnv) - # assign(x = "avgEIVs", value = avgEIVs(), envir = .GlobalEnv) - # assign(x = "diversityAnalysis", value = diversityAnalysis(), envir = .GlobalEnv) - # assign(x = "mvaNationalRefResults", value = mvaNationalRefResults(), envir = .GlobalEnv) - # assign(x = "mvaLocalRefRestrictedResults", value = mvaLocalRefRestrictedResults(), envir = .GlobalEnv) - # assign(x = "mvaLocalRefUnrestrictedResults", value = mvaLocalRefUnrestrictedResults(), envir = .GlobalEnv) - # - # }) + observe({ + + assign(x = "sidebar_options", value = sidebar_options(), envir = .GlobalEnv) + assign(x = "surveyData", value = surveyData(), envir = .GlobalEnv) + assign(x = "surveyDataValidator", value = surveyDataValidator(), envir = .GlobalEnv) + assign(x = "surveyDataSummary", surveyDataSummary(), envir = .GlobalEnv) + assign(x = "nvcAssignment", value = nvcAssignment(), envir = .GlobalEnv) + assign(x = "habCor", value = habCor(), envir = .GlobalEnv) + assign(x = "floristicTables", value = floristicTables(), envir = .GlobalEnv) + assign(x = "speciesFreq", value = speciesFreq(), envir = .GlobalEnv) + assign(x = "avgEIVs", value = avgEIVs(), envir = .GlobalEnv) + assign(x = "diversityAnalysis", value = diversityAnalysis(), envir = .GlobalEnv) + assign(x = "mvaNationalRefResults", value = mvaNationalRefResults(), envir = .GlobalEnv) + assign(x = "mvaLocalRefRestrictedResults", value = mvaLocalRefRestrictedResults(), envir = .GlobalEnv) + assign(x = "mvaLocalRefUnrestrictedResults", value = mvaLocalRefUnrestrictedResults(), envir = .GlobalEnv) + + }) } diff --git a/report/Report.Rmd b/report/Report.Rmd index a2e0487..a4a7a8f 100644 --- a/report/Report.Rmd +++ b/report/Report.Rmd @@ -53,6 +53,9 @@ mvaNationalRefResults <- params$mvaNationalRefResults mvaLocalRefRestrictedResults <- params$mvaLocalRefRestrictedResults mvaLocalRefUnrestrictedResults <- params$mvaLocalRefUnrestrictedResults +# Survey data +surveyData_long <- surveyData$surveyData_long + # Sidebar options inputMethod <- sidebar_options$inputMethod includeBryophytes <- sidebar_options$includeBryophytes @@ -74,6 +77,7 @@ quadratsPerYearGroup <- surveyDataStructure$quadratsPerYearGroup nvcAssignmentPlot_Jaccard <- nvcAssignment$nvcAssignmentPlot_Jaccard nvcAssignmentSite_Czekanowski <- nvcAssignment$nvcAssignmentSite_Czekanowski nvcAssignmentGroup_Czekanowski <- nvcAssignment$nvcAssignmentGroup_Czekanowski +topNVCCommunities <- nvcAssignment$topNVCCommunities # EIVs weightedMeanHEValuesSite <- avgEIVs$weightedMeanHEValuesSite @@ -631,12 +635,16 @@ if("mvaNationalReference" %in% reportOptions){ if("mvaNationalReference" %in% reportOptions){ - # cat("## National Reference") + dcaAxisSelection <- "dca1dca2" + x_axis <- "DCA1" + y_axis <- "DCA2" mvaNationalRefPlot <- ggplot2::ggplot() + - ggplot2::geom_polygon(data = mvaNationalRef_hulls, alpha = 0.2, - mapping = ggplot2::aes(x = DCA1, - y = DCA2, + ggplot2::geom_polygon(data = mvaNationalRef_hulls |> dplyr::filter(dcaAxes == dcaAxisSelection, + NVC %in% topNVCCommunities), + alpha = 0.2, + mapping = ggplot2::aes(x = .data[[x_axis]], + y = .data[[y_axis]], fill = NVC )) + ggplot2::geom_point(data = mvaNationalRef_quadrats_survey, @@ -683,12 +691,15 @@ if("mvaLocalReferenceRestricted" %in% reportOptions){ if("mvaLocalReferenceRestricted" %in% reportOptions){ - # cat("## Local Reference, Restricted") + dcaAxisSelection <- "dca1dca2" + x_axis <- "DCA1" + y_axis <- "DCA2" mvaLocalRefRestrictedPlot <- ggplot2::ggplot() + - ggplot2::geom_polygon(data = mvaLocalRefRestricted_hulls_pquads, alpha = 0.2, - mapping = ggplot2::aes(x = DCA1, - y = DCA2, + ggplot2::geom_polygon(data = mvaLocalRefRestricted_hulls_pquads |> dplyr::filter(dcaAxes == dcaAxisSelection), + alpha = 0.2, + mapping = ggplot2::aes(x = .data[[x_axis]], + y = .data[[y_axis]], fill = NVC.Comm )) + ggplot2::geom_point(data = mvaLocalRefRestricted_quadrats_survey, @@ -735,12 +746,15 @@ if("mvaLocalReferenceUnrestricted" %in% reportOptions){ if("mvaLocalReferenceUnrestricted" %in% reportOptions){ - # cat("## Local Reference, Unrestricted") + dcaAxisSelection <- "dca1dca2" + x_axis <- "DCA1" + y_axis <- "DCA2" mvaLocalRefUnrestrictedPlot <- ggplot2::ggplot() + - ggplot2::geom_polygon(data = mvaLocalRefUnrestricted_hulls_pquads, alpha = 0.2, - mapping = ggplot2::aes(x = DCA1, - y = DCA2, + ggplot2::geom_polygon(data = mvaLocalRefUnrestricted_hulls_pquads |> dplyr::filter(dcaAxes == dcaAxisSelection), + alpha = 0.2, + mapping = ggplot2::aes(x = .data[[x_axis]], + y = .data[[y_axis]], fill = NVC.Comm )) + ggplot2::geom_point(data = mvaLocalRefUnrestricted_quadrats_survey, @@ -782,7 +796,7 @@ if("surveyData" %in% reportOptions){ cat("\\newpage") cat("## Survey Data Table") - kableExtra::kbl(x = surveyData, format = "latex", booktabs = TRUE, + kableExtra::kbl(x = surveyData_long, format = "latex", booktabs = TRUE, longtable = TRUE, linesep = "", caption = "Survey Data Table") |> kableExtra::kable_styling(latex_options = c("repeat_header", "HOLD_position")) From 405d1be939f1058a8e4e79e0a63f3dac03ae3193 Mon Sep 17 00:00:00 2001 From: ZekeMarshall Date: Tue, 5 Mar 2024 10:48:13 +0000 Subject: [PATCH 3/3] fixes for v0.97 --- README.Rmd | 9 +++++---- README.md | 7 +++++-- docker-compose.yml | 2 +- docs/documentation.Rmd | 29 +++++++++++++++++++++++++++-- modules/nvcAssignment_server.R | 8 -------- modules/nvcAssignment_ui.R | 2 +- modules/sidebar_server.R | 12 ++++++++---- report/Report.Rmd | 9 +++++++-- www/documentation.html | 29 +++++++++++++++++++++++++++-- 9 files changed, 81 insertions(+), 26 deletions(-) diff --git a/README.Rmd b/README.Rmd index 57c2150..2d0a899 100644 --- a/README.Rmd +++ b/README.Rmd @@ -14,19 +14,20 @@ knitr::opts_chunk$set( # RMAVIS -[![Generic badge](https://img.shields.io/badge/Version-0.96-green.svg)]() +[![Generic badge](https://img.shields.io/badge/Version-0.97-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) 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. +sample data to UK National Vegetation Classification units, with additional exploratory analyses. ## Running the app 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")`. -If `renv::restore()` fails run `install.packages(unique(renv::dependencies()$Package), dependencies = TRUE)`. +If `renv::restore()` fails run `install.packages(unique(renv::dependencies()$Package), dependencies = TRUE)`. +Note that whilst the correct dependencies will be installed, the versions may not match those in the renv.lock file. Future developments may support the release of RMAVIS as an R package. @@ -34,7 +35,7 @@ Future developments may support the release of RMAVIS as an R package. ### Posit Connect -RMAVIS is currently hosted on the UKCEH Posit Connect server: +RMAVIS is currently hosted on the UKCEH Posit Connect server: https://connect-apps.ceh.ac.uk/RMAVIS/ ### Docker diff --git a/README.md b/README.md index f37cc85..f07bbc8 100644 --- a/README.md +++ b/README.md @@ -4,7 +4,7 @@ [![Generic -badge](https://img.shields.io/badge/Version-0.96-green.svg)]() +badge](https://img.shields.io/badge/Version-0.97-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) @@ -12,7 +12,7 @@ developed.](https://www.repostatus.org/badges/latest/active.svg)](https://www.re 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. +units, with additional exploratory analyses. ## Running the app @@ -22,6 +22,8 @@ by cloning the repository, calling `renv::restore()`, and then calling If `renv::restore()` fails run `install.packages(unique(renv::dependencies()$Package), dependencies = TRUE)`. +Note that whilst the correct dependencies will be installed, the +versions may not match those in the renv.lock file. Future developments may support the release of RMAVIS as an R package. @@ -30,6 +32,7 @@ Future developments may support the release of RMAVIS as an R package. ### Posit Connect RMAVIS is currently hosted on the UKCEH Posit Connect server: + ### Docker diff --git a/docker-compose.yml b/docker-compose.yml index c1dcd6a..b72a361 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -4,7 +4,7 @@ services: build: context: . dockerfile: Dockerfile - image: "/rmavis:v0.96" + image: "/rmavis:v0.97" container_name: "rmavis" restart: always privileged: true diff --git a/docs/documentation.Rmd b/docs/documentation.Rmd index caa8fd5..755d9ae 100644 --- a/docs/documentation.Rmd +++ b/docs/documentation.Rmd @@ -1,6 +1,6 @@ --- title: "RMAVIS - Documentation" -subtitle: "v0.96" +subtitle: "v0.97" # output: # bookdown::word_document2: # always_allow_html: true @@ -530,6 +530,16 @@ to be displayed in the MVA plots: Here the user may select any NVC community to display in the **National Reference** MVA plot only. +**Group Survey Plots** + +Three options are available to 'group' the survey quadrat/plot data: + +- No, the individual plots are left ungrouped. +- Group, mean DCA axis scores are calculated from the individual plots + by group. +- Year, mean DCA axis scores are calculated from the individual plots + by year. + **Survey Quadrat Selection** Three methods are available for subsetting the survey quadrats being @@ -566,6 +576,7 @@ plots. - Survey Quadrats, the survey quadrats entered in **Survey Data**. - Pseudo-Quadrats, all pseudo-quadrats used in the DCA ordination. - Reference Space, the convex hulls formed around the pseudo-quadrats. +- Reference Centroids, the centroids formed from the pseudo-quadrat DCA scores. - Species, the species DCA axis scores. - Unique Survey Species, the species present in the survey quadrats but absent in the top-fitted NVC communities pseudo-quadrats. @@ -638,7 +649,7 @@ Marshall, Z., Smart, S., and Harrower, C.. (2024). RMAVIS. @misc{marshall2024, author = {Marshall, Z. and Smart, S. and Harrower, C.}, title = {RMAVIS}, - howpublished = {Available at https://connect-apps.ceh.ac.uk/RMAVIS/, version 0.96}, + howpublished = {Available at https://connect-apps.ceh.ac.uk/RMAVIS/, version 0.97}, month = {02}, year = {2024}, note = {A R Shiny application for the assignment of vegetation survey data to National Vegetation Classification (NVC) communities, with additional exploratory analyses.} @@ -649,6 +660,20 @@ Marshall, Z., Smart, S., and Harrower, C.. (2024). RMAVIS.
    +v0.97 + +2024/03/XX + +- Modifications: NA +- Fixes: + - Updating documentation to reflect new MVA functionality. + - Fixing group survey plots option in MVA module. +- New Features: NA + +
    + +
    + v0.96 2024/03/02 diff --git a/modules/nvcAssignment_server.R b/modules/nvcAssignment_server.R index 6748d73..2069e0c 100644 --- a/modules/nvcAssignment_server.R +++ b/modules/nvcAssignment_server.R @@ -606,14 +606,6 @@ nvcAssignment <- function(input, output, session, setupData, surveyData, surveyD # Create data frame containing top-fitted NVC subcommunities and communities topNVCCommunities <- unique(c(NVC_communities_all, NVC_communities_fromSubCom)) - # Update nvcAssignmentR6 object - # nvcAssignmentR6$nvcAssignmentPlot_Jaccard <- nvcAssignmentPlot_Jaccard - # nvcAssignmentR6$nvcAssignmentGroup_Czekanowski <- nvcAssignmentGroup_Czekanowski - # nvcAssignmentR6$nvcAssignmentSite_Czekanowski <- nvcAssignmentSite_Czekanowski - # nvcAssignmentR6$topNVCCommunities <- topNVCCommunities - # - # nvcAssignment_rval(nvcAssignmentR6) - nvcAssignment_list <- list("nvcAssignmentPlot_Jaccard" = nvcAssignmentPlot_Jaccard, "nvcAssignmentSite_Czekanowski" = nvcAssignmentSite_Czekanowski, "nvcAssignmentGroup_Czekanowski" = nvcAssignmentGroup_Czekanowski, diff --git a/modules/nvcAssignment_ui.R b/modules/nvcAssignment_ui.R index 4325560..4a605ea 100644 --- a/modules/nvcAssignment_ui.R +++ b/modules/nvcAssignment_ui.R @@ -33,7 +33,7 @@ nvcAssignmentUI <- function(id){ # ), shiny::div( - id = ns("nvcAssignmentPlot_JaccardTable_div"), + id = ns("nvcAssignmentPlot_Jaccard_div"), shiny::h5("Quadrat Similarities"), diff --git a/modules/sidebar_server.R b/modules/sidebar_server.R index dd0d313..5d49f43 100644 --- a/modules/sidebar_server.R +++ b/modules/sidebar_server.R @@ -384,17 +384,20 @@ sidebar <- function(input, output, session, surveyData, surveyDataValidator, nvc # Reactively update DCA survey quadrat selection options ------------------ observe({ + surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long + if(is.null(mvaLocalRefRestrictedResults()) == FALSE){ - uniq_years <- surveyData() |> + uniq_years <- surveyData_long |> dplyr::pull(Year) |> unique() - uniq_quadrats <- surveyData() |> + uniq_quadrats <- surveyData_long |> dplyr::pull(Quadrat) |> unique() - uniq_groups <- surveyData() |> + uniq_groups <- surveyData_long |> dplyr::pull(Group) |> unique() @@ -532,8 +535,9 @@ sidebar <- function(input, output, session, surveyData, surveyDataValidator, nvc content = function(file) { surveyData <- surveyData() + surveyData_long <- surveyData$surveyData_long - write.csv(x = surveyData, file, row.names = FALSE, fileEncoding = "UTF-8") + write.csv(x = surveyData_long, file, row.names = FALSE, fileEncoding = "UTF-8") } ) diff --git a/report/Report.Rmd b/report/Report.Rmd index a4a7a8f..ffc73cd 100644 --- a/report/Report.Rmd +++ b/report/Report.Rmd @@ -141,7 +141,7 @@ reportOptions_options <- list(`NVC Assignment` = c("Site, Czekanowski" = "nvcAss ```{r RMAVISVersion, echo=FALSE, message=FALSE, warning=FALSE, results='asis'} -cat("**Version:** ", as.character("v0.96"), sep = "") +cat("**Version:** ", as.character("v0.97"), sep = "") ``` @@ -170,8 +170,11 @@ cat("**Date & Time:** ", as.character(format(Sys.time(), "%Y-%m-%d %H:%M:%S")), \newpage # Introduction + This report contains user-selected outputs of a RMAVIS application session. +## Main Options + ```{r inputMethod, echo=FALSE, message=FALSE, warning=FALSE, results='asis'} cat("**Input Method:** ", as.character(inputMethod), sep = "") ``` @@ -196,7 +199,9 @@ cat("**Habitat Restriction:** ", as.character(habitatRestriction), sep = "") cat("**Number of Top Results:** ", as.character(nTopResults), sep = "") ``` -The selected outputs are shown in Table \@ref(tab:selectedOutputs). +## Selected Outputs + +The report outputs selected by the app user are shown in Table \@ref(tab:selectedOutputs). ```{r selectedOutputs, echo=FALSE, message=FALSE, warning=FALSE, results='asis'} reportOptions_options_named_df <- stack(lapply(reportOptions_options, names)) |> diff --git a/www/documentation.html b/www/documentation.html index 65be9d0..b233502 100644 --- a/www/documentation.html +++ b/www/documentation.html @@ -260,7 +260,7 @@

    RMAVIS - Documentation

    -

    v0.96

    +

    v0.97

    @@ -713,6 +713,15 @@

    2.9.4 Options

    National Reference Spaces

    Here the user may select any NVC community to display in the National Reference MVA plot only.

    +

    Group Survey Plots

    +

    Three options are available to ‘group’ the survey quadrat/plot data:

    +
      +
    • No, the individual plots are left ungrouped.
      • +
    • Group, mean DCA axis scores are calculated from the individual plots +by group.
      • +
    • Year, mean DCA axis scores are calculated from the individual plots +by year.
      • +

    Survey Quadrat Selection

    Three methods are available for subsetting the survey quadrats being displayed:

    @@ -746,6 +755,7 @@

    2.9.4 Options

  • Survey Quadrats, the survey quadrats entered in Survey Data.
  • Pseudo-Quadrats, all pseudo-quadrats used in the DCA ordination.
  • Reference Space, the convex hulls formed around the pseudo-quadrats.
    • +
  • Reference Centroids, the centroids formed from the pseudo-quadrat DCA scores.
  • Species, the species DCA axis scores.
  • Unique Survey Species, the species present in the survey quadrats but absent in the top-fitted NVC communities pseudo-quadrats. @@ -981,7 +991,7 @@

    4 Reccomended Citation

    @misc{marshall2024,
   author = {Marshall, Z. and Smart, S. and Harrower, C.},
   title = {RMAVIS},
-  howpublished = {Available at https://connect-apps.ceh.ac.uk/RMAVIS/, version 0.96},
+  howpublished = {Available at https://connect-apps.ceh.ac.uk/RMAVIS/, version 0.97},
   month = {02},
   year  = {2024},
   note = {A R Shiny application for the assignment of vegetation survey data to National Vegetation Classification (NVC) communities, with additional exploratory analyses.}
@@ -991,6 +1001,21 @@ 
    4 Reccomended Citation
    
 
    5 Release Log
    
 
    
 
+v0.97
+
+
    2024/03/XX
    
+
      
+
    • Modifications: NA
      • 
+
    • Fixes:
+
        
+
      • Updating documentation to reflect new MVA functionality.
        • 
+
      • Fixing group survey plots option in MVA module.
        • 
+
      • 
+
    • New Features: NA
      • 
+
    
+
    
+
    
+
 v0.96
 
 
    2024/03/02