R/get_plant_name.R

In SticsRPacks/SticsRFiles: Read and Modify 'STICS' Input/Output Files

#' Get plant names
#'
#' @description Get the plant name (and file name) for each usm in a workspace
#'
#' @param workspace      Path of a JavaSTICS workspace, or a vector of
#' (recursive call).
#' @param usms_filepath  Path of the usms file (`usms.xml`)
#' @param usm_name      Vector of usms to read (optional, used to filter usms)
#' @param javastics_path JavaSTICS installation path (Optional, needed if the
#' plant files are not in the `workspace` but rather in the JavaSTICS
#' default workspace). Only used to get the plants names.
#' @param verbose Logical value (optional), TRUE to display information
#' on error, FALSE otherwise (default)
#'
#'
#' @return A list of plant names for each usm with one value for sole crop
#' and two values for intercrop (principal, associated).
#' @keywords internal
#'
#' @noRd
#'
#' @examples
#' \dontrun{
#' path <- get_examples_path(file_type = "xml")
#'
#' # Get plant names for all usms (no javastics path, so only the file
#' # name is returned):
#' get_plant_name(path)
#' # Get plant names only for banana:
#' get_plant_name(path, "banana")
#'
#' # Get plant names for banana with a javastics path, so the plant
#' # name is returned:
#' get_plant_name(path)
#' # NB: if the plant folder is in the workspace, no need to provide
#' # javastics_path
#' }
#'
get_plant_name <- function(
    workspace,
    usms_filepath,
    usm_name = NULL,
    javastics_path = NULL,
    verbose = TRUE) {
  usms_path <- normalizePath(usms_filepath, mustWork = FALSE)

  if (!file.exists(usms_path)) {
    stop(usms_filepath, ": not found !")
  }

  # recalculating usms file name
  usms_filename <- basename(usms_path)

  # getting usms names from the usms.xml file:
  usms <- get_usms_list(file = usms_path)

  # Filtering USMs if required:
  if (!is.null(usm_name)) {
    usm_exist <- usm_name %in% usms

    # Some provided usms are not available:
    if (!all(usm_exist)) {
      if (verbose) {
        cli::cli_alert_danger(paste0(
          "The usm{?s} ",
          "{.val {usm_name[!usm_exist]}}",
          " d{?oes/o} not exist in the workspace!"
        ))
        cli::cli_alert_info("Usm{?s} found in the workspace: {.val {usms}}")
      }
      stop(usm_name, ": do(es) not match usms")
    }
    usms <- usm_name
  }

  nb_plant <- get_plants_nb(usms_path)[usms]

  # Getting plant files (fplt) for a set of usm
  plant_files <- get_param_xml(
    file = usms_path,
    param = "fplt",
    select = "usm",
    select_value = usms
  )
  plant_files <- plant_files[[usms_filename]]$fplt

  # Getting plant list:
  if (length(plant_files) == 2 * length(usms)) {
    # If plante dominance="1" and plante dominance="2" are declared,
    # put each one in a column:
    plant_list <- unlist(
      apply(
        matrix(plant_files, ncol = 2, byrow = TRUE),
        MARGIN = 1,
        list
      ),
      recursive = FALSE
    )
  } else if (length(plant_files) == length(usms)) {
    # If plante dominance="2" is not declared, repeat plante dominance="1"
    # twice to get the same data structure:
    plant_list <- unlist(
      apply(
        matrix(c(plant_files, plant_files), ncol = 2, byrow = TRUE),
        MARGIN = 1,
        list
      ),
      recursive = FALSE
    )
  } else {
    stop(
      "plante dominance=\"2\" should always be declared in usms.xml",
      " even for sole crops (use null as values)."
    )
  }
  names(plant_list) <- usms

  # Keeping only useful files names according to nb_plant data
  plant_xml <- try(
    mapply(
      function(x, y) {
        list(x[1:y])
      },
      x = plant_list,
      y = nb_plant
    )
  )

  if (inherits(plant_xml, "try-error")) {
    plant_xml <- vector(mode = "list", length = length(usms))
    plant_xml[nb_plant == 1] <- "plant_1"
    plant_xml[nb_plant > 1] <- c("plant_1", "plant_2")
    names(plant_xml) <- usms
    if (verbose) {
      cli::cli_alert_warning("Error reading usms file, using dummy plant names")
    }
    return(plant_xml)
  }

  alert_msg <- paste0(
    "plant folder not found in the workspace, please add ",
    "{.code javastics_path} to use real plant names",
    " from javaStics."
  )
  if (is.null(javastics_path)) {
    plt_path <- file.path(workspace, "plant")
    if (!all(dir.exists(plt_path))) {
      cli::cli_alert_warning(alert_msg)
      return(plant_xml)
    }
  } else {
    plt_path <- try(normalizePath(file.path(javastics_path, "plant")))
  }

  plant_names <-
    try(
      lapply(plant_xml, function(x) {
        unlist(get_param_xml(
          file = normalizePath(file.path(plt_path, x)),
          param = "codeplante"
        ))
      })
    )

  if (inherits(plant_names, "try-error")) {
    plant_names <- plant_xml
    if (verbose) {
      cli::cli_alert_warning(paste0(
        "Error reading plant names, ",
        "using plant file names for the",
        " output instead"
      ))
    }
  }

  return(plant_names)
}