StateKey: StateKey

In R-Burke/SiteSummaryTool: Ecological Site Summaries using Assessment, Inventory, and Monitoring (AIM) and Landscape Monitoring Framework (LMF) data

Description

Keys individual plots to ecological state based on quantitative key. Returns a dataframe with ecological states attributed to each plot.

Usage

StateKey(TerrADat_Path, Tall_Table_Path,
          StateKeyPath, StateKeyName, EDIT_List_Path,
          EcoSiteName, EcologicalSiteId, State, Degraded)

Arguments

TerrADat_Path	file path to the TerrADat geodatabase. Set to NULL if you are internal (within Bureau of Land Management network/vpn)
Tall_Table_Path	file path to R tall tables containing AIM&LMF data. These are necessary to calculate custom indicators.
StateKeyPath	file path to the Excel workbook that contains the general quantitative key and historic plant indicators.
StateKeyName	Name of the Excel workbook containing quantiative key and historic indicators.
EcoSiteName	General ecological site name, i.e. Sandy, Gravelly, etc.
EcologicalSiteId	Full ecological site id code
EDIT_List_Path	file path to the .csv with list of formal ecological site ids (on the sharepoint with Site Summary Tool template)
Internal	logical.TRUE if within BLM network/on vpn. FALSE if accessing TerrADat via external geodatabase.
State	2 letter state abbreviation (political/administrative state)
Degraded	logical. Degraded = FALSE will err on less degraded ecological state if there is a tie between 2 states. Degraded = TRUE will err on more degraded ecological state if there is a tie between 2 states.

Author(s)

Rachel Burke, ecologist/analyst @ Jornada

Examples

##---- Should be DIRECTLY executable !! ----
##-- ==>  Define data, use random,
##--	or do  help(data=index)  for the standard data sets.

## The function is currently defined as
function (x)
{ ### Set up custom indicator-
  ### This is list of species in "Historically Dominant" tab in generalized key sheet
  ### This tab is really the only thing that needs to be updated for sites in generalized key groups

  HistoricPlant_sheet <- paste("Hx", EcoSiteName, sep = " ")
  KeyIndicator_sheet <- "Key Indicators"
  GeneralKey_sheet <- "Generalized Key"
  TransitionRisk_sheet <- "Transition indicators"

  ### Need to gather tall tables if not already
  #terradactyl::gather_all(TerrADat_Path = TerrADat_Path, folder = Tall_Table_Path)


  ###   Read in LPI and header
  # Most recently run tall tables
  lpi <-  readRDS(paste(Tall_Table_Path , "lpi_tall.RData" , sep = ""))
  header <- readRDS(paste(Tall_Table_Path , "header.RData" , sep = ""))

  header_state <- header [(header[["State"]] 
  state_primarykeys <- header_state$PrimaryKey

  lpi_subset<- lpi[(lpi[["PrimaryKey"]] 

  ### Read in Historic Plants

  HxPlants <- readxl::read_excel(paste(StateKeyPath, StateKeyName, sep = "/"), sheet = paste("Hx", EcoSiteName, sep = " "))

  HxPlants <- HxPlants$Species

  ## Pull out everything in LPI with historic plant community present

  lpi_Hx <- lpi_subset[(lpi_subset[["code"]] 

  # Create a column named Historic and give it the value of Historic

  lpi_Hx$Historic <- "Historic"

  #Pull out everything without historic species

  lpi_NonHx <- lpi_subset[(!lpi_subset[["code"]] 

  # Create a column named Historic and give it value Non-Historic

  lpi_NonHx$Historic <- "Non-Historic"

  #Now bind them back together

  lpi_Hx_populated <- rbind(lpi_Hx , lpi_NonHx)

  #We need AH and FH because FH would indicate interspaces (see STM)

  Hx_AH <- terradactyl::pct_cover(lpi_tall = lpi_Hx_populated,
                                  tall = TRUE,
                                  hit = "any",
                                  by_year = FALSE,
                                  by_line = FALSE,
                                  Historic) # Group by historic plant variable (or other custom indicator in future)

  Hx_AH <- Hx_AH 

  Hx_FH <- terradactyl::pct_cover(lpi_tall = lpi_Hx_populated,
                                  tall = TRUE,
                                  hit = "first",
                                  by_year = FALSE,
                                  by_line = FALSE,
                                  Historic)

  Hx_FH <- Hx_FH 

  Hx_indicator <- merge(Hx_AH , Hx_FH , by = "PrimaryKey") 

  ## Now read in the data
  ## Must preload Combine_AIM_LMF function
  TDat_LMF <- SiteSummaryTool::Combine_AIM_LMF(TerrADat_Path = TerrADat_Path,
                                               EDIT_List_Path = EDIT_List_Path,
                                               Internal = FALSE)

  #Subset based on EcologicalSiteId

  EcoSitePlots <- TDat_LMF[TDat_LMF[["EcologicalSiteId"]] 

  # Pull primary keys from subsetted plots

  EcoSite_PKs <- EcoSitePlots$PrimaryKey

  ##Now we can bind the custom indicator with the full data set
  ## Note that at this point the full data set has been subset to the ecological site but the custom indicator has not.

  #Subset the custom indicator to the ecological site

  Hx_indicator<- Hx_indicator[(Hx_indicator[["PrimaryKey"]] 
  all(Hx_indicator$PrimaryKey 

  #Get the data into tall format so that it can be merged with the rest of the indicators
  Hx_tall <- tidyr::gather(Hx_indicator, key = Historic, value = Percent , 2:3)

  #### Pull in generalized key ####

  ## Read in Excel Key built from SDM
  GeneralizedKey <- readxl::read_excel(paste(StateKeyPath, StateKeyName, sep = "/"), sheet = "Generalized Key")

  ## These are the only indicators necessary to apply key logic
  KeyIndicators <- readxl::read_excel(paste(StateKeyPath, StateKeyName, sep = "/"), sheet = "Key Indicators")
  KeyIndicators <- unique(KeyIndicators$Indicator)

  # Trim the full dataset to just the key indicators

  FullDataTrim <- EcoSitePlots 
  col <- ncol(FullDataTrim)

  # Get tall

  FullData_Tall <- FullDataTrim 

  ## Now combine

  Hx_tall <- Hx_tall 
  FullData_PlusCustom <- rbind(FullData_Tall, Hx_tall)

  #Now we can join the full data set with the key and apply the key logic.
  Joined <- dplyr::full_join(FullData_PlusCustom, GeneralizedKey, by = c("Indicator"))

  #Adding the wide table to populate relative fields
  Joined_Populate <- dplyr::full_join(Joined, FullDataTrim, by = "PrimaryKey")

  #Pull unique values in Key, mutate values for relative values based on indicators

  Upper_unique <- unique(Joined_Populate$Upper.Limit)

  Lower_unique <- unique(Joined_Populate$Lower.Limit)
  names(Joined_Populate)

  Joined_Populated <- Joined_Populate 
                                                                               ifelse(Upper.Limit == "AH_NonNoxPerenGrassCover", AH_NonNoxPerenGrassCover, Upper.Limit)),
                                                        Lower_derived = ifelse(Lower.Limit == "AH_NonNoxShrubCover + AH_NonNoxSubShrubCover + AH_NonNoxAnnGrassCover + AH_NonNoxAnnForbCover + AH_NonNoxPerenForbCover",
                                                                               AH_NonNoxShrubCover + AH_NonNoxSubShrubCover + AH_NonNoxAnnGrassCover + AH_NonNoxAnnForbCover + AH_NonNoxPerenForbCover,
                                                                               ifelse(Lower.Limit == "AH_NonNoxShrubCover + AH_NonNoxSubShrubCover", AH_NonNoxShrubCover + AH_NonNoxSubShrubCover,
                                                                                      ifelse(Lower.Limit == "AH_NonNoxCover", AH_NonNoxCover,
                                                                                             ifelse(Lower.Limit == "FH_NonNoxPerenGrassCover", FH_NonNoxPerenGrassCover, Lower.Limit))))) 
    dplyr::select(-Lower.Limit, -Upper.Limit) 

  length(unique(Joined$PrimaryKey)) # Make sure no plots dropped

  # Paste the evaluation criteria into 2 columns

  Conditional_Paste <- Joined_Populated 

  eval_vars <- names(Conditional_Paste)[grep(names(Conditional_Paste) , pattern = "^Eval_")]

  ## Need to remove NA values (artifact of merging, joining)

  Conditional_Paste <- Conditional_Paste 

  benchmark_vector <- sapply(X = 1:nrow(Conditional_Paste),
                             data = Conditional_Paste,
                             eval_vars = eval_vars,
                             FUN = function(X, data, eval_vars){
                               all(sapply(X = eval_vars,
                                          data = data[X, ],
                                          FUN = function(X, data){
                                            evalstring <- data[[X]]
                                            eval(parse(text = evalstring))
                                          }))
                             })
  Conditional_Paste$benchmark_vector <- benchmark_vector

  #This first summary will only include plots that meet all critera for a state/phase combo

  Summary <- Conditional_Paste 

  output_summary1 <- Summary[Summary$Final.State, c("PrimaryKey", "State" , "StateName")]

  # This summary will rank the likelihood of a plot belonging to a certain state/phase
  Summary2 <- Conditional_Paste 
    dplyr::summarize(ProportionCriteriaMet = sum(benchmark_vector)/length(benchmark_vector)) 
    dplyr::filter(ProportionCriteriaMet > 0)

  # Here I am checking to make sure that if a plot has a 1 for rank, it was icluded in the first summary
  AllTrue <- Summary2 
  length(unique(Summary2$PrimaryKey)) #This should equal the number of total plots.

  #Top 3 most likely state
  Summary_Rank_Top <- Summary2 
    dplyr::top_n(3, ProportionCriteriaMet) 
    dplyr::rename(EcologicalState = State)

  # Combine with Tdat for plotting

  output_spatial_top <- merge(Summary_Rank_Top, EcoSitePlots , by = "PrimaryKey") 
    dplyr::select(PrimaryKey , PlotID, EcologicalSiteId, EcologicalState , StateName , ProportionCriteriaMet, Latitude_NAD83 , Longitude_NAD83)

  ## If there is a tie between likelihood of 2 states,
  ## Degraded = TRUE will err on side of more degraded
  ## Degraded = FALSE will err on side of less degraded
  ### Trying again
  Summary_Rank_Top_Slice <- Summary_Rank_Top 
    dplyr::mutate(EcologicalState_Final = ifelse(Degraded == TRUE, max(EcologicalState),
                                                 ifelse(Degraded == FALSE, min(EcologicalState), NA))) 
    dplyr::select(-EcologicalState) 
    dplyr::rename(EcologicalState = EcologicalState_Final) 
    unique() 

  output_spatial_full <- merge(Summary_Rank_Top_Slice, EcoSitePlots , by = "PrimaryKey")
  write.csv(output_spatial_full, file = paste(EcologicalSiteId, "FullOutput_GeneralKey.csv", sep ="") , row.names = FALSE)
  write.csv(Summary_Rank_Top_Slice , file = paste(EcologicalSiteId, "GeneralKeyEcologicalState.csv", sep = ""), row.names = FALSE)

  return(output_spatial_full)

  #######
  }

R-Burke/SiteSummaryTool documentation built on Oct. 15, 2020, 8:21 p.m.