Merge pull request #21 from KWB-R/dev

Release v0.3.0

.github/workflows/R-CMD-check.yaml

@@ -23,7 +23,7 @@ jobs:
       matrix:
         config:
           - {os: macOS-latest, r: 'release'}
-          - {os: ubuntu-20.04, r: 'release', rspm: "https://packagemanager.rstudio.com/cran/__linux__/focal/latest"}
+          - {os: ubuntu-latest, r: 'release'}
           - {os: windows-latest, r: 'devel'}
           - {os: windows-latest, r: 'oldrel'}
           - {os: windows-latest, r: 'release'}
@@ -36,11 +36,11 @@ jobs:
     steps:
       - uses: actions/checkout@v2
 
-      - uses: r-lib/actions/setup-r@master
+      - uses: r-lib/actions/setup-r@v2
         with:
           r-version: ${{ matrix.config.r }}
 
-      - uses: r-lib/actions/setup-pandoc@master
+      - uses: r-lib/actions/setup-pandoc@v2
 
       - name: Query dependencies
         run: |
@@ -76,7 +76,7 @@ jobs:
 
       - name: Upload check results
         if: failure()
-        uses: actions/upload-artifact@master
+        uses: actions/upload-artifact@v2
         with:
           name: ${{ runner.os }}-r${{ matrix.config.r }}-results
           path: check

.github/workflows/pkgdown.yaml

@@ -15,9 +15,9 @@ jobs:
     steps:
       - uses: actions/checkout@v2
 
-      - uses: r-lib/actions/setup-r@master
+      - uses: r-lib/actions/setup-r@v2
 
-      - uses: r-lib/actions/setup-pandoc@master
+      - uses: r-lib/actions/setup-pandoc@v2
 
       - name: Query dependencies
         run: |

.github/workflows/pr-commands.yaml

@@ -11,10 +11,10 @@ jobs:
       GITHUB_PAT: ${{ secrets.GH_PRIVATE_TOKEN }}
     steps:
       - uses: actions/checkout@v2
-      - uses: r-lib/actions/pr-fetch@master
+      - uses: r-lib/actions/pr-fetch@v2
         with:
           repo-token: ${{ secrets.GITHUB_TOKEN }}
-      - uses: r-lib/actions/setup-r@master
+      - uses: r-lib/actions/setup-r@v2
       - name: Install dependencies
         run: Rscript -e 'install.packages(c("remotes", "roxygen2"))' -e 'remotes::install_deps(dependencies = TRUE)'
       - name: Document
@@ -23,7 +23,7 @@ jobs:
         run: |
           git add man/\* NAMESPACE
           git commit -m 'Document'
-      - uses: r-lib/actions/pr-push@master
+      - uses: r-lib/actions/pr-push@v2
         with:
           repo-token: ${{ secrets.GH_PRIVATE_TOKEN }}
   style:
@@ -34,10 +34,10 @@ jobs:
       GITHUB_PAT: ${{ secrets.GH_PRIVATE_TOKEN }}
     steps:
       - uses: actions/checkout@v2
-      - uses: r-lib/actions/pr-fetch@master
+      - uses: r-lib/actions/pr-fetch@v2
         with:
           repo-token: ${{ secrets.GH_PRIVATE_TOKEN }}
-      - uses: r-lib/actions/setup-r@master
+      - uses: r-lib/actions/setup-r@v2
       - name: Install dependencies
         run: Rscript -e 'install.packages("styler")'
       - name: Style
@@ -46,6 +46,6 @@ jobs:
         run: |
           git add \*.R
           git commit -m 'Style'
-      - uses: r-lib/actions/pr-push@master
+      - uses: r-lib/actions/pr-push@v2
         with:
           repo-token: ${{ secrets.GH_PRIVATE_TOKEN }}

.github/workflows/test-coverage.yaml

@@ -18,9 +18,9 @@ jobs:
     steps:
       - uses: actions/checkout@v2
 
-      - uses: r-lib/actions/setup-r@master
+      - uses: r-lib/actions/setup-r@v2
 
-      - uses: r-lib/actions/setup-pandoc@master
+      - uses: r-lib/actions/setup-pandoc@v2
 
       - name: Query dependencies
         run: |

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: kwb.abimo
 Title: R Package with Functions for Working with Water Balance
     Model ABIMO
-Version: 0.2.0
+Version: 0.3.0
 Authors@R: 
     c(person(given = "Andreas",
              family = "Matzinger",
@@ -35,7 +35,6 @@ Imports:
     gridExtra,
     kwb.utils,
     remotes,
-    stringr,
     xml2
 Suggests: 
     knitr,
@@ -46,7 +45,7 @@ Remotes:
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.0
+RoxygenNote: 7.2.3
 Depends: 
     R (>= 2.10)
 VignetteBuilder: knitr

NAMESPACE

@@ -10,10 +10,13 @@ export(abimo_xml_BER)
 export(abimo_xml_evap)
 export(add_ISU5_ID)
 export(appendSubToFile)
+export(calculate_bagrov_curve)
 export(create_configurator)
 export(default_config)
 export(extdata_file)
+export(get_bagrov_curves_from_abimo)
 export(get_xpaths)
+export(install_abimo)
 export(replace_value)
 export(run_abimo)
 export(run_abimo_command_line)
@@ -25,11 +28,20 @@ importFrom(gh,gh)
 importFrom(grDevices,dev.off)
 importFrom(graphics,lines)
 importFrom(gridExtra,grid.table)
+importFrom(kwb.utils,asNoFactorDataFrame)
+importFrom(kwb.utils,catAndRun)
+importFrom(kwb.utils,createDirectory)
 importFrom(kwb.utils,hsShowPdf)
+importFrom(kwb.utils,isTryError)
 importFrom(kwb.utils,preparePdf)
+importFrom(kwb.utils,printIf)
+importFrom(kwb.utils,replaceFileExtension)
+importFrom(kwb.utils,selectElements)
+importFrom(kwb.utils,stringList)
 importFrom(remotes,available_packages)
-importFrom(stringr,str_replace_all)
 importFrom(utils,download.file)
+importFrom(utils,getFromNamespace)
+importFrom(utils,read.table)
 importFrom(xml2,read_xml)
 importFrom(xml2,write_xml)
 importFrom(xml2,xml_attr)

NEWS.md

@@ -1,3 +1,18 @@
+# Latest developments
+
+# kwb.abimo 0.3.0 (2023-10-26)
+
+* Fix GitHub Actions workflow files (master -> v2)
+* Remove dependency on package "stringr"
+* New (exported) functions
+    - `calculate_bagrov_curve()`
+    - `get_bagrov_curves_from_abimo()`
+    - `install_abimo()`
+* The `CODE` column is now expected to be of type character, not integer
+* `dive_into()` now returns objects that have a `get()` method
+* Improve organisation of functions in files
+* many more changes (TODO: complete this list)
+
 # kwb.abimo 0.2.0 (2022-06-23)
 
 * Set GITHUB_PAT correctly in GitHub Actions configuration files

R/abimo_functions_am.R

@@ -75,47 +75,6 @@ abimo_comb_in_out <- function (
 
 }
 
-#' writes data.frame into ABIMO-dbf
-#'
-#' Saves an existing data.frame into dBase-format
-#' and adds "SUB" field to the end of the file
-#' as required by ABIMO
-#'
-#' @param df_name name of data.frame
-#' @param new_dbf path of new ABIMO-input file to be written (.dbf)
-#'
-#' @return dbf file that can be processed by ABIMO
-#' @importFrom foreign write.dbf
-#' @export
-write.dbf.abimo <- function (
-  df_name,
-  new_dbf
-)
-{
-  foreign::write.dbf(df_name, new_dbf)
-  appendSubToFile(new_dbf)
-}
-
-
-#' Add "SUB" field to dbf-File
-#'
-#' Adds "SUB" field to the end of an existing  file, as expected by some
-#' older applications (such as input-dbf-file for ABIMO)
-#' function by grandmaster HAUKESON
-#'
-#' @param filename Path of file name of data.frame
-#'
-#' @return dbf file with sub field
-#' @export
-appendSubToFile <- function (
-  filename
-)
-{
-  con <- file(filename, "ab")
-  on.exit(close(con))
-  writeBin(as.raw(0x1A), con)
-}
-
 #' add ISU5 ID to dbf file from geoportal
 #'
 #' the ID is an unambiguous identifier
@@ -304,15 +263,15 @@ abimo_xml_BER <- function (
 }
 
 #' Helper function: replace value
-#' @description searches for string for parameter=pattern_value
-#' pattern and replaces with parameter="new_value" for all found
-#' entries
+#'
+#' @description searches string for parameter=<pattern_value> and replaces with
+#' parameter=<new_value> for all found entries
+#'
 #' @param string string with ABIMO config
 #' @param new_value new parameter value
 #' @param parameter parameter name to search for (default: "etp")
 #' @param pattern_value pattern of value field (default: '\"\[0-9\]+?\\.?\[0-9\]+?\"')
 #' @return returns string with modified parameter = value
-#' @importFrom stringr str_replace_all
 #' @export
 #' @examples
 #' ### Simple string
@@ -322,15 +281,18 @@ abimo_xml_BER <- function (
 #' ### Default ABIMO config
 #' config <- readLines(kwb.abimo::default_config())
 #' replace_value(config, new_value = 100, parameter = "etp")
-replace_value <- function(string,
-                          new_value,
-                          parameter = "etp",
-                          pattern_value = "\"[0-9]+?\\.?[0-9]+?\"") {
-
-  pattern <- sprintf("%s=%s", parameter, pattern_value)
-  replacement <- sprintf("%s=\"%s\"", parameter, new_value)
-
-  stringr::str_replace_all(string, pattern, replacement)
+replace_value <- function(
+    string,
+    new_value,
+    parameter = "etp",
+    pattern_value = "\"[0-9]+?\\.?[0-9]+?\""
+)
+{
+  gsub(
+    pattern = sprintf("%s=%s", parameter, pattern_value),
+    replacement = sprintf("%s=\"%s\"", parameter, new_value),
+    x = string
+  )
 }
 
 #' change potential evaporation in Abimo config.xml

R/calculate_bagrov_curve.R

@@ -0,0 +1,84 @@
+# calculate_bagrov_curve -------------------------------------------------------
+
+#' Calculate the curve(s) of the Bagrov relation
+#'
+#' @param effectivity Bagrov effectivity value (= n-value)
+#' @param P_over_Ep_max maximum value of the ratio P/Ep with precipitation P and
+#'   potential evaporation Ep.
+#' @param Ep potential evaporation in mm/a (default: 650)
+#' @param delta_Ea step of actual evaporation (default: 0.1)
+#' @param dbg logical indicating whether or not to show debug messages
+#' @return data frame with columns \code{P_over_Ep} (P/Ep), \code{Ea_over_Ep}
+#'   (Ea/Ep), \code{effectivity} (n-value)
+#' @export
+#' @examples
+#' \dontrun{
+#' bagrov_data <- calculate_bagrov_curve(1:2)
+#' plot(bagrov_data$P_over_Ep, bagrov_data$Ea_over_Ep)
+#' }
+calculate_bagrov_curve <- function(
+    effectivity,
+    P_over_Ep_max = 4,
+    Ep = 650, # mm/a
+    delta_Ea = 0.1,
+    dbg = FALSE
+)
+{
+  stopifnot(is.numeric(effectivity))
+
+  # If more than one effectivity value is given, call this function for each
+  # effectivity value, row-bind the data frames and return the resulting data
+  # frame
+  if (length(effectivity) > 1L) {
+
+    return(do.call(rbind, lapply(
+      X = effectivity,
+      FUN = calculate_bagrov_curve,
+      P_over_Ep_max = P_over_Ep_max,
+      Ep = Ep,
+      delta_Ea = delta_Ea,
+      dbg = dbg
+    )))
+  }
+
+  stopifnot(length(effectivity) == 1L)
+
+  kwb.utils::catAndRun(
+    paste("Calculating Bagrov curve for effectivity =", effectivity),
+    dbg = dbg,
+    expr = {
+
+      Ea <- 0
+      P <- 0
+      Ea_over_Ep <- 0
+
+      # Initialise result list
+      results <- list()
+
+      while(P <= P_over_Ep_max * Ep && Ea_over_Ep <= 1) {
+
+        # Update delta_P
+        delta_P <- delta_Ea / (1 - Ea_over_Ep^effectivity)
+
+        # Increment P and Ea with their corresponding deltas
+        P <- P + delta_P
+        Ea <- Ea + delta_Ea
+
+        # Calculate quotients Ea/Ep and P/Ep
+        P_over_Ep <- P / Ep
+        Ea_over_Ep <- Ea / Ep
+
+        # Put the quotients and the effectivity-value into a named vector and add the
+        # vector to the end of the result list
+        results[[length(results) + 1L]] <- data.frame(
+          P_over_Ep = P_over_Ep,
+          Ea_over_Ep = Ea_over_Ep,
+          effectivity = effectivity
+        )
+      }
+
+      # Row-bind all data frames
+      do.call(rbind, results)
+    }
+  )
+}

R/check_types.R

@@ -6,7 +6,7 @@ check_types <- function(abimo_data)
   #writeLines(sprintf("%s = \"%s\",", names(types), types))
 
   expected_types <- list(
-    CODE = "integer",
+    CODE = "character",
     BEZIRK = "integer",
     STAGEB = "integer",
     BLOCK = "integer",

R/configure_2.R

@@ -1,7 +1,7 @@
 # read_config ------------------------------------------------------------------
 read_config <- function(file = default_config_file())
 {
-  dive_into(xml2::read_xml(file), file)
+  dive_into(x = xml2::read_xml(file), file)
 }
 
 # dive_into --------------------------------------------------------------------
@@ -12,6 +12,14 @@ dive_into <- function(x, xml_file, depth = 0L)
 
   if (length(children) == 0L) {
 
+    x$get <- function(name = NULL) {
+      attrs <- xml2::xml_attrs(x)
+      if (is.null(name)) {
+        return(attrs)
+      }
+      kwb.utils::selectElements(as.list(attrs), name)
+    }
+
     x$set <- function(...) {
       args <- list(...)
       for (name in names(args)) {