SIPNET Initialization Code (carbon and nitrogen pool calculations)

modules/meta.analysis/inst/magic/Class_Subclass_Mapping.R

@@ -0,0 +1,64 @@
+library(readr)
+library(dplyr)
+
+# Create the mapping with proper structure
+mapping <- tibble::tribble(
+  ~CLASS, ~SUBCLASS, ~CLASS_desc, ~SUBCLASS_desc,
+  "C", "4", "Citrus and subtropical", "dates",
+  "C", "5", "Citrus and subtropical", "avocados",
+  "C", "6", "Citrus and subtropical", "olives",
+  "C", "7", "Citrus and subtropical", "miscellaneous subtropical fruits",
+  "C", "8", "Citrus and subtropical", "kiwis",
+  "D", "1", "Deciduous fruits and nuts", "apples",
+  "D", "3", "Deciduous fruits and nuts", "cherries",
+  "D", "5", "Deciduous fruits and nuts", "peaches and nectarines",
+  "D", "6", "Deciduous fruits and nuts", "pears",
+  "D", "10", "Deciduous fruits and nuts", "miscellaneous deciduous",
+  "D", "11", "Deciduous fruits and nuts", "mixed deciduous",
+  "D", "12", "Deciduous fruits and nuts", "almonds",
+  "D", "13", "Deciduous fruits and nuts", "walnuts",
+  "D", "14", "Deciduous fruits and nuts", "pistachios",
+  "D", "15", "Deciduous fruits and nuts", "pomegranates",
+  "D", "16", "Deciduous fruits and nuts", "plums prunes or apricots",
+  "F", "1", "Field crops", "cotton",
+  "F", "2", "Field crops", "safflower",
+  "F", "10", "Field crops", "beans",
+  "F", "11", "Field crops", "miscellaneous field",
+  "F", "12", "Field crops", "sunflowers",
+  "F", "16", "Field crops", "corn sorghum sudan",
+  "G", "2", "Grain and hay crops", "wheat",
+  "G", "6", "Grain and hay crops", "miscellaneous grain and hay",
+  "I", "2", "Idle", "new prepped for production",
+  "P", "1", "Pasture", "alfalfa and alfalfa mixtures",
+  "P", "3", "Pasture", "mixed pasture",
+  "P", "4", "Pasture", "native pasture",
+  "P", "6", "Pasture", "miscellaneous grasses",
+  "R", "1", "Rice", "rice",
+  "R", "2", "Rice", "wild rice",
+  "T", "4", "Truck, nursery, and berry crops", "cole crops",
+  "T", "6", "Truck, nursery, and berry crops", "carrots",
+  "T", "9", "Truck, nursery, and berry crops", "melons squash and cucumber",
+  "T", "10", "Truck, nursery, and berry crops", "onions and garlic",
+  "T", "12", "Truck, nursery, and berry crops", "potatoes",
+  "T", "15", "Truck, nursery, and berry crops", "tomatoes",
+  "T", "16", "Truck, nursery, and berry crops", "flowers nursery and christmas tree farms",
+  "T", "18", "Truck, nursery, and berry crops", "miscellaneous truck",
+  "T", "19", "Truck, nursery, and berry crops", "bush berries",
+  "T", "20", "Truck, nursery, and berry crops", "strawberries",
+  "T", "21", "Truck, nursery, and berry crops", "peppers",
+  "T", "27", "Truck, nursery, and berry crops", "greenhouse",
+  "T", "30", "Truck, nursery, and berry crops", "lettuce or leafy greens",
+  "T", "31", "Truck, nursery, and berry crops", "potato or sweet potato",
+  "V", "2", "Vineyards", "wine grapes",
+  "YP", NA, "Young perennial", NA
+)
+
+# Create lookup key
+mapping <- mapping %>%
+  mutate(key = paste0(CLASS, SUBCLASS))
+
+# Define lookup function
+get_crop_name <- function(code) {
+  out <- mapping$SUBCLASS_desc[mapping$key == code]
+  if (length(out) == 0) NA else out
+}

modules/meta.analysis/inst/magic/average_by_trait.R

@@ -0,0 +1,14 @@
+library(dplyr)
+
+average_by_trait <- function(group_df) {
+  summarized_df <- group_df %>%
+    group_by(TraitID) %>%
+    summarise(
+      mean_value = mean(mean_value, na.rm = TRUE),
+      mean_sd    = mean(sd, na.rm = TRUE),
+      mean_n     = mean(n, na.rm = TRUE),
+      .groups = "drop"
+    )
+
+  return(summarized_df)
+}

modules/meta.analysis/inst/magic/class_mapping.R

@@ -0,0 +1,81 @@
+group_to_class <- c(
+  # Citrus and subtropical
+  "dates" = "Citrus and subtropical",
+  "avocados" = "Citrus and subtropical",
+  "olives" = "Citrus and subtropical",
+  "miscellaneous subtropical fruits" = "Citrus and subtropical",
+  "kiwis" = "Citrus and subtropical",
+
+  # Deciduous fruits and nuts
+  "apples" = "Deciduous fruits and nuts",
+  "cherries" = "Deciduous fruits and nuts",
+  "peaches and nectarines" = "Deciduous fruits and nuts",
+  "pears" = "Deciduous fruits and nuts",
+  "miscellaneous deciduous" = "Deciduous fruits and nuts",
+  "mixed deciduous" = "Deciduous fruits and nuts",
+  "almonds" = "Deciduous fruits and nuts",
+  "walnuts" = "Deciduous fruits and nuts",
+  "pistachios" = "Deciduous fruits and nuts",
+  "pomegranates" = "Deciduous fruits and nuts",
+  "plums prunes or apricots" = "Deciduous fruits and nuts",
+
+  # Field crops
+  "cotton" = "Field crops",
+  "safflower" = "Field crops",
+  "beans" = "Field crops",
+  "miscellaneous field" = "Field crops",
+  "sunflowers" = "Field crops",
+  "corn sorghum sudan" = "Field crops",
+
+  # Grain and hay crops
+  "wheat" = "Grain and hay crops",
+  "miscellaneous grain and hay" = "Grain and hay crops",
+
+  # Pasture
+  "alfalfa and alfalfa mixtures" = "Pasture",
+  "mixed pasture" = "Pasture",
+  "native pasture" = "Pasture",
+  "miscellaneous grasses" = "Pasture",
+
+  # Rice
+  "rice" = "Rice",
+  "wild rice" = "Rice",
+
+  # Truck, nursery, and berry crops
+  "cole crops" = "Truck, nursery, and berry crops",
+  "carrots" = "Truck, nursery, and berry crops",
+  "melons squash and cucumber" = "Truck, nursery, and berry crops",
+  "onions and garlic" = "Truck, nursery, and berry crops",
+  "potatoes" = "Truck, nursery, and berry crops",
+  "tomatoes" = "Truck, nursery, and berry crops",
+  "flowers nursery and christmas tree farms" = "Truck, nursery, and berry crops",
+  "miscellaneous truck" = "Truck, nursery, and berry crops",
+  "bush berries" = "Truck, nursery, and berry crops",
+  "strawberries" = "Truck, nursery, and berry crops",
+  "peppers" = "Truck, nursery, and berry crops",
+  "greenhouse" = "Truck, nursery, and berry crops",
+  "lettuce or leafy greens" = "Truck, nursery, and berry crops",
+  "potato or sweet potato" = "Truck, nursery, and berry crops",
+
+  # Vineyards
+  "wine grapes" = "Vineyards",
+
+  # Young perennial
+  "NA" = "Young perennial"
+)
+
+map_group_to_class <- function(group_vec) {
+  class <- group_to_class[group_vec]
+  class[is.na(class)] <- "NA"
+  return(unname(class))
+}
+
+# Convert named vector to dataframe
+group_class_df <- data.frame(
+  group = names(group_to_class),
+  class = unname(group_to_class),
+  row.names = NULL,
+  stringsAsFactors = FALSE
+)
+
+

modules/meta.analysis/inst/magic/extract_rows_traitID.R

@@ -1,5 +1,6 @@
 library(readxl)
 library(dplyr)
+library(taxize)
 
 extract_rows_traitID <- function(excel_path, sheet_name = 1, trait_ID) {
 

modules/meta.analysis/inst/magic/find_default_species.R

@@ -0,0 +1,68 @@
+library(dplyr)
+library(rotl)
+library(ape)
+
+find_default_species <- function(target_species) {
+
+  clean_name <- function(x) {
+    x <- gsub("\\s+(sp\\.|cf\\.|var\\..*|subsp\\..*)", "", x)
+    x <- trimws(x)
+    return(x)
+  }
+
+  target_species <- clean_name(target_species)
+
+  # master_data must be in environment, with column AccSpeciesName
+  reference_species <- unique(master_data$AccSpeciesName)
+  reference_species <- sapply(reference_species, clean_name)
+  reference_species <- reference_species[reference_species != ""]
+
+  all_species <- unique(c(target_species, reference_species))
+  resolved <- tnrs_match_names(all_species)
+  resolved <- resolved[!is.na(resolved$ott_id), ]
+  resolved <- resolved[!is.na(resolved$pruned_ott_id), ]   # remove pruned taxa
+
+  if (nrow(resolved) == 0) return(NA)
+
+  if (!(target_species %in% resolved$search_string)) {
+    genus <- strsplit(target_species, " ")[[1]][1]
+    resolved_genus <- tnrs_match_names(genus)
+    resolved_genus <- resolved_genus[!is.na(resolved_genus$ott_id), ]
+    resolved_genus <- resolved_genus[!is.na(resolved_genus$pruned_ott_id), ]
+
+    if (nrow(resolved_genus) == 0) return(NA)
+
+    target_species <- resolved_genus$search_string[1]
+
+    if (!(target_species %in% resolved$search_string)) {
+      resolved <- rbind(resolved, resolved_genus[1, ])
+    }
+  }
+
+  ott_ids <- resolved$pruned_ott_id
+  name_map <- resolved$unique_name
+  names(name_map) <- resolved$search_string
+
+  # Build induced subtree - this should work without HTTP 400 errors now
+  tree <- tol_induced_subtree(ott_ids = ott_ids)
+
+  dist_matrix <- cophenetic(tree)
+
+  target_name <- name_map[target_species]
+  if (!(target_name %in% rownames(dist_matrix))) return(NA)
+
+  distances_to_target <- dist_matrix[target_name, ]
+  distances_to_target <- distances_to_target[names(distances_to_target) != target_name]
+
+  matched_reference <- reference_species[reference_species %in% resolved$search_string]
+  reference_names <- name_map[matched_reference]
+
+  distances_to_target <- distances_to_target[names(distances_to_target) %in% reference_names]
+
+  if (length(distances_to_target) == 0) return(NA)
+
+  closest_name <- names(which.min(distances_to_target))
+  original_closest <- names(name_map[name_map == closest_name])[1]
+
+  return(original_closest)
+}

modules/meta.analysis/inst/magic/find_same_class.R

@@ -0,0 +1,21 @@
+library(dplyr)
+
+find_same_class<- function(group_name) {
+  desired_class <- map_group_to_class(group_name)
+
+  if (is.na(desired_class)) {
+    return("Group name not found within class-mapping")
+  }
+
+  find_same_groups_in_class <- names(group_to_class[group_to_class == desired_class])
+
+  find_same_species_in_group <- names(genus_to_group[genus_to_group %in% find_same_groups_in_class])
+
+  master_genus <- sub(" .*", "", master_data$AccSpeciesName)
+  target_species <- master_data$AccSpeciesName[master_genus %in% find_same_species_in_group]
+  target_species <- unique(target_species)
+
+  return (target_species)
+
+}
+

modules/meta.analysis/inst/magic/find_same_group.R

@@ -0,0 +1,38 @@
+#sifts the species through the entire list of species within the master data and returns all similar related species by group
+library(dplyr)
+source("get_stats.R")
+
+
+find_same_group <- function(group_name) {
+  desired_group <- group_name
+
+  if (is.na(desired_group)) {
+    return("SpeciesName not found within genus_mapping")
+  }
+
+  list_fallback_species <- c()
+  for (i in master_data$AccSpeciesName) {
+    target_group <- map_species_to_group(i)
+    if (target_group == desired_group) {
+      list_fallback_species <- c(list_fallback_species, i)
+    }
+  }
+
+
+  stats_list <- list()
+  for (sp in list_fallback_species) {
+    single_stats <- get_stats(master_data,
+                              value_column = "OrigValueStr",
+                              trait_column = "TraitID",
+                              species_column = "AccSpeciesName",
+                              species_name = sp)
+    stats_list[[sp]] <- single_stats 
+  }
+
+  combined <- do.call(rbind, stats_list)
+
+  return (combined)
+
+
+}
+

modules/meta.analysis/inst/magic/find_same_group_stats.R

@@ -0,0 +1,38 @@
+#sifts the species through the entire list of species within the master data and returns all similar related species by group
+library(dplyr)
+source("get_stats.R")
+
+
+find_same_group_stats <- function(species_name) {
+  desired_group <- map_species_to_group(species_name)
+
+  if (is.na(desired_group)) {
+    return("SpeciesName not found within genus_mapping")
+  }
+
+  list_fallback_species <- c()
+  for (i in master_data$AccSpeciesName) {
+    target_group <- map_species_to_group(i)
+    if (target_group == desired_group) {
+      list_fallback_species <- c(list_fallback_species, i)
+    }
+  }
+
+
+  stats_list <- list()
+  for (sp in list_fallback_species) {
+    single_stats <- get_stats(master_data,
+                              value_column = "OrigValueStr",
+                              trait_column = "TraitID",
+                              species_column = "AccSpeciesName",
+                              species_name = sp)
+    stats_list[[sp]] <- single_stats 
+  }
+
+  combined <- do.call(rbind, stats_list)
+
+  return (combined)
+
+
+}
+

modules/meta.analysis/inst/magic/find_same_type.R

@@ -0,0 +1,25 @@
+# This is the file to find all the species within the same type
+library(dplyr)
+
+source("type_classing.R")
+
+find_same_type <- function(group_name) {
+  desired_type <- map_group_to_type(group_name)
+
+  if (is.na(desired_type) || desired_type == "NA") {
+    return("Group name is not within type mapping")
+  }
+
+  find_same_groups_in_type <- names(group_to_type[group_to_type == desired_type])
+
+  find_same_species_in_group <- names(genus_to_group[genus_to_group %in% find_same_groups_in_type])
+
+  master_genus <- sub(" .*", "", master_data$AccSpeciesName)
+  target_species <- master_data$AccSpeciesName[master_genus %in% find_same_species_in_group]
+  target_species <- unique(target_species)
+
+  return (target_species)
+
+
+}
+