R/RHC_function.R

In RHC: Rangeland Health and Condition

#' @title Rangeland Health, Condition
#' @description This function calculates attributes of landscape function analysis (LFA), rangeland health and condition.
#' @details
#' The function takes standardized data, performs predictions using pre-trained models, and returns the results.
#' @param final_data_st A data frame containing standardized data from the first function.
#' @return The attributes of landscape function analysis (LFA), rangeland health and condition.
#' @examples
#' data(canopy_oc_file)
#' data(trait_file)
#' final_data_st <- prepare_RHC_data(canopy_oc_file, trait_file)
#' evaluation.criteria <- RHC_function(final_data_st)
#' @importFrom stats predict
#' @importFrom randomForest randomForest
#' @name RHC_function
#' @export
RHC_function <- function(final_data_st) {
  model_info <- list(
    list(path = "extdata/Total_Stability.rds", name = "Total.Stability"),
    list(path = "extdata/Total_Infiltration.rds", name = "Total.Infiltration"),
    list(path = "extdata/Total_Nutrients.rds", name = "Total.Nutrients"),
    list(path = "extdata/LFA.rds", name = "LFA"),
    list(path = "extdata/Soil_Site_Stability.rds", name = "Soil.Site.Stability"),
    list(path = "extdata/Hydrologic_Function.rds", name = "Hydrologic.Function"),
    list(path = "extdata/Biotic_Integrity.rds", name = "Biotic.Integrity"),
    list(path = "extdata/Rangeland_Health.rds", name = "Rangeland.Health"),
    list(path = "extdata/condition_4.rds", name = "Condition.4"),
    list(path = "extdata/condition_6.rds", name = "Condition.6")
  )

  load_model <- function(model_path) {
    file_path <- system.file(model_path, package = "RHC")
    model <- readRDS(file_path)
    if (!inherits(model, "randomForest")) {
      stop("Model is not a valid random forest object: ", model_path)
    }
    return(model)
  }

  run_predictions <- function(final_data_st) {
    predictions <- lapply(model_info, function(info) {
      model <- load_model(info$path)
      predict(model, newdata = final_data_st)
    })

    evaluation.criteria <- do.call(cbind, predictions)
    colnames(evaluation.criteria) <- sapply(model_info, function(x) x$name)
    return(evaluation.criteria)
  }

  predictions <- run_predictions(final_data_st)
  return(predictions)
}