Adding surveyTableSummary module

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)
-
-}
-
 

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)
+
+}

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)
 

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**
 

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)
 

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)
   # 
   # })