Merge pull request #104 from orichters/master

accept factor vectors in chooseFromList; do not fail setScenario if config file has one data column

.buildlibrary

@@ -1,4 +1,4 @@
-ValidationKey: '6591750'
+ValidationKey: '6612056'
 AcceptedWarnings:
 - 'Warning: package ''.*'' was built under R version'
 - 'Warning: namespace ''.*'' is not available and has been replaced'

CITATION.cff

@@ -2,8 +2,8 @@ cff-version: 1.2.0
 message: If you use this software, please cite it using the metadata from this file.
 type: software
 title: 'gms: ''GAMS'' Modularization Support Package'
-version: 0.33.0
-date-released: '2024-09-09'
+version: 0.33.1
+date-released: '2024-09-10'
 abstract: A collection of tools to create, use and maintain modularized model code
   written in the modeling language 'GAMS' (<https://www.gams.com/>). Out-of-the-box
   'GAMS' does not come with support for modularized model code. This package provides

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: gms
 Type: Package
 Title: 'GAMS' Modularization Support Package
-Version: 0.33.0
-Date: 2024-09-09
+Version: 0.33.1
+Date: 2024-09-10
 Authors@R: c(person("Jan Philipp", "Dietrich", email = "[email protected]", 
              comment = c(affiliation = "Potsdam Institute for Climate Impact Research", ORCID = "0000-0002-4309-6431"), role = c("aut","cre")),
              person("David", "Klein", comment = c(affiliation = "Potsdam Institute for Climate Impact Research"), role = "aut"),

R/chooseFromList.R

@@ -35,6 +35,7 @@
 #' @export
 chooseFromList <- function(theList, type = "items", userinfo = NULL, addAllPattern = TRUE,
                            returnBoolean = FALSE, multiple = TRUE, userinput = FALSE, errormessage = NULL) {
+  if (is.factor(theList)) theList <- as.character(theList)
   originalList <- theList
   if (length(theList) == 0) {
     message("No ", type, " found that might be selected, returning the empty list.")
@@ -134,9 +135,12 @@ choosePatternFromList <- function(theList, type = "items", pattern = FALSE, fixe
     message("\nInsert the ", if (fixed) "search pattern with fixed=TRUE: " else "regular expression: ")
     pattern <- getLine()
   }
-  id <- grep(pattern = pattern, theList, fixed = fixed)
+  id <- try(grep(pattern = pattern, theList, fixed = fixed))
   # lists all chosen and ask for the confirmation of the made choice
-  if (length(id) > 0) {
+  if (inherits(id, "try-error")) {
+    message("\n\nMatching created an error. Try again!")
+    return(choosePatternFromList(theList, type, fixed = fixed))
+  } else if (length(id) > 0) {
     message("\n\nThe search pattern matches the following ", type, ":")
     message(paste(paste(seq_along(id), theList[id], sep = ": "), collapse = "\n"))
   } else {

R/model_lock.R

@@ -72,7 +72,7 @@ Check if all runs using old locking are finished, and if they are, remove the lo
 
   # lock takes the timeout in milliseconds, timeout1 is in hours.
   timeStartLock <- Sys.time()
-  message(timeStartLock, ": try to acquire model lock...")
+  message(round(timeStartLock), ": try to acquire model lock...")
   id <- lock(lfile, timeout = timeout1 * 3600000)
   if (is.null(id)) {
     # timeout
@@ -84,7 +84,7 @@ Check if all runs using old locking are finished, and if they are, remove the lo
 
   timeLocked <- Sys.time()
   timediff <- timeLocked - timeStartLock
-  message(timeLocked, ": acquired model lock in ", round(timediff, 1), " ", units(timediff), ".")
+  message(round(timeLocked), ": acquired model lock in ", round(timediff, 1), " ", units(timediff), ".")
 
   return(id)
 }

R/model_unlock.R

@@ -7,5 +7,5 @@ model_unlock <- function(id, folder=NULL, file=NULL, oncluster=NULL) {
   if (!is.null(oncluster)) warning("oncluster setting is deprecated and ignored.")
 
   unlock(id)
-  message(Sys.time(), ": unlocked model.")
+  message(round(Sys.time()), ": unlocked model.")
 }

R/setScenario.R

@@ -18,6 +18,7 @@
 #' @author Jan Philipp Dietrich, Anastasis Giannousakis
 #' @export
 #' @importFrom utils read.csv
+#' @importFrom dplyr select
 #' @seealso \code{\link{check_config}},\code{\link{getModules}}
 setScenario <- function(cfg,scenario,scenario_config="config/scenario_config.csv"){
 
@@ -40,7 +41,7 @@ setScenario <- function(cfg,scenario,scenario_config="config/scenario_config.csv
     if(inherits(tmp, "try-error") || all(dimnames(tmp)[[1]]==as.character(1:dim(tmp)[1]))) {
       tmp <- read.csv(scenario_config, as.is=TRUE, sep=";", check.names=FALSE, colClasses = "character")
       dimnames(tmp)[[1]] <- tmp[,1]
-      tmp <- tmp[,-1]
+      tmp <- subset(tmp, select = -1)
     }
     scenario_config <- tmp
   }

README.md

@@ -1,6 +1,6 @@
 # 'GAMS' Modularization Support Package
 
-R package **gms**, version **0.33.0**
+R package **gms**, version **0.33.1**
 
 [![CRAN status](https://www.r-pkg.org/badges/version/gms)](https://cran.r-project.org/package=gms) [![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.4390032.svg)](https://doi.org/10.5281/zenodo.4390032) [![R build status](https://github.com/pik-piam/gms/workflows/check/badge.svg)](https://github.com/pik-piam/gms/actions) [![codecov](https://codecov.io/gh/pik-piam/gms/branch/master/graph/badge.svg)](https://app.codecov.io/gh/pik-piam/gms) [![r-universe](https://pik-piam.r-universe.dev/badges/gms)](https://pik-piam.r-universe.dev/builds)
 
@@ -43,7 +43,7 @@ In case of questions / problems please contact Jan Philipp Dietrich <dietrich@pi
 
 To cite package **gms** in publications use:
 
-Dietrich J, Klein D, Giannousakis A, Beier F, Koch J, Baumstark L, Pflüger M, Richters O (2024). _gms: 'GAMS' Modularization Support Package_. doi:10.5281/zenodo.4390032 <https://doi.org/10.5281/zenodo.4390032>, R package version 0.33.0, <https://github.com/pik-piam/gms>.
+Dietrich J, Klein D, Giannousakis A, Beier F, Koch J, Baumstark L, Pflüger M, Richters O (2024). _gms: 'GAMS' Modularization Support Package_. doi:10.5281/zenodo.4390032 <https://doi.org/10.5281/zenodo.4390032>, R package version 0.33.1, <https://github.com/pik-piam/gms>.
 
 A BibTeX entry for LaTeX users is
 
@@ -52,7 +52,7 @@ A BibTeX entry for LaTeX users is
   title = {gms: 'GAMS' Modularization Support Package},
   author = {Jan Philipp Dietrich and David Klein and Anastasis Giannousakis and Felicitas Beier and Johannes Koch and Lavinia Baumstark and Mika Pflüger and Oliver Richters},
   year = {2024},
-  note = {R package version 0.33.0},
+  note = {R package version 0.33.1},
   url = {https://github.com/pik-piam/gms},
   doi = {10.5281/zenodo.4390032},
 }

tests/testthat/test-chooseFromList.R

@@ -50,6 +50,9 @@ with_mocked_bindings({ # fail if getLine() is called
                      c("A", "B"))
     expect_identical(theList[choosePatternFromList(theList, pattern = "^[0-9]+$")],
                      theList[names(theList) == "Number"])
+    # accept factor vectors but turn them into characters
+    expect_identical(unname(chooseFromList(as.factor(theList), userinput = "3,5")),
+                     c("B", "1"))
     # check whether chooseFromList identifies errors and asks user again
     expect_error(chooseFromList(theList, userinput = length(theList) + length(unique(names(theList))) + 3 + 1)) # 3 for all, pattern, fixed
     expect_error(chooseFromList(theList, multiple = FALSE, userinput = length(theList) + 1))