Merge pull request #227 from jread-usgs/master

adding logical vectors to parse and write nml functions #226

DESCRIPTION

@@ -1,8 +1,8 @@
 Package: glmtools
 Type: Package
 Title: glmtools
-Version: 0.14.5
-Date: 2017-01-11
+Version: 0.14.6
+Date: 2017-01-31
 Authors@R: c( person("Jordan", "Read", role = c("aut","cre"),
     email = "[email protected]"),
     person("Luke", "Winslow", role = "aut",

R/nml_helpers.R

@@ -26,13 +26,12 @@ buildVal	<-	function(textLine, lineNum, blckName){
 	}
 	if (any(grep("'",parVl))){
 
-		parVl	<-	gsub("'","",parVl)#c(as.character(unlist(strsplit(parVl,","))))
+		parVl	<-	gsub("'","",parVl)
 	}else if (any(grep("\"",parVl))){
 	  parVl  <-	gsub("\"","",parVl)
-	}else if (any(grep(".true.",parVl))){
-		parVl	<-	TRUE
-	}else if (any(grep(".false.",parVl))){
-		parVl	<-	FALSE
+	}else if (isTRUE(grepl(".true.",parVl) || grepl(".false.",parVl))){
+		logicals <- unlist(strsplit(parVl,","))
+		parVl <- from.glm_boolean(logicals)
 	}else if (any(grep(",",parVl))){	# comma-sep-nums
 		parVl	<-	c(as.numeric(unlist(strsplit(parVl,","))))
 	}else {	# test for number
@@ -43,6 +42,29 @@ buildVal	<-	function(textLine, lineNum, blckName){
 	return(lineVal)
 }
 
+#' go from glm2.nml logical vectors to R logicals
+#' 
+#' @param values a vector of strings containing either .false. or .true.
+#' @return a logical vector
+#' @keywords internal
+from.glm_boolean <- function(values){
+
+  logicals <- sapply(values, FUN = function(x){
+    if (!isTRUE(grepl(".true.", x) || grepl(".false.", x))){
+      stop(x, ' is not a .true. or .false.; conversion to TRUE or FALSE failed.', 
+           call. = FALSE)
+    }
+    return(ifelse(isTRUE(grepl(".true.", x)), TRUE, FALSE))
+  })
+  return(as.logical(logicals))
+}
+
+to.glm_boolean <- function(values){
+  val.logical <- values
+  values[val.logical] <- '.true.'
+  values[!val.logical] <- '.false.'
+  return(values)
+}
 # private function
 findBlck	<-	function(nml,argName){
 

R/print.nml.R

@@ -12,16 +12,19 @@ print.nml <- function(x, ...){
       cat(names(blckList)[j])
       cat(' = ')
       if (length(blckList[[j]])>1){
-        writer	<-	paste(c(blckList[[j]]),collapse=', ')
+        if (is.logical(blckList[[j]])){
+          charText <- to.glm_boolean(blckList[[j]])
+        } else {
+          charText <- c(blckList[[j]])
+        }
+        writer	<-	paste(charText,collapse=', ')
       } else if (is.character(blckList[[j]])) {
-        charText	<-	strsplit(blckList[[j]],',')
-        writer	<-	paste(c("'",paste(c(charText[[1]]),collapse="','"),"'"),collapse='')
-      } else if (is.logical(blckList[[j]]) & blckList[[j]]){
-        writer	<-	".true."
-      } else if (is.logical(blckList[[j]]) & !blckList[[j]]){
-        writer	<-	".false."
+        charText <- strsplit(blckList[[j]],',')
+        writer <- paste(c("'",paste(c(charText[[1]]),collapse="','"),"'"),collapse='')
+      } else if (is.logical(blckList[[j]])){
+        writer <- to.glm_boolean(blckList[[j]])
       } else {
-        writer	<-	blckList[[j]]
+        writer <- blckList[[j]]
       }
       cat(writer)
       cat('\n')

R/read_nml.R

@@ -51,9 +51,8 @@ read_nml  <-	function(nml_file = 'template'){
     carryover = ''
 
     for (j in (blckOpen[i]+1):(blckClse[i]-1)){
+
       textLine	<-	paste(carryover, gsub("\t","",gsub(" ","",fileLines[j])), sep='')
-      #cat(textLine,'\n')
-      #browser()
       if(substr(textLine,1,1)!='!'){
         # Add a check here, sometimes, if there is a hanging comma, 
         #and only sometimes that means add next row

inst/extdata/multiple_booleans.nml

@@ -0,0 +1,93 @@
+&glm_setup
+   sim_name = 'GLMSimulation'
+   max_layers = 1000
+   min_layer_vol = 0.025
+   min_layer_thick = 0.25
+   max_layer_thick = 0.5
+   Kw = 0.7687144
+   coef_mix_conv = 0.1
+   coef_wind_stir = 0.2827018
+   coef_mix_shear = 0.2644648
+   coef_mix_turb = 0.4
+   coef_mix_KH = 0.204202
+   coef_mix_hyp = 0.5982979
+/
+&morphometry
+   lake_name = 'Cannonsville'
+   latitude = 42.078
+   longitude = -75.3344
+   bsn_len = 12000
+   bsn_wid = 800
+   bsn_vals = 36
+   H = 301.22, 301.83, 303.35, 304.88, 306.4, 307.93, 309.45, 310.98, 312.5, 314.02, 315.55, 317.07, 318.6, 320.12, 321.65, 323.17, 324.7, 326.22, 327.74, 329.27, 330.79, 332.32, 333.84, 335.37, 336.89, 338.42, 339.94, 341.46, 342.99, 344.51, 346.04, 347.56, 349.09, 350.61, 352.13, 353.66
+   A = 1630, 1630, 42600, 79400, 140000, 220000, 335000, 655000, 1090000, 1260000, 1470000, 2020000, 2850000, 3270000, 3720000, 4780000, 5760000, 6270000, 6820000, 8120000, 9240000, 9950000, 10800000, 11900000, 12800000, 13400000, 13900000, 14600000, 15400000, 15900000, 16500000, 17400000, 18300000, 19300000, 20300000, 21300000
+/
+&time
+   timefmt = 2
+   start = '2000-01-01 00:00:00'
+   stop = '2002-12-08 23:00:00'
+   dt = 3600
+   timezone = -4
+/
+&output
+   out_dir = '.'
+   out_fn = 'output'
+   nsave = 24
+   csv_lake_fname = 'Physics'
+   csv_point_nlevs = 1
+   csv_point_fname = 'WQ'
+   csv_point_at = 20
+   csv_point_nvars = 5
+   csv_point_vars = 'temp','OXY_oxy','OGM_doc','PHY_TCHLA','TOT_tp'
+   csv_outlet_fname = 'outlet_'
+   csv_outlet_nvars = 3
+   csv_outlet_vars = 'flow','temp','OXY_oxy'
+   csv_ovrflw_fname = 'overflow'
+/
+&init_profiles
+   num_depths = 3
+   the_depths = 0, 3, 25.5
+   the_temps = 4, 4, 4
+   the_sals = 0.76, 0.76, 0.76
+   lake_depth = 40
+   num_wq_vars = 0
+/
+&meteorology
+   met_sw = .true.
+   lw_type = 'LW_IN'
+   rain_sw = .false.
+   atm_stab = .false.
+   catchrain = .false.
+   rad_mode = 2
+   albedo_mode = 1
+   cloud_mode = 4
+   meteo_fl = 'NLDAS2_Cannonsville_C6.csv'
+   subdaily = .true.
+   wind_factor = 1
+   sw_factor = 0.6212019
+   cd = 0.001216207
+   ce = 0.001336918
+   ch = 0.001268856
+   rain_threshold = 0.01
+   runoff_coef = 0.3
+/
+&inflow
+   num_inflows = 3
+   names_of_strms = 'Trout','WBDR','ungaged'
+   strm_hf_angle = 10, 10, 10
+   strmbd_slope = 47, 47, 47
+   strmbd_drag = 0.01326389, 0.01326389, 0.01326389
+   inflow_factor = 1, 1, 1
+   inflow_fl = 'Cannonsville_inflow_Trout.csv','Cannonsville_inflow_WBDR.csv','Cannonsville_inflow_ungaged.csv'
+   inflow_varnum = 2
+   inflow_vars = 'FLOW','TEMP'
+/
+&outflow
+   num_outlet = 3
+   flt_off_sw = .false.,.false.,.false.
+   outl_elvs = 330.86, 311, 350.52
+   bsn_len_outl = 996, 837, 4600
+   bsn_wid_outl = 433, 363, 2000
+   outflow_fl = 'Cannonsville_outflow_withdraw.csv','Cannonsville_outflow_damrelease.csv','Cannonsville_outflow_spill.csv'
+   outflow_factor = 1, 1, 1
+/

tests/testthat/test-nml.R

@@ -14,7 +14,19 @@ test_that("set_nml() with different datatypes", {
 
 })
 
+context("can use vectors for logicals")
+test_that("set_nml() can use a vector for logicals", {
+  nml <- set_nml(nml, 'flt_off_sw', c(T, F, F))
+  expect_true(get_nml_value(nml, 'flt_off_sw')[1])
+  expect_false(get_nml_value(nml, 'flt_off_sw')[2])
+  expect_error(set_nml(nml, 'flt_off_sw', c(T, F, '.false.')))
+})
 
+test_that("can read in nml with vector for logicals", {
+  nml <- read_nml(system.file(package='glmtools','extdata','multiple_booleans.nml'))
+  expect_true(length(get_nml_value(nml, 'flt_off_sw')) > 1)
+  expect_is(get_nml_value(nml, 'flt_off_sw'), 'logical')
+})
 
 context("reading a bad nml file")
 test_that("file errors out",{