From f9361a7e1fb360836d1cca31320e60ce1364d5a8 Mon Sep 17 00:00:00 2001 From: ZekeMarshall Date: Thu, 18 Jan 2024 17:08:49 +0000 Subject: [PATCH] Adding surveyTableSummary module --- R/functions.R | 36 --- R/inverse_distance_metric.R | 3 - R/syntopicTable_functions.R | 33 +++ app.R | 5 +- {R => data-raw}/create_logo.R | 0 docs/documentation.Rmd | 12 +- modules/floristicTables_server.R | 79 +---- modules/server.R | 31 +- modules/speciesDataAvailability_server.R | 0 modules/speciesDataAvailability_ui.R | 0 modules/surveyTableSummary_server.R | 351 +++++++++++++++++++++++ modules/surveyTableSummary_ui.R | 66 +++++ modules/surveyTableValidator_server.R | 194 +------------ modules/surveyTableValidator_ui.R | 29 -- modules/ui.R | 12 + www/documentation.html | 11 +- 16 files changed, 507 insertions(+), 355 deletions(-) delete mode 100644 R/inverse_distance_metric.R create mode 100644 R/syntopicTable_functions.R rename {R => data-raw}/create_logo.R (100%) delete mode 100644 modules/speciesDataAvailability_server.R delete mode 100644 modules/speciesDataAvailability_ui.R create mode 100644 modules/surveyTableSummary_server.R create mode 100644 modules/surveyTableSummary_ui.R diff --git a/R/functions.R b/R/functions.R index 2f23b4e..f7a8199 100644 --- a/R/functions.R +++ b/R/functions.R @@ -16,40 +16,4 @@ # Calculate mean EIVs using surveyTable -# Compose floristic tables from surveyTable -composeSyntopicTables <- function(surveyTable){ - - syntopicTables <- surveyTable |> - # tidyr::unite(col = "ID", c("Year", "Group"), sep = " - ", remove = TRUE) |> - dplyr::mutate("ID" = as.character(Year)) |> - dplyr::select(-Year, -Group) |> - dplyr::select(-Cover) |> - dplyr::mutate("Present" = 1) |> - tidyr::pivot_wider(id_cols = c(ID, Species), - values_from = Present, - names_from = Quadrat) |> - dplyr::rowwise() |> - dplyr::mutate("Sum" = sum(dplyr::c_across(dplyr::where(is.numeric)), na.rm = TRUE)) |> - dplyr::ungroup() |> - dplyr::mutate("Frequency" = Sum / (ncol(dplyr::pick(dplyr::everything())) - 3)) |> # -2 - dplyr::select(ID, Species, Sum, Frequency) |> - dplyr::mutate( - "Constancy" = - dplyr::case_when( - Frequency <= 0.2 ~ "I", - Frequency <= 0.4 ~ "II", - Frequency <= 0.6 ~ "III", - Frequency <= 0.8 ~ "IV", - Frequency <= 1.0 ~ "V", - TRUE ~ as.character(Frequency) - ) - ) |> - dplyr::select(ID, Species, Constancy) |> - dplyr::mutate("Constancy" = factor(Constancy, levels = c("V", "IV", "III", "II", "I"))) |> - dplyr::arrange(ID, Constancy, Species) - - return(syntopicTables) - -} - \ No newline at end of file diff --git a/R/inverse_distance_metric.R b/R/inverse_distance_metric.R deleted file mode 100644 index d332606..0000000 --- a/R/inverse_distance_metric.R +++ /dev/null @@ -1,3 +0,0 @@ -# Calculate the mean position of a group of quadrats in the DCA space - -# Calculate the Inverse Distance Metric of a quadrat using pseudo-quadrats \ No newline at end of file diff --git a/R/syntopicTable_functions.R b/R/syntopicTable_functions.R new file mode 100644 index 0000000..0fb5fda --- /dev/null +++ b/R/syntopicTable_functions.R @@ -0,0 +1,33 @@ +# Compose floristic tables from surveyTable +composeSyntopicTables <- function(surveyTable, group_cols, species_col_name = "Species", releve_col_name = "Quadrat"){ + + syntopicTables <- surveyTable |> + tidyr::unite(col = "ID", group_cols, sep = " - ", remove = TRUE) |> + dplyr::select(ID, releve_col_name, species_col_name) |> + dplyr::mutate("Present" = 1) |> + tidyr::pivot_wider(id_cols = c(ID, species_col_name), + values_from = Present, + names_from = releve_col_name) |> + dplyr::rowwise() |> + dplyr::mutate("Sum" = sum(dplyr::c_across(dplyr::where(is.numeric)), na.rm = TRUE)) |> + dplyr::ungroup() |> + dplyr::mutate("Frequency" = Sum / (ncol(dplyr::pick(dplyr::everything())) - 3)) |> # -2 + dplyr::select(ID, species_col_name, Sum, Frequency) |> + dplyr::mutate( + "Constancy" = + dplyr::case_when( + Frequency <= 0.2 ~ "I", + Frequency <= 0.4 ~ "II", + Frequency <= 0.6 ~ "III", + Frequency <= 0.8 ~ "IV", + Frequency <= 1.0 ~ "V", + TRUE ~ as.character(Frequency) + ) + ) |> + dplyr::select(ID, species_col_name, Constancy) |> + dplyr::mutate("Constancy" = factor(Constancy, levels = c("V", "IV", "III", "II", "I"))) |> + dplyr::arrange(ID, Constancy, species_col_name) + + return(syntopicTables) + +} \ No newline at end of file diff --git a/app.R b/app.R index 7bfbf5a..07ab0de 100644 --- a/app.R +++ b/app.R @@ -8,7 +8,7 @@ source("R/create_constants.R", local = TRUE) source("R/render_docs.R", local = TRUE) # Source functions -------------------------------------------------------- -source("R/functions.R", local = TRUE) +source("R/syntopicTable_functions.R", local = TRUE) source("R/similarity_functions.R", local = TRUE) source("R/reactable_functions.R", local = TRUE) @@ -32,6 +32,9 @@ source("modules/surveyTable_server.R", local = TRUE) source("modules/surveyTableValidator_ui.R", local = TRUE) source("modules/surveyTableValidator_server.R", local = TRUE) +source("modules/surveyTableSummary_ui.R", local = TRUE) +source("modules/surveyTableSummary_server.R", local = TRUE) + source("modules/surveyTableWide_ui.R", local = TRUE) source("modules/surveyTableWide_server.R", local = TRUE) diff --git a/R/create_logo.R b/data-raw/create_logo.R similarity index 100% rename from R/create_logo.R rename to data-raw/create_logo.R diff --git a/docs/documentation.Rmd b/docs/documentation.Rmd index 1416c45..3d3d698 100644 --- a/docs/documentation.Rmd +++ b/docs/documentation.Rmd @@ -176,15 +176,13 @@ In MAVIS NVC community similarities were assigned to survey data based on the the Czekanowski index [@bloom1981; @hill1989], which quantifies the similarity between a floristic table composed from survey data and the NVC floristic tables. -In pseudoMAVIS NVC community similarities are assigned to the survey -data based on the Jaccard similarity between user-inputted sample -quadrats and a set of pseudo-quadrats generated from the NVC floristic tables. +In pseudoMAVIS the Czekanowski index method is also used, however the primary +and reccomended method is the Jaccard similarity. Which is calculated +between user-inputted sample quadrats and a set of pseudo-quadrats generated +from the NVC floristic tables. This approach is noted as improving the accuracy of fit relative to the Czekanowski index for samples with low species richness [@tipping2013]. -Future development of pseudoMAVIS may incorporate the Czekanowski index -and other ecological resemblance metrics to aid in the NVC Assignment process. - ### Communities The NVC communities available in pseudoMAVIS are composed from the following @@ -210,6 +208,8 @@ Three sets of NVC assignment results are available in pseudoMAVIS at present: - Site, Pseudo-quadrat - Group, Pseudo-quadrat - Quadrat, Pseudo-quadrat +- Site, Czekanowski +- Group, Czekanowski **Restrict Habitat** diff --git a/modules/floristicTables_server.R b/modules/floristicTables_server.R index 41c297f..af87d9d 100644 --- a/modules/floristicTables_server.R +++ b/modules/floristicTables_server.R @@ -56,81 +56,24 @@ floristicTables <- function(input, output, session, surveyTable, surveyTableVali shiny::req(surveyTable()) surveyTable <- surveyTable() - - surveyTable_prepped <- surveyTable |> - tidyr::unite(col = "ID", c("Year", "Group"), sep = " - ", remove = TRUE) floristicTables_composed_all <- data.frame("ID" = character(), "Species" = character(), "Constancy" = factor()) - # assign(x = "surveyTable_prepped", value = surveyTable_prepped, envir = .GlobalEnv) - # Create composed floristic tables across all groups ---------------------- - floristicTables_composed <- surveyTable_prepped |> - # dplyr::filter(!is.na(Cover)) |> - dplyr::mutate("ID" = stringr::str_extract(string = ID, pattern = "(\\d{4})")) |> - dplyr::select(-Cover) |> - dplyr::mutate("Present" = 1) |> - tidyr::pivot_wider(values_from = Present, - names_from = Quadrat) |> - dplyr::rowwise() |> - dplyr::mutate("Sum" = sum(dplyr::c_across(dplyr::where(is.numeric)), na.rm = TRUE)) |> - dplyr::ungroup() |> - dplyr::mutate("Frequency" = Sum / (ncol(dplyr::pick(dplyr::everything())) - 3)) |> # -2 - dplyr::mutate( - "Constancy" = - dplyr::case_when( - Frequency <= 0.2 ~ "I", - Frequency <= 0.4 ~ "II", - Frequency <= 0.6 ~ "III", - Frequency <= 0.8 ~ "IV", - Frequency <= 1.0 ~ "V", - TRUE ~ as.character(Frequency) - ) - ) |> - dplyr::select(ID, Species, Constancy) |> - dplyr::mutate("Constancy" = factor(Constancy, levels = c("V", "IV", "III", "II", "I"))) |> - dplyr::arrange(ID, Constancy, Species) - - floristicTables_composed_all <- floristicTables_composed_all |> - dplyr::bind_rows(floristicTables_composed) - - -# Create composed floristic tables for groups ----------------------------- - for(id in unique(surveyTable_prepped$ID)){ - - floristicTables_composed <- surveyTable_prepped |> - dplyr::filter(ID == id) |> - # dplyr::filter(!is.na(Cover)) |> - dplyr::select(-Cover) |> - dplyr::mutate("Present" = 1) |> - tidyr::pivot_wider(values_from = Present, - names_from = Quadrat) |> - dplyr::rowwise() |> - dplyr::mutate("Sum" = sum(dplyr::c_across(dplyr::where(is.numeric)), na.rm = TRUE)) |> - dplyr::ungroup() |> - dplyr::mutate("Frequency" = Sum / (ncol(dplyr::pick(dplyr::everything())) - 3)) |> # -2 - dplyr::mutate( - "Constancy" = - dplyr::case_when( - Frequency <= 0.2 ~ "I", - Frequency <= 0.4 ~ "II", - Frequency <= 0.6 ~ "III", - Frequency <= 0.8 ~ "IV", - Frequency <= 1.0 ~ "V", - TRUE ~ as.character(Frequency) - ) - ) |> - dplyr::select(ID, Species, Constancy) |> - dplyr::mutate("Constancy" = factor(Constancy, levels = c("V", "IV", "III", "II", "I"))) |> - dplyr::arrange(ID, Constancy, Species) - - floristicTables_composed_all <- floristicTables_composed_all |> - dplyr::bind_rows(floristicTables_composed) - - } + floristicTables_composed_year_group <- composeSyntopicTables(surveyTable = surveyTable, + group_cols = c("Year", "Group"), + species_col_name = "Species", + releve_col_name = "Quadrat") + + floristicTables_composed_year <- composeSyntopicTables(surveyTable = surveyTable, + group_cols = c("Year"), + species_col_name = "Species", + releve_col_name = "Quadrat") + + floristicTables_composed_all <- rbind(floristicTables_composed_year, floristicTables_composed_year_group) floristicTables_composed_all_rval(floristicTables_composed_all) diff --git a/modules/server.R b/modules/server.R index 626bbbd..6c67464 100644 --- a/modules/server.R +++ b/modules/server.R @@ -26,6 +26,10 @@ server <- function(input, output, session) { surveyTable = surveyTable, sidebar_options = sidebar_options) + surveyTableSummary <- shiny::callModule(module = surveyTableSummary, + id = "surveyTableSummary_id_1", + surveyTable = surveyTable) + surveyTableWide <- shiny::callModule(module = surveyTableWide, id = "surveyTableWide_id_1", surveyTable = surveyTable, @@ -104,20 +108,19 @@ 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 = "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) - # + # # 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 = "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/modules/speciesDataAvailability_server.R b/modules/speciesDataAvailability_server.R deleted file mode 100644 index e69de29..0000000 diff --git a/modules/speciesDataAvailability_ui.R b/modules/speciesDataAvailability_ui.R deleted file mode 100644 index e69de29..0000000 diff --git a/modules/surveyTableSummary_server.R b/modules/surveyTableSummary_server.R new file mode 100644 index 0000000..e148fda --- /dev/null +++ b/modules/surveyTableSummary_server.R @@ -0,0 +1,351 @@ +surveyTableSummary <- function(input, output, session, surveyTable) { + + ns <- session$ns + + # Create Survey Data Structure Table data ------------------------------ + surveyTableStructure_rval <- reactiveVal() + + observe({ + + shiny::req(surveyTable()) + + surveyTable <- surveyTable() + + # Create a list of dataframes containing the number of quadrats, per group, per year + quadratsPerYear <- surveyTable |> + dplyr::select(Year, Group, Quadrat) |> + dplyr::distinct() |> + dplyr::group_by(Year) |> + dplyr::summarise(quadratsPerYear = dplyr::n()) + + quadratsPerYearGroup <- surveyTable |> + dplyr::select(Year, Group, Quadrat) |> + dplyr::distinct() |> + dplyr::group_by(Year, Group) |> + dplyr::summarise(quadratsPerYearGroup = dplyr::n()) + + quadratsPerYearID <- quadratsPerYear |> + dplyr::mutate("ID" = Year, .before = "Year", .keep = "unused") |> + dplyr::select("ID" = ID, + "n" = quadratsPerYear) + + quadratsPerYearGroupID <- quadratsPerYearGroup |> + tidyr::unite(col = "ID", c(Year, Group), sep = " - ", remove = TRUE) |> + dplyr::select("ID" = ID, + "n" = quadratsPerYearGroup) + + quadratsPerID <- rbind(quadratsPerYearID, quadratsPerYearGroupID) + + surveyTable_quadratsPerYearGroup <- list("quadratsPerYear" = quadratsPerYear, + "quadratsPerYearGroup" = quadratsPerYearGroup, + "quadratsPerID" = quadratsPerID) + + surveyTableStructure_rval(surveyTable_quadratsPerYearGroup) + + }) |> + bindEvent(surveyTable(), + ignoreInit = TRUE, + ignoreNULL = TRUE) + + # Create Species Data Availability Table data ---------------------------- + speciesDataAvailability_rval <- reactiveVal() + + observe({ + + shiny::req(surveyTable()) + + surveyTable <- surveyTable() + + speciesDataAvailability <- surveyTable |> + dplyr::select("Species") |> + dplyr::distinct() |> + dplyr::mutate( + "Hill-Ellenberg" = + dplyr::case_when( + Species %in% unique(dplyr::filter(master_data, !is.na(`F`)) |> dplyr::pull(species)) ~ "Yes", + TRUE ~ as.character("No") + ) + ) |> + dplyr::mutate( + "NVC" = + dplyr::case_when( + Species %in% unique(nvc_floristic_tables$Species) ~ "Yes", + TRUE ~ as.character("No") + ) + ) + + + speciesDataAvailability_rval(speciesDataAvailability) + + }) |> + bindEvent(surveyTable(), + ignoreInit = TRUE, + ignoreNULL = TRUE) + + # Initialise speciesDataAvailability Table ------------------------------ + speciesDataAvailabilityTable_init <- data.frame("Species" = integer(), + "Hill-Ellenberg" = character(), + "NVC" = character() + ) + + speciesDataAvailabilityTable_rval <- reactiveVal(speciesDataAvailabilityTable_init) + + output$speciesDataAvailabilityTable <- reactable::renderReactable({ + + speciesDataAvailabilityTable <- reactable::reactable(data = speciesDataAvailabilityTable_init, + filterable = FALSE, + pagination = FALSE, + highlight = TRUE, + bordered = TRUE, + sortable = TRUE, + wrap = FALSE, + resizable = TRUE, + style = list(fontSize = "1rem"), + class = "my-tbl", + # style = list(fontSize = "1rem"), + rowClass = "my-row", + defaultColDef = reactable::colDef( + format = reactable::colFormat(digits = 0), + headerClass = "my-header", + class = "my-col", + align = "center" # Needed as alignment is not passing through to header + ) + ) + + return(speciesDataAvailabilityTable) + + }) + + + # Initialise quadratsPerYear Table ---------------------------------------- + quadratsPerYearTable_init <- data.frame("Year" = integer(), + "n" = numeric() + ) + + quadratsPerYearTable_rval <- reactiveVal(quadratsPerYearTable_init) + + output$quadratsPerYearTable <- reactable::renderReactable({ + + quadratsPerYearTable <- reactable::reactable(data = quadratsPerYearTable_init, + filterable = FALSE, + pagination = FALSE, + highlight = TRUE, + bordered = TRUE, + sortable = TRUE, + wrap = FALSE, + resizable = TRUE, + style = list(fontSize = "1rem"), + class = "my-tbl", + # style = list(fontSize = "1rem"), + rowClass = "my-row", + defaultColDef = reactable::colDef( + format = reactable::colFormat(digits = 0), + headerClass = "my-header", + class = "my-col", + align = "center" # Needed as alignment is not passing through to header + )) + + return(quadratsPerYearTable) + + }) + + # Initialise quadratsPerYearGroup Table ----------------------------------- + quadratsPerYearGroupTable_init <- data.frame("Year" = integer(), + "Group" = character(), + "n" = numeric() + ) + + quadratsPerYearGroupTable_rval <- reactiveVal(quadratsPerYearGroupTable_init) + + output$quadratsPerYearGroupTable <- reactable::renderReactable({ + + quadratsPerYearGroupTable <- reactable::reactable(data = quadratsPerYearGroupTable_init, + filterable = FALSE, + pagination = FALSE, + highlight = TRUE, + bordered = TRUE, + sortable = TRUE, + wrap = FALSE, + resizable = TRUE, + style = list(fontSize = "1rem"), + class = "my-tbl", + # style = list(fontSize = "1rem"), + rowClass = "my-row", + defaultColDef = reactable::colDef( + format = reactable::colFormat(digits = 0), + headerClass = "my-header", + class = "my-col", + align = "center" # Needed as alignment is not passing through to header + )) + + return(quadratsPerYearGroupTable) + + }) + + + # Update quadratsPerYear Table -------------------------------------------- + observe({ + + req(surveyTableStructure_rval()) + + quadratsPerYear <- surveyTableStructure_rval()$quadratsPerYear |> + dplyr::mutate("n" = quadratsPerYear, .keep = "unused") + + output$quadratsPerYearTable <- reactable::renderReactable({ + + quadratsPerYearTable <- reactable::reactable(data = quadratsPerYear, + filterable = FALSE, + pagination = FALSE, + highlight = TRUE, + bordered = TRUE, + sortable = TRUE, + wrap = FALSE, + resizable = TRUE, + style = list(fontSize = "1rem"), + class = "my-tbl", + # style = list(fontSize = "1rem"), + rowClass = "my-row", + defaultColDef = reactable::colDef( + format = reactable::colFormat(digits = 0), + headerClass = "my-header", + class = "my-col", + align = "center" # Needed as alignment is not passing through to header + )) + + return(quadratsPerYearTable) + + }) + + }) |> + bindEvent(surveyTableStructure_rval(), + ignoreInit = TRUE, + ignoreNULL = TRUE) + + + # Update quadratsPerYearGroup Table --------------------------------------- + observe({ + + req(surveyTableStructure_rval()) + + quadratsPerYearGroup <- surveyTableStructure_rval()$quadratsPerYearGroup|> + dplyr::mutate("n" = quadratsPerYearGroup, .keep = "unused") + + output$quadratsPerYearGroupTable <- reactable::renderReactable({ + + quadratsPerYearGroupTable <- reactable::reactable(data = quadratsPerYearGroup, + filterable = FALSE, + pagination = FALSE, + highlight = TRUE, + bordered = TRUE, + sortable = TRUE, + wrap = FALSE, + resizable = TRUE, + style = list(fontSize = "1rem"), + class = "my-tbl", + # style = list(fontSize = "1rem"), + rowClass = "my-row", + defaultColDef = reactable::colDef( + format = reactable::colFormat(digits = 0), + headerClass = "my-header", + class = "my-col", + align = "center" # Needed as alignment is not passing through to header + )) + + return(quadratsPerYearGroupTable) + + }) + + }) |> + bindEvent(surveyTableStructure_rval(), + ignoreInit = TRUE, + ignoreNULL = TRUE) + + # Update speciesDataAvailability Table ---------------------------------- + observe({ + + req(speciesDataAvailability_rval()) + + speciesDataAvailability <- speciesDataAvailability_rval() + + output$speciesDataAvailabilityTable <- reactable::renderReactable({ + + speciesDataAvailabilityTable <- reactable::reactable(data = speciesDataAvailability, + height = 300, + filterable = FALSE, + pagination = FALSE, + highlight = TRUE, + bordered = TRUE, + sortable = TRUE, + wrap = FALSE, + resizable = TRUE, + style = list(fontSize = "1rem"), + class = "my-tbl", + # style = list(fontSize = "1rem"), + rowClass = "my-row", + defaultColDef = reactable::colDef( + format = reactable::colFormat(digits = 0), + headerClass = "my-header", + class = "my-col", + align = "center" # Needed as alignment is not passing through to header + ), + columns = list( + `Species` = reactable::colDef( + format = reactable::colFormat(digits = 0), + filterable = TRUE, + filterMethod = reactable::JS("function(rows, columnId, filterValue) { + return rows.filter(function(row) { + return row.values[columnId] == filterValue + }) + }") + ), + `Hill-Ellenberg` = reactable::colDef( + format = reactable::colFormat(digits = 0), + filterable = TRUE, + filterMethod = reactable::JS("function(rows, columnId, filterValue) { + return rows.filter(function(row) { + return row.values[columnId] == filterValue + }) + }") + ), + `NVC` = reactable::colDef( + format = reactable::colFormat(digits = 0), + filterable = TRUE, + filterMethod = reactable::JS("function(rows, columnId, filterValue) { + return rows.filter(function(row) { + return row.values[columnId] == filterValue + }) + }") + ) + )) + + return(speciesDataAvailabilityTable) + + }) + + }) |> + bindEvent(speciesDataAvailability_rval(), + ignoreInit = TRUE, + ignoreNULL = TRUE) + + + # Compose Data Object to Return ------------------------------------------- + surveyTableSummary_rval <- reactiveVal() + + observe({ + + surveyTableSummary <- list( + "surveyTableStructure" = surveyTableStructure_rval() + ) + + # print(surveyTableValidatorData) + + surveyTableSummary_rval(surveyTableSummary) + + }) |> + bindEvent(surveyTableStructure_rval(), + ignoreInit = TRUE, + ignoreNULL = TRUE) + + return(surveyTableSummary_rval) + +} \ No newline at end of file diff --git a/modules/surveyTableSummary_ui.R b/modules/surveyTableSummary_ui.R new file mode 100644 index 0000000..16f659b --- /dev/null +++ b/modules/surveyTableSummary_ui.R @@ -0,0 +1,66 @@ +surveyTableSummaryUI <- function(id){ + + ns <- NS(id) + + shiny::fluidRow( + shiny::column( + width = 12, + + shiny::h5("Data Structure"), + + # shiny::div(shiny::br()), + + shiny::markdown( + " + A sample size of at least five quadrats are reccomended per group and per year. + Smaller sample sizes may result in inaccuracies in + the NVC assignment process and the composition of representative floristic tables. + Below the number of quadrats per year, along with the number of quadrats per group and year are displayed. + + " + ), + + shiny::div(shiny::br()), + + shiny::div( + reactable::reactableOutput(outputId = ns("quadratsPerYearTable")) + ), + + shiny::div(shiny::br()), + + shiny::div( + reactable::reactableOutput(outputId = ns("quadratsPerYearGroupTable")) + ), + + shiny::div(shiny::br()), + + shiny::h5("Species Data Availability"), + + # shiny::div(shiny::br()), + + shiny::markdown( + " + Below the availability of data for each species is displayed, + two datasets are currently used: Hill-Ellenberg values and the NVC Floristic + tables. + + If there are no Hill-Ellenberg values for a species that species does + not contribute to the mean Hill-Ellenberg values calculated for each + Quadrat, Group, and Site; or the CCA scores found in the MVA section. + + If a species is not present in the NVC Floristic tables it still + contributes to (dis)similarity metrics used in the NVC assignment process. + " + ), + + shiny::div(shiny::br()), + + shiny::div( + reactable::reactableOutput(outputId = ns("speciesDataAvailabilityTable")) + ), + + shiny::div(shiny::br()) + + ) + ) +} \ No newline at end of file diff --git a/modules/surveyTableValidator_server.R b/modules/surveyTableValidator_server.R index 7b6ab70..d173c81 100644 --- a/modules/surveyTableValidator_server.R +++ b/modules/surveyTableValidator_server.R @@ -489,197 +489,6 @@ surveyTableValidator <- function(input, output, session, surveyTable, sidebar_op ignoreInit = TRUE, ignoreNULL = TRUE) - - -# Create Survey Data Structure Table -------------------------------------- - surveyTableStructure_rval <- reactiveVal() - - observe({ - - shiny::req(surveyTable()) - - surveyTable <- surveyTable() - - # Create a list of dataframes containing the number of quadrats, per group, per year - quadratsPerYear <- surveyTable |> - dplyr::select(Year, Group, Quadrat) |> - dplyr::distinct() |> - dplyr::group_by(Year) |> - dplyr::summarise(quadratsPerYear = dplyr::n()) - - quadratsPerYearGroup <- surveyTable |> - dplyr::select(Year, Group, Quadrat) |> - dplyr::distinct() |> - dplyr::group_by(Year, Group) |> - dplyr::summarise(quadratsPerYearGroup = dplyr::n()) - - quadratsPerYearID <- quadratsPerYear |> - dplyr::mutate("ID" = Year, .before = "Year", .keep = "unused") |> - dplyr::select("ID" = ID, - "n" = quadratsPerYear) - - quadratsPerYearGroupID <- quadratsPerYearGroup |> - tidyr::unite(col = "ID", c(Year, Group), sep = " - ", remove = TRUE) |> - dplyr::select("ID" = ID, - "n" = quadratsPerYearGroup) - - quadratsPerID <- rbind(quadratsPerYearID, quadratsPerYearGroupID) - - surveyTable_quadratsPerYearGroup <- list("quadratsPerYear" = quadratsPerYear, - "quadratsPerYearGroup" = quadratsPerYearGroup, - "quadratsPerID" = quadratsPerID) - - surveyTableStructure_rval(surveyTable_quadratsPerYearGroup) - - }) |> - bindEvent(surveyTable(), - ignoreInit = TRUE, - ignoreNULL = TRUE) - -# Initialise quadratsPerYear Table ---------------------------------------- - quadratsPerYearTable_init <- data.frame("Year" = integer(), - "n" = numeric() - ) - - quadratsPerYearTable_rval <- reactiveVal(quadratsPerYearTable_init) - - output$quadratsPerYearTable <- reactable::renderReactable({ - - quadratsPerYearTable <- reactable::reactable(data = quadratsPerYearTable_init, - filterable = FALSE, - pagination = FALSE, - highlight = TRUE, - bordered = TRUE, - sortable = TRUE, - wrap = FALSE, - resizable = TRUE, - style = list(fontSize = "1rem"), - class = "my-tbl", - # style = list(fontSize = "1rem"), - rowClass = "my-row", - defaultColDef = reactable::colDef( - format = reactable::colFormat(digits = 0), - headerClass = "my-header", - class = "my-col", - align = "center" # Needed as alignment is not passing through to header - )) - - return(quadratsPerYearTable) - - }) - -# Initialise quadratsPerYearGroup Table ----------------------------------- - quadratsPerYearGroupTable_init <- data.frame("Year" = integer(), - "Group" = character(), - "n" = numeric() - ) - - quadratsPerYearGroupTable_rval <- reactiveVal(quadratsPerYearGroupTable_init) - - output$quadratsPerYearGroupTable <- reactable::renderReactable({ - - quadratsPerYearGroupTable <- reactable::reactable(data = quadratsPerYearGroupTable_init, - filterable = FALSE, - pagination = FALSE, - highlight = TRUE, - bordered = TRUE, - sortable = TRUE, - wrap = FALSE, - resizable = TRUE, - style = list(fontSize = "1rem"), - class = "my-tbl", - # style = list(fontSize = "1rem"), - rowClass = "my-row", - defaultColDef = reactable::colDef( - format = reactable::colFormat(digits = 0), - headerClass = "my-header", - class = "my-col", - align = "center" # Needed as alignment is not passing through to header - )) - - return(quadratsPerYearGroupTable) - - }) - - -# Update quadratsPerYear Table -------------------------------------------- - observe({ - - req(surveyTableStructure_rval()) - - quadratsPerYear <- surveyTableStructure_rval()$quadratsPerYear |> - dplyr::mutate("n" = quadratsPerYear, .keep = "unused") - - output$quadratsPerYearTable <- reactable::renderReactable({ - - quadratsPerYearTable <- reactable::reactable(data = quadratsPerYear, - filterable = FALSE, - pagination = FALSE, - highlight = TRUE, - bordered = TRUE, - sortable = TRUE, - wrap = FALSE, - resizable = TRUE, - style = list(fontSize = "1rem"), - class = "my-tbl", - # style = list(fontSize = "1rem"), - rowClass = "my-row", - defaultColDef = reactable::colDef( - format = reactable::colFormat(digits = 0), - headerClass = "my-header", - class = "my-col", - align = "center" # Needed as alignment is not passing through to header - )) - - return(quadratsPerYearTable) - - }) - - }) |> - bindEvent(surveyTableStructure_rval(), - ignoreInit = TRUE, - ignoreNULL = TRUE) - - -# Update quadratsPerYearGroup Table --------------------------------------- - observe({ - - req(surveyTableStructure_rval()) - - quadratsPerYearGroup <- surveyTableStructure_rval()$quadratsPerYearGroup|> - dplyr::mutate("n" = quadratsPerYearGroup, .keep = "unused") - - output$quadratsPerYearGroupTable <- reactable::renderReactable({ - - quadratsPerYearGroupTable <- reactable::reactable(data = quadratsPerYearGroup, - filterable = FALSE, - pagination = FALSE, - highlight = TRUE, - bordered = TRUE, - sortable = TRUE, - wrap = FALSE, - resizable = TRUE, - style = list(fontSize = "1rem"), - class = "my-tbl", - # style = list(fontSize = "1rem"), - rowClass = "my-row", - defaultColDef = reactable::colDef( - format = reactable::colFormat(digits = 0), - headerClass = "my-header", - class = "my-col", - align = "center" # Needed as alignment is not passing through to header - )) - - return(quadratsPerYearGroupTable) - - }) - - }) |> - bindEvent(surveyTableStructure_rval(), - ignoreInit = TRUE, - ignoreNULL = TRUE) - - # Compose Data Object to Return ------------------------------------------- surveyTableValidatorData_rval <- reactiveVal() @@ -689,8 +498,7 @@ surveyTableValidator <- function(input, output, session, surveyTable, sidebar_op "adjustSpecies" = input$adjustSpecies, "combineDuplicates" = input$combineDuplicates, "speciesAdjustmentTable" = rhandsontable::hot_to_r(input$speciesAdjustmentTable), - "surveyTableValidation" = surveyTableValidation_rval(), - "surveyTableStructure" = surveyTableStructure_rval() + "surveyTableValidation" = surveyTableValidation_rval() ) # print(surveyTableValidatorData) diff --git a/modules/surveyTableValidator_ui.R b/modules/surveyTableValidator_ui.R index 8de1cde..f43d9b2 100644 --- a/modules/surveyTableValidator_ui.R +++ b/modules/surveyTableValidator_ui.R @@ -330,35 +330,6 @@ surveyTableValidatorUI <- function(id){ shiny::div( rhandsontable::rHandsontableOutput(outputId = ns("speciesAdjustmentTable")) # , height = "300px" - ), - - shiny::div(shiny::br()), - - shiny::h5("Data Structure"), - - shiny::div(shiny::br()), - - shiny::markdown( - " - A sample size of at least five quadrats are reccomended per group and per year. - Smaller sample sizes may result in inaccuracies in - the NVC assignment process and the composition of representative floristic tables. - - Below the number of quadrats per year, along with the number of quadrats per group and year are displayed. - - " - ), - - shiny::div(shiny::br()), - - shiny::div( - reactable::reactableOutput(outputId = ns("quadratsPerYearTable")) - ), - - shiny::div(shiny::br()), - - shiny::div( - reactable::reactableOutput(outputId = ns("quadratsPerYearGroupTable")) ) ) diff --git a/modules/ui.R b/modules/ui.R index 6209eaa..3f9d3ae 100644 --- a/modules/ui.R +++ b/modules/ui.R @@ -64,6 +64,18 @@ ui <- bslib::page_navbar( ), + bslib::nav_panel( + + full_screen = TRUE, + + bslib::card_header("Data Summary"), + + value = "surveyTableSummary_panel", + + surveyTableSummaryUI(id = "surveyTableSummary_id_1") + + ), + bslib::nav_panel( full_screen = TRUE, diff --git a/www/documentation.html b/www/documentation.html index 0f0f6e6..5527590 100644 --- a/www/documentation.html +++ b/www/documentation.html @@ -408,13 +408,12 @@

2.3 NVC Assignment

In MAVIS NVC community similarities were assigned to survey data based on the the Czekanowski index (Bloom 1981; Hill 1989), which quantifies the similarity between a floristic table composed from survey data and the NVC floristic tables.

-

In pseudoMAVIS NVC community similarities are assigned to the survey -data based on the Jaccard similarity between user-inputted sample -quadrats and a set of pseudo-quadrats generated from the NVC floristic tables. +

In pseudoMAVIS the Czekanowski index method is also used, however the primary +and reccomended method is the Jaccard similarity. Which is calculated +between user-inputted sample quadrats and a set of pseudo-quadrats generated +from the NVC floristic tables. This approach is noted as improving the accuracy of fit relative to the Czekanowski index for samples with low species richness (Tipping et al. 2013).

-

Future development of pseudoMAVIS may incorporate the Czekanowski index -and other ecological resemblance metrics to aid in the NVC Assignment process.

2.3.1 Communities

The NVC communities available in pseudoMAVIS are composed from the following @@ -440,6 +439,8 @@

2.3.2 Options

  • Site, Pseudo-quadrat
  • Group, Pseudo-quadrat
  • Quadrat, Pseudo-quadrat
    • +
  • Site, Czekanowski
    • +
  • Group, Czekanowski

    • Restrict Habitat

    Optionally restrict the NVC assignment process to one or more broad NVC habitat