Run styler

R/add_node_to_doc.R

@@ -42,7 +42,6 @@
 #' @noRd
 #'
 add_node_to_doc <- function(xml_doc, new_node, nodes_nb = 1, parent_path) {
-
   # Checking that parent_path is valid xpath for xml_doc
   if (is.null(get_nodes(xml_doc, parent_path))) {
     warning(paste("Given xpath is not a valid one:", parent_path))

R/add_stics_nodes.R

@@ -24,8 +24,6 @@
 #'
 add_stics_nodes <- function(xml_doc, formalism_name = NULL, nodes_nb = 1,
                             stics_version = "latest") {
-
-
   # Getting nodes types that may be added to xml_doc
   node_types <- get_xml_base_node()
 

R/all_in_par.R

@@ -1,4 +1,3 @@
-
 #' Return all possible STICS inputs parameters
 #'
 #' @description Helper function to print the list of all possible parameters
@@ -20,21 +19,23 @@
 #' @noRd
 #'
 all_in_par <- function(stics_version = "latest") {
-
   # Checking and getting the right version
   stics_version <- check_version_compat(stics_version = stics_version)
 
   #  if (get_version_num(stics_version = stics_version) < 9.2) {
   #    cols_idx <- 1:4
   #  } else {
-  cols_idx <- c(1, 4, 7:8,2)
+  cols_idx <- c(1, 4, 7:8, 2)
   #  }
 
   par_df <- utils::read.csv2(
     file.path(
-      get_examples_path(file_type = "csv",
-                        stics_version = stics_version),
-      "inputs.csv"),
+      get_examples_path(
+        file_type = "csv",
+        stics_version = stics_version
+      ),
+      "inputs.csv"
+    ),
     header = FALSE,
     stringsAsFactors = FALSE
   )[, cols_idx]
@@ -81,13 +82,11 @@ all_in_par <- function(stics_version = "latest") {
 #' # Find for a particular version:
 #' SticsRFiles::get_param_info("alb", stics_version = "V9.0")
 #'
-#'
 #' @export
 #'
 get_param_info <- function(param = NULL,
                            keyword = NULL,
                            stics_version = "latest") {
-
   all_pars <- all_in_par(stics_version)
 
   if (!is.null(keyword)) {
@@ -110,13 +109,13 @@ get_param_info <- function(param = NULL,
   return(all_pars)
 }
 
-get_idx_matches <- function(string, names){
-  unlist(lapply(string,
-                function(x) {
-                  grep(x, names, ignore.case = TRUE)
-                }
-  )
-  )
+get_idx_matches <- function(string, names) {
+  unlist(lapply(
+    string,
+    function(x) {
+      grep(x, names, ignore.case = TRUE)
+    }
+  ))
 }
 
 #' Search if a STICS parameter exist
@@ -142,17 +141,17 @@ get_idx_matches <- function(string, names){
 #'
 is_stics_param <- function(param,
                            stics_version = "latest") {
-
-
   all_pars <- all_in_par(stics_version)
   par_parsed <- var_to_col_names(param)
   pars_names_parsed <- var_to_col_names(all_pars$name)
   index_par <- match(par_parsed, pars_names_parsed)
   par_found <- !is.na(index_par)
   if (any(!par_found)) {
     cli::cli_alert_warning(
-      paste0("paremeters{?s} {.var {par_parsed[!par_found]}}",
-             " not found. Try {.code get_param_info()}.")
+      paste0(
+        "paremeters{?s} {.var {par_parsed[!par_found]}}",
+        " not found. Try {.code get_param_info()}."
+      )
     )
   }
   return(par_found)

R/all_out_var.R

@@ -1,4 +1,3 @@
-
 #' Return all possible STICS outputs for var.mod
 #'
 #' @description Helper function to print the list of all possible variables
@@ -20,7 +19,6 @@
 #' @noRd
 #'
 all_out_var <- function(stics_version = "latest") {
-
   # Checking and getting the right version
   stics_version <- check_version_compat(stics_version = stics_version)
 
@@ -32,9 +30,12 @@ all_out_var <- function(stics_version = "latest") {
 
   var_df <- utils::read.csv2(
     file.path(
-      get_examples_path(file_type = "csv",
-                        stics_version = stics_version),
-      "outputs.csv"),
+      get_examples_path(
+        file_type = "csv",
+        stics_version = stics_version
+      ),
+      "outputs.csv"
+    ),
     header = FALSE,
     stringsAsFactors = FALSE
   )[, cols_idx]
@@ -78,23 +79,21 @@ all_out_var <- function(stics_version = "latest") {
 #' # Find for a particular version:
 #' SticsRFiles::get_var_info("lai", stics_version = "V9.0")
 #'
-#'
 #' @export
 #'
 get_var_info <- function(var = NULL,
                          keyword = NULL,
                          stics_version = "latest") {
-
   all_vars <- all_out_var(stics_version)
   if (!is.null(var)) {
     var <- var_to_col_names(var)
     vars_names_parsed <- var_to_col_names(all_vars$name)
-    idx <- unlist(lapply(var,
-                         function(x) {
-                           grep(x, vars_names_parsed, ignore.case = TRUE)
-                           }
-                         )
-                  )
+    idx <- unlist(lapply(
+      var,
+      function(x) {
+        grep(x, vars_names_parsed, ignore.case = TRUE)
+      }
+    ))
     all_vars[idx, ]
   } else if (!is.null(keyword)) {
     idx <- grepl(keyword, all_vars$definition, ignore.case = TRUE)
@@ -127,7 +126,6 @@ get_var_info <- function(var = NULL,
 #'
 is_stics_var <- function(var,
                          stics_version = "latest") {
-
   all_vars <- all_out_var(stics_version)
   var_parsed <- var_to_col_names(var)
   vars_names_parsed <- var_to_col_names(all_vars$name)
@@ -136,8 +134,10 @@ is_stics_var <- function(var,
   var_found <- !is.na(index_var)
   if (any(!var_found)) {
     cli::cli_alert_warning(
-      paste0("Variable{?s} {.var {var_parsed[!var_found]}}",
-             " not found. Try {.code get_var_info()}.")
+      paste0(
+        "Variable{?s} {.var {var_parsed[!var_found]}}",
+        " not found. Try {.code get_var_info()}."
+      )
     )
   }
   return(var_found)

R/attributes_list2matrix.R

@@ -11,8 +11,10 @@
 #'
 #' xml_path <- file.path(get_examples_path(file_type = "xml"), "sols.xml")
 #' sols_doc <- xmldocument(xml_path)
-#' node_set <- get_nodes(sols_doc,
-#'                                "//*[@nom=\"solcanne\" or @nom=\"mulchbat\"]")
+#' node_set <- get_nodes(
+#'   sols_doc,
+#'   "//*[@nom=\"solcanne\" or @nom=\"mulchbat\"]"
+#' )
 #' attr_list <- sapply(node_set, function(x) XML::xmlAttrs(x))
 #'
 #' #> [[1]]

R/check_choice_param.R

@@ -15,7 +15,6 @@
 #' }
 #'
 check_choice_param <- function(xml_doc, param_name, stop = FALSE) {
-
   #--------------------------------------------------------------------#
   # This is for the moment a specific case attached to tec files:
   # parameter names attached to intervention nodes

R/check_java_workspace.R

@@ -15,7 +15,6 @@
 #' @noRd
 
 check_java_workspace <- function(javastics, workspace = NULL) {
-
   # Ensure that the user working directory is unchanged after
   # the function has run
   current_wd <- getwd()

R/check_param_names.R

@@ -1,6 +1,5 @@
 check_param_names <- function(param_names, ref_names, pattern_tag = "",
                               err_stop = TRUE) {
-
   # Checking parameter names from param_table against xml ones
   # param_names <- unique(gsub(pattern =
   # paste0("\\_(",pattern_tag,"){0,1}[1-9]+"), x = tolower(param_names), ""))

R/col_names_to_var.R

@@ -23,9 +23,13 @@ col_names_to_var <- function(var_list = c()) {
   # Getting the index of the variables to convert
   #
   idx_end_convert <- unlist(lapply(X = words, function(x) {
-    end_conv <- grepl("[n | 0-9*]|nboite|nboite-1|ao|as",
-                      x[length(x)])
-    if (end_conv) return(TRUE)
+    end_conv <- grepl(
+      "[n | 0-9*]|nboite|nboite-1|ao|as",
+      x[length(x)]
+    )
+    if (end_conv) {
+      return(TRUE)
+    }
     FALSE
   }))
 
@@ -44,9 +48,11 @@ col_names_to_var <- function(var_list = c()) {
   # for varname_1, var_name_1,
   # TODO: fix the case var_name_1_2
   conv_var_list <-
-    gsub("_(n{1}|\\d{1,2}|nboite|nboite-1|ao|as)$",
-         "(\\1",
-         conv_var_list)
+    gsub(
+      "_(n{1}|\\d{1,2}|nboite|nboite-1|ao|as)$",
+      "(\\1",
+      conv_var_list
+    )
 
   any_opening <- grepl("\\(", conv_var_list)
 

R/compute_date_from_day.R

@@ -16,10 +16,12 @@
 #'
 #' @export
 #'
-compute_date_from_day <- function(day, start_year){
-  stopifnot(all(is.numeric(day)),
-            length(start_year) == 1,
-            is.numeric(start_year))
+compute_date_from_day <- function(day, start_year) {
+  stopifnot(
+    all(is.numeric(day)),
+    length(start_year) == 1,
+    is.numeric(start_year)
+  )
 
   return(as.Date(day - 1, origin = paste0(start_year, "-01-01")))
 }

R/compute_day_number.R

@@ -6,7 +6,7 @@
 #' @author Timothee Flutre
 #' @keywords internal
 #' @noRd
-get_day_of_year <- function(date){
+get_day_of_year <- function(date) {
   stopifnot(methods::is(date, "Date"))
 
   return(lubridate::yday(date))
@@ -22,11 +22,12 @@ get_day_of_year <- function(date){
 #' @author Timothee Flutre
 #' @keywords internal
 #' @noRd
-is_leap_year <- function(year, integer = FALSE){
-
+is_leap_year <- function(year, integer = FALSE) {
   is_leap <- year %% 4 == 0 & (year %% 100 != 0 | year %% 400 == 0)
 
-  if (integer) return(as.integer(is_leap))
+  if (integer) {
+    return(as.integer(is_leap))
+  }
 
   return(is_leap)
 }
@@ -53,60 +54,69 @@ is_leap_year <- function(year, integer = FALSE){
 #' compute_day_from_date(date = "2015-02-10", start_year = 2014)
 #'
 #' date <- as.Date("2009-02-10")
-#' compute_day_from_date(date = date, start_year = 2008 )
+#' compute_day_from_date(date = date, start_year = 2008)
 #'
 #' dates <- c(as.Date("2008-02-10"), as.Date("2009-02-10"))
-#' compute_day_from_date(date = dates, start_year = 2008 )
+#' compute_day_from_date(date = dates, start_year = 2008)
 #'
 #' @export
 compute_day_from_date <- function(date,
                                   start_year = NULL,
-                                  start_date = lifecycle::deprecated()){
-
-
+                                  start_date = lifecycle::deprecated()) {
   # In case of several input dates
-  if(length(date) > 1) {
+  if (length(date) > 1) {
     out <- unlist(
       lapply(date, function(x) {
-        compute_day_from_date(date = x,
-                              start_year = start_year,
-                              start_date = start_date)
-      }
-      )
+        compute_day_from_date(
+          date = x,
+          start_year = start_year,
+          start_date = start_date
+        )
+      })
     )
     return(out)
   }
 
   # To keep compatibility with the previous argument start_date
   # conversion to year
   if (lifecycle::is_present(start_date)) {
-    lifecycle::deprecate_warn("1.4.0",
-                              "compute_day_from_date(start_date)",
-                              "compute_day_from_date(start_year)")
+    lifecycle::deprecate_warn(
+      "1.4.0",
+      "compute_day_from_date(start_date)",
+      "compute_day_from_date(start_year)"
+    )
 
     start_year <- lubridate::year(as.Date(start_date))
   }
 
-  stopifnot(methods::is(as.Date(date), "Date") || methods::is(date, "Date"),
-            is.null(start_year) || methods::is(start_year, "numeric"))
+  stopifnot(
+    methods::is(as.Date(date), "Date") || methods::is(date, "Date"),
+    is.null(start_year) || methods::is(start_year, "numeric")
+  )
 
   # Converting a character date to Date format
-  if(is.character(date)) date <- as.Date(date)
+  if (is.character(date)) date <- as.Date(date)
 
   day_of_year <- get_day_of_year(date)
   date_year <- lubridate::year(date)
 
   # No start_year, or start_year ==  date year
   # returning the current date year day
-  if (is.null(start_year))
+  if (is.null(start_year)) {
     start_year <- date_year
+  }
 
-  if (date_year == start_year) return(day_of_year)
+  if (date_year == start_year) {
+    return(day_of_year)
+  }
 
   # Impossible case
-  if(start_year > date_year)
-    stop("The start year ", start_year,
-         " is greater than the date year ", date_year, "!")
+  if (start_year > date_year) {
+    stop(
+      "The start year ", start_year,
+      " is greater than the date year ", date_year, "!"
+    )
+  }
 
   # Several years
   years <- seq(start_year, date_year - 1)
@@ -115,6 +125,5 @@ compute_day_from_date <- function(date,
   # Calculating the day number over years
   return(365 * (length(years) - leap_year_number) +
     366 * leap_year_number +
-    day_of_year
-    )
+    day_of_year)
 }