-
Notifications
You must be signed in to change notification settings - Fork 4
/
get_param_xml.R
124 lines (112 loc) · 4.05 KB
/
get_param_xml.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
#' @title Getting parameter values from xml files
#'
#' @description Extracting parameter values for a list of xml files and
#' parameters
#'
#' @param file Vector of the xml file paths from which parameters values
#' must be extracted
#' @param xml_file `r lifecycle::badge("deprecated")` `xml_file` is no
#' longer supported, use `file` instead.
#' @param param Vector of parameter names. Optional, if not provided, the
#' function returns information for all parameters.
#' @param param_name `r lifecycle::badge("deprecated")` `param_name` is no
#' longer supported, use `param` instead.
#' @param select node name or attribute name to use for selection
#' (optional, default to no selection)
#' @param select_value Vector of values used for select (see examples).
#' Optional, should be provided only if select is provided.
#' @param value `r lifecycle::badge("deprecated")` `value` is no
#' longer supported, use `select_value` instead.
#' @param ... Pass further arguments to `get_param_value()`
#'
#' @return A list of parameter values for each xml_file (a list of list)
#'
#' @examples
#'
#' # Soil file
#' file <- file.path(get_examples_path(file_type = "xml"), "sols.xml")
#'
#' # For all soils
#' get_param_xml(file)
#' get_param_xml(file, c("argi", "norg"))
#'
#' # With soil selection
#' # scalar parameters per soil
#' get_param_xml(file, c("argi", "norg"),
#' select = "sol", select_value = c("solcanne", "solbanane")
#' )
#'
#' # Crop management file
#' file <- file.path(get_examples_path(file_type = "xml"), "file_tec.xml")
#'
#' # Getting parameters for irrigation (date and quantity)
#' get_param_xml(file, c("julapI_or_sum_upvt", "amount"))
#'
#'
#' @export
get_param_xml <- function(file,
param = NULL,
select = NULL,
select_value = NULL,
xml_file = lifecycle::deprecated(),
param_name = lifecycle::deprecated(),
value = lifecycle::deprecated(),
...) {
# ... argument for passing : ids, show_xpath to get_param_value
# Managing parameter names changes between versions:
if (lifecycle::is_present(xml_file)) {
lifecycle::deprecate_warn("1.0.0",
"get_param_xml(xml_file)",
"get_param_xml(file)")
} else {
xml_file <- file # to remove when we update inside the function
}
if (lifecycle::is_present(param_name)) {
lifecycle::deprecate_warn("1.0.0",
"get_param_xml(param_name)",
"get_param_xml(param)")
} else {
param_name <- param # to remove when we update inside the function
}
if (lifecycle::is_present(value)) {
lifecycle::deprecate_warn("1.0.0",
"get_param_xml(value)",
"get_param_xml(select_value)")
} else {
value <- select_value # to remove when we update inside the function
}
xml_docs <- lapply(xml_file, xmldocument)
# Checking if any param duplicates in tec files, for 'cut crop' choices
lapply(
xml_docs,
function(x) {
check_choice_param(
xml_doc = x,
param_name = param_name
)
}
)
values <- get_param_value(
xml_doc = xml_docs,
param_name = param_name,
parent_name = select,
parent_sel_attr = value,
...
)
xml_names <- lapply(xml_file, basename) %>% unlist()
# If there are duplicated names in xml_file:
is_duplicated_name <- xml_names %>% duplicated()
xml_names[is_duplicated_name] <- paste0("xml_",
which(is_duplicated_name == TRUE),
"_",
xml_names[is_duplicated_name])
# Fixing parameters with no values with NA
values[[1]] <- lapply(values[[1]],
function(x) {
if (length(x) == 0) return(NA)
x
})
names(values) <- xml_names
lapply(xml_docs, delete)
return(values)
}