Merge pull request #92 from timflutre/get_cultivars_list

add get_cultivars_list with tests

DESCRIPTION

@@ -114,6 +114,7 @@ Collate:
     'gen_usms_xml2txt.R'
     'gen_varmod.R'
     'get_climate_txt.R'
+    'get_cultivars_list.R'
     'get_file.R'
     'get_file_int.R'
     'get_formalisms_xml.R'

NAMESPACE

@@ -16,6 +16,7 @@ export(gen_usms_xml)
 export(gen_usms_xml2txt)
 export(gen_varmod)
 export(get_climate_txt)
+export(get_cultivars_list)
 export(get_examples_path)
 export(get_general_txt)
 export(get_ini_txt)

R/get_cultivars_list.R

@@ -0,0 +1,39 @@
+#' @title Get the cultivar names for a plt.xml file
+#'
+#' @description Extracts the cultivar names from a plant file
+#'
+#' @param file The path of a plant file.
+#'
+#' @return A vector of cultivar names
+#'
+#' @examples
+#' path <- get_examples_path(file_type = "xml")
+#'
+#' # Read from a plant file (all cultivars available in a plant file)
+#' cv_list <- get_cultivars_list(file = file.path(path, "file_plt.xml"))
+#'
+#' @export
+#'
+get_cultivars_list <- function(file) {
+
+  ## get_param_xml(file, param="variete") # returns a list of lists
+
+  xml_doc <- xmldocument(file)
+
+  stopifnot(is_stics_plt(xml_doc))
+
+  xml_name <- "variete"
+
+  cv_list <- unique(
+      unlist(
+          lapply(
+              XML::getNodeSet(doc = xml_doc@content, path = paste0("//", xml_name)),
+              function(x) {
+                XML::xmlGetAttr(x, "nom")
+              }
+          )
+      )
+  )
+
+  return(cv_list)
+}

_pkgdown.yml

@@ -67,6 +67,7 @@ reference:
       - get_usms_files
       - get_usms_list
       - get_soils_list
+      - get_cultivars_list
 
   - title: "Generate Stics Input files (Text format)"
     desc: Input parameters files, outputs definition files or observations files

tests/testthat/test-get_cultivars_list.R

@@ -0,0 +1,28 @@
+library(SticsRFiles)
+
+stics_version <- get_stics_versions_compat()$latest_version
+version_num <- get_version_num()
+
+xml_plant <- file.path(
+  get_examples_path("xml", stics_version = stics_version),
+  "file_plt.xml"
+)
+
+cultivar_names <- get_cultivars_list(file = xml_plant)
+
+context("Getting returned type")
+test_that("type, character vector", {
+  expect_is(cultivar_names, "character")
+})
+
+context("checking existing cultivar name")
+cv_name <- "Sol"
+test_that("name", {
+  expect_true(cv_name %in% cultivar_names)
+})
+
+context("checking non-existing cultivar name")
+cv_name <- "SolTest"
+test_that("name", {
+  expect_false(cv_name %in% cultivar_names)
+})