Brining Release up to 2023 Q2 Status (#18)

* Added the parameter field for the SUMMARY DBS keyword to the keyword window

* Small typo fix in the databaseDescription.xlsx file

* Bug fix: Grey screen was occurring when trying to edit the PLANT/NATURAL management action window.

* Removed two extraneous unused variables, and another unused commented-out section, from the kcpVetting function.

* Limited the types of file extensions the kcpUpload button looks for to be .kcp and .RData

* • Bug fix: when trying to change to freeform with a stand or group selected, the grey screen was occurring. Added a clause to instead return from the function in this instance, similar to how the Edit button works (i.e., nothing happens).
• Bug fix: when clicking the “Save in component collection” button more than once when the last keyword in the KCP was in a conditional block, and ENDIF keyword was being added more than once.
• Added a few “## “ labels above some observer functions that did not have them, making identification easier.

* Removed all references to "fvsOLdev", added code that tests on the
library fvsOL is loaded from and if it is R-dev, then the neading is
adjusted to say "Dev".  Modified the run scripts so that rFVS will
be loaded from R-dev if it is located at that location.

* Modified the date of revision, cleaned up some line endings, reorganized
a bit of code so that a cluster instance is not started if an error
condition is discovered.

* Removed one more "devVersion" code sequence, cleaning up the
fvsOLdev issue.

* Fixed a small bug when the PlotInit table is absent in the mapping code.

* Updates to voleqnum.kwd to include additional available volume equations

* modifications to basekeys.kwd to allow for user input to top diameter limits and stump in BFVOLUME and VOLUME keyword dialogs

* Minor typo fix in ui.R

* Added the three cmpSummary tables to the list of simulation-level tables for use in the "Database tables to consider" window in the View outputs > Load menu.

* Standardized the "## " titles for observer functions in server.R as many were absent, or had different number of pound signs and spacing. This is to (hopefully) make  easier the searching for, and learning of, code for any future interface programmers.

* Updated the "Release date" variables to be 20230106

* Added the old iet01.key and iet01.tre files into a ../tests folder for use with the introductory rFVS wiki examples.

* Deletion of fvsOLdev folder from the development branch

* Typo fix

* Bug fix: composite tables were showing up in the "Database tables to consider" window when a single run with a single stand was selected in the "Runs to consider" window.

* Updated Wensel &Olsen Scribner 32 function names to remove a '-' that was causing an uncommon character.  Replaced with parentheses.

* Voleqnum.kwd parm updates
Added space to Wensel & Olsen
Removed all Sharpneck equations from availability
Removed F0#FW2W260, general hemlock equations
Compared volume eq table document returns (BF vol vs cubic vol) and removed equations that didn't return the proper volume type from the respective cubic ft vs board ft equation lists

* Added some more standardization for labeling functions, and removed an unnecessary clause that was precluding the creation of the stand and stock table that was introduced in a recent test commit.

* Added 3 eqs missing from ec, wc, bm, pn, op, oc
628BEHW093 = Region 6:Engelmann spruce - Behres Hyperbola
616TRFW747 = Region 6:black cottonwood - PNW tariff Equation
616TRFW998 = Region 6:unknown hardwood - PNW tariff Equation

* Strange character encoding correction
Found other instances of 'Behre's' begin translated with unusual characters.
Changed to 'Behres'

* Removal of newSum variable from server.R and calls to the writeKeyFile function that was preventing new runs from keeping the Summary2 table as the default if any previous runs had the Summary table in them.

* Bringing Main up to 2023 Q2 Status (#17)

* rFVS: added fvsCutNow and fvsMakeyFile functions, Fixed a typo in
fvsAddActivity, added the ability to set/get "special" tree tag and
kutkod used in prescription thinnings.
fvsOL: modified code to support package sf (more work to do on this).

* Started process of adding support of package sf

* Rmeoved "NAMESPACE" from management by the repository

* Finished changes to convert from package sp to sf for spatial data

* Commented out the ability to specify "development" code in new projects.

* Fixed a bug I just introduced.

* Removed the use of R-dev as an installation library (a change to the
makefiles) This restores the code to a previous version.

* rFVS: Improved the documentation for fvs[Get|Set]SpeciesAttrs, reset the
revision date in DESCRIPRTION

* fvsOL: Fixed a bug that caused a warning in some cases when a run's
variant was not set, modified the code that runs the Acadian variant so that
fvs tree ids are maintained (the trees were being renumbered). Updated
the revision tag in DESCRIPTION

* Pull Request #14 Updates from NCrookston

* 1. When trying to manually add the RRTREIN and BBCLEAR root disease keywords a crash was occurring.
2. When trying to add in the THINRDSL keyword into the Run contents using a non-NE variant, a crash was occurring (keyword only applies to the NE variant).
3. When trying to import a custom SQL query using the Import runs and other items, a crash was occurring, and the query was also not showing up in the Custom query menu after import.
4. Improvements to the SQLIN/SQLOUT database keyword windows:
    a. Updated example text & code was added to below the windows
    b. A column ruler was added to be above the editor window
    c. The needed DATABASE/END keywords are now automatically added around  the query when building the keyword file at run time (they were previously being tagged as “base” instead of “dbs”)
5. The “Rebuild StdStk” button now works in that if a run containing a StdStk (or cmpStdStk) table is pre-selected in the “Runs to consider” window, and then the “Rebuild StdStk” button is clicked after changing the “DBH class size” and/or “Large DBH” values, the “DBHClasses” under the Explore menu are immediately updated. Previously, a run had to not be selected before changing either of those values, and then a run selected, for the changes to then reflect under the Explore menu.
6. A logical variables was added to the keyword writing function to prevent two successive END keywords from being written that was happening when a base keyword was following a conditionally-scheduled non-base keyword.

* Update fvsRunUtilities.R

Fixing inadvertent overwrite when merging multiple pull requests

* Bug fixes (fvsOL):
• When trying to import a project backup the check for a blank/null INV_YEAR field in the input database was causing a crash if the column name for that variables was not upper case. The tolower() function was added to coerce it to lower case for even comparison of all casings of that variable.
• The keyword writing code was missing logic to handle when a conditional was following a previous conditional that had multiple non-base keywords.
• When deleting the only stand from a run that had components attached to groups (thus creating a blank-appearing run), the components were being inherited by any subsequently-added stands. This made sense for runs with multiple stands (where deleting one stand didn’t result in a blank run) but was deemed confusing (since adding stands into a blank run should not carry any keyword inheritance). Now, any groups & their associated keywords associated with the stand being deleted from a single-stand run are now removed from the run upon clicking “Cut/delete”.
• The sumOnSpecies indicator variable in the graphing code was not setup to accommodate the 3 newer species codes (SpeciesFVS, SpeciesPLANTS, SpeciesFIA) resulting in plots containing any one of those 3 variables were resulting in erroneously large Y-axis values (e.g., 4000ft tall trees).

* 2023 q2 shettles final (#17)

* Bug fixes (fvsOL):
• When trying to import a project backup the check for a blank/null INV_YEAR field in the input database was causing a crash if the column name for that variables was not upper case. The tolower() function was added to coerce it to lower case for even comparison of all casings of that variable.
• The keyword writing code was missing logic to handle when a conditional was following a previous conditional that had multiple non-base keywords.
• When deleting the only stand from a run that had components attached to groups (thus creating a blank-appearing run), the components were being inherited by any subsequently-added stands. This made sense for runs with multiple stands (where deleting one stand didn’t result in a blank run) but was deemed confusing (since adding stands into a blank run should not carry any keyword inheritance). Now, any groups & their associated keywords associated with the stand being deleted from a single-stand run are now removed from the run upon clicking “Cut/delete”.
• The sumOnSpecies indicator variable in the graphing code was not setup to accommodate the 3 newer species codes (SpeciesFVS, SpeciesPLANTS, SpeciesFIA) resulting in plots containing any one of those 3 variables were resulting in erroneously large Y-axis values (e.g., 4000ft tall trees).

* The BurnReDB database keyword was still being displayed as BurnRept in the Keywords menu dropdown menu list.

* Removal of a browser() command from code.

* 1) Added keyword windows for the REGREPTS and INVSTATS DBS keywords (#18)

2) Added the new BHTWTBA and AHTWTBA Event Monitor variables to the "Variables" dropdown list

* Update of "Release date" for upper right panel in GUI to read 20230518 for upcoming Q2 release. (#19)

* Modified R/externalCallable.R to add the ability to delete stands and
modified the function that lists stands to return a data.frame that has
the stand uuid as well as the standid. Modified fvsRunAadian to not use
fvsStopPoint 7. The stoppoint works, but what we were trying to
accomplish was not getting done.

* Removed NAMESPACE from being tracked by git.  It is automatically built
when R builds the package.

* 1) Updated the example text under the SQLout window (#21)

2) Fixed the Lory's height EM variable calculation so that it inserts the correct variable

---------

Co-authored-by: Nicholas Crookston <ncrookston.fs@gmail.com>
Co-authored-by: MICHAEL A. SHETTLES <michael.a.shettles@usda.gov>

---------

Co-authored-by: Michael Shettles <michael.a.shettles@usda.gov>
Co-authored-by: Nicholas Crookston <ncrookston.fs@gmail.com>
Co-authored-by: mshettles <100229112+mshettles@users.noreply.github.com>

Author: 3 people

FVSPrjBldr/server.R

@@ -29,10 +29,10 @@ shinyServer(function(input, output, session) {
       workDir = paste0("/home/shiny/FVSwork/",uuid)
       cat("workDir=",workDir,"\n")
       dir.create(workDir)
-      if (input$version == "production") 
+#      if (input$version == "production") 
         cat ('library(fvsOL)\nfvsOL(fvsBin="/home/shiny/FVS/bin")\n',file=paste0(workDir,"/app.R"))
-      if (input$version == "development") 
-        cat ('library(fvsOLdev)\nfvsOL(fvsBin="/home/shiny/FVSdev/bin")\n',file=paste0(workDir,"/app.R"))
+#      if (input$version == "development") 
+#        cat ('library(fvsOLdev)\nfvsOL(fvsBin="/home/shiny/FVSdev/bin")\n',file=paste0(workDir,"/app.R"))
       # projectId file...
 cat("email=",emailnew,"\ntitle=",input$title,"\n")
       cat(file=paste0(workDir,"/projectId.txt"),

FVSPrjBldr/ui.R

@@ -20,10 +20,10 @@ shinyUI(fluidPage(
     textInput("title", "Your new project title"),
     textInput("emailnew", "Your Email address"),
     textInput("emaildup", "Your Email address again"),
-    radioButtons("version",NULL,choices=list( 
-       "Use the production version of the software"="production",
-       "Use the development version"="development"),
-       selected="production"),
+#    radioButtons("version",NULL,choices=list( 
+#       "Use the production version of the software"="production",
+#       "Use the development version"="development"),
+#       selected="production"),
     p("By pressing submit you are certifying that you agree to the Notice posted below."),
     actionButton("submitnew","Submit"),
     tags$style(type="text/css","#actionMsg{color:darkred;}"), 

fvsOL/DESCRIPTION

@@ -1,17 +1,18 @@
-Package: fvsOL
-Title: Forest Vegetation Simulator
-Version: 2022.09.30
-Authors@R: c(person("Nicholas", "Crookston", email = "ncrookston.fs@gmail.com",
-                  role = c("aut")),
-             person("Michael", "Shettles", email = "michael.a.shettles@usda.gov",
-                  role = c("aut", "cre")))
-Description: An R-Shiny interface to the Forest Vegetation Simulator which can be
- run as an "Online" or "Onlocal" configuration.
-Depends: R (>= 4.0.0), rFVS (>= 2021.03.15), shiny (>= 1.6.0), Cairo (>= 1.5.11),
- rhandsontable (>= 0.3.7), ggplot2 (>= 3.3.3), parallel (>= 4.0.0),
- RSQLite (>= 2.2.4), plyr (>= 1.8.6), dplyr (>= 1.0.4), colourpicker (>= 1.1.0),
- rgl (>= 0.105.0), leaflet (>= 2.0.4.1), zip (>= 2.1.1), openxlsx (>= 4.2.3)
-Suggests: rgdal (>= 1.5-23), nlme (>= 3.1-140)
-License: MIT
-Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.2
+Package: fvsOL
+Title: Forest Vegetation Simulator
+Version: 2023.05.18
+Authors@R: c(person("Nicholas", "Crookston", email = "ncrookston.fs@gmail.com",
+                  role = c("aut")),
+             person("Michael", "Shettles", email = "michael.a.shettles@usda.gov",
+                  role = c("aut", "cre")))
+Description: An R-Shiny interface to the Forest Vegetation Simulator which can be
+ run as an "Online" or "Onlocal" configuration.
+Depends: R (>= 4.0.0), rFVS (>= 2021.03.15), shiny (>= 1.6.0), Cairo (>= 1.5.11),
+ rhandsontable (>= 0.3.7), ggplot2 (>= 3.3.3), parallel (>= 4.0.0),
+ RSQLite (>= 2.2.4), plyr (>= 1.8.6), dplyr (>= 1.0.4), colourpicker (>= 1.1.0),
+ rgl (>= 0.105.0), leaflet (>= 2.0.4.1), zip (>= 2.1.1), openxlsx (>= 4.2.3)
+Suggests: rgdal (>= 1.5-23), nlme (>= 3.1-140)
+License: MIT
+Roxygen: list(markdown = TRUE)
+RoxygenNote: 7.2.3
+Encoding: UTF-8

fvsOL/NAMESPACE

@@ -53,7 +53,7 @@ keyword.dbs.StandSQL.Win <- function(title, prms, globals, input, output)
 }
 keyword.dbs.StandSQL.Win.mkKeyWrd <- function(input,output)
 {
-  list(ex="base", 
+  list(ex="dbs", 
     kwds = paste0("StandSQL\n",input$freeEdit,"\nEndSQL\n"),
     reopn = c(freeEdit=input$freeEdit)
   )  
@@ -82,14 +82,12 @@ keyword.dbs.TreeSQL.Win <- function(title, prms, globals, input, output)
 }
 keyword.dbs.TreeSQL.Win.mkKeyWrd <- function(input,output)
 {
-  list(ex="base", 
+  list(ex="dbs", 
     kwds = paste0("TreeSQL\n",input$freeEdit,"\nEndSQL\n"),
     reopn = c(freeEdit=input$freeEdit)
   )  
 }
 
-
-
 keyword.dbs.SQLIn.Win <- function(title, prms, globals, input, output)
 {
   globals$currentCmdDefs <- c(f1=" ",freeEdit="")
@@ -99,22 +97,29 @@ keyword.dbs.SQLIn.Win <- function(title, prms, globals, input, output)
   ans = list( 
     list (
       mkScheduleBox("f1",prms,NULL,globals,input,output),
+      tags$style(type="text/css", 
+        "#freeEditCols{font-family:monospace;font-size:90%;width:95%;}"), 
+      tags$p(id="freeEditCols", 
+             HTML(paste0("&nbsp;",paste0("....+....",1:8,collapse="")))),
       tags$style(type="text/css", 
         "#freeEdit{font-family:monospace;font-size:90%;width:95%;}"), 
       tags$textarea(id="freeEdit", rows=10, globals$currentCmdDefs["freeEdit"]),
       tags$p(id="instruct",HTML(paste0(
-            "Run an query on the DSNIn connection. If the query is a SELECT, ",
-            "then the last row of the result table will define the values of ",
-            "variables in the Event Monitor. The variables will have the column names.<br>",
-            "Example:<br><b>Select Inv_Year as MyYear from FVS_StandInit ",
-            "where Stand_ID = '%StandID%';<br></b>will define MyYear in the Event Monitor")
-            ))
+        "Run a query on the DSNIn connection. If the query is a SELECT, ",
+        "the column names from the table are compared to the names of ",
+        "user-defined Event Monitor variables. For any matching variable, ",
+        "the value in the last row of the result table will define the values of ",
+        "variables in the Event Monitor.<br>",
+        "Example:<br><b>SELECT Inv_Year as MyYear<br>FROM FVS_StandInit<br>",
+        "WHERE Stand_ID = '%StandID%'<br></b>will define ",
+        "MyYear as a variable in the Event Monitor")
+        ))  
      ),list())
   ans
 }
 keyword.dbs.SQLIn.Win.mkKeyWrd <- function(input,output)
 {
-  list(ex="base", 
+  list(ex="dbs", 
     kwds = paste0(sprintf("SQLIn     %10s\n",input$f1),input$freeEdit,"\nEndSQL\n"),
     reopn = c(f1=input$f1,freeEdit=input$freeEdit)
   )  
@@ -130,15 +135,29 @@ keyword.dbs.SQLOut.Win <- function(title, prms, globals, input, output)
   ans = list( 
     list (
       mkScheduleBox("f1",prms,NULL,globals,input,output),
+      tags$style(type="text/css", 
+        "#freeEditCols{font-family:monospace;font-size:90%;width:95%;}"), 
+      tags$p(id="freeEditCols", 
+             HTML(paste0("&nbsp;",paste0("....+....",1:8,collapse="")))),
       tags$style(type="text/css", 
         "#freeEdit{font-family:monospace;font-size:90%;width:95%;}"), 
-      tags$textarea(id="freeEdit", rows=10, globals$currentCmdDefs["freeEdit"])),
-    list())
+      tags$textarea(id="freeEdit", rows=10, globals$currentCmdDefs["freeEdit"]),
+          tags$p(id="instruct",HTML(paste0(
+        "Run a query on the DSNOut connection. If the query is a SELECT, ",
+        "the column names from the table are compared to the names of ",
+        "user-defined Event Monitor variables. For any matching variable, ",
+        "the value in the last row of the result table will define the values of ",
+        "variables in the Event Monitor.<br>",
+        "Example:<br><b>SELECT SDI as MySDI<br>FROM FVS_Summary2<br>",
+        "WHERE StandID = '%StandID%'<br></b>will define ",
+        "MySDI as a variable in the Event Monitor")
+        ))  
+    ),list())
   ans
 }
 keyword.dbs.SQLOut.Win.mkKeyWrd <- function(input,output)
 {
-  list(ex="base", 
+  list(ex="dbs", 
     kwds = paste0(sprintf("SQLOut    %10s\n",input$f1),input$freeEdit,"\nEndSQL\n"),
     reopn = c(f1=input$f1,freeEdit=input$freeEdit)
   )  
@@ -241,9 +260,10 @@ PlantNaturalFullWin <- function(title, prms, globals, input, output, full=TRUE)
 {
   pknum = match("management.PlantNatural",names(prms))
   globals$currentCmdPkey = as.character(pknum)  #point to the pkeys.
-  globals$currentCmdDefs <- c(pnDOD="1",pnYD="1",pnPBrn=" ",pnPMch=" ",
-    pnSprt=getPstring(atag=globals$activeVariants[1],pkey="hasSproutingSpecies",
-          pkeys=prms[[pknum]])[[1]],
+  globals$currentCmdDefs <- c(pnDOD="1")
+  if (full) globals$currentCmdDefs <- c(globals$currentCmdDefs,pnYD="1", pnPBrn=" ",pnPMch=" ")
+  globals$currentCmdDefs <- c(globals$currentCmdDefs, pnSprt=getPstring(atag=globals$activeVariants[1],
+                              pkey="hasSproutingSpecies",pkeys=prms[[pknum]])[[1]],
     pnYpn1="1",pnTr1="1",pnSp1=" ", pnTpa1=" ",pnPsv1="100.",pnAge1=" ",
     pnHt1=" ",pnShd1="0",
     pnYpn2="1",pnTr2="1",pnSp2=" ", pnTpa2=" ",pnPsv2="100.",pnAge2=" ",

fvsOL/R/componentWins.R

@@ -1,5 +1,3 @@
-# $Id$
-
 mkStdSel <- function (dbGlb)
 {
   if (length(dbGlb$sids) > 1000) return(renderUI(NULL))

fvsOL/R/editDataUtilities.R

@@ -1,5 +1,3 @@
-# $Id: externalCallable.R 4018 2022-07-27 22:59:15Z nickcrookston $
-#
 #' Build an FVS run in a project
 #'
 #' Build an FVS run in a project and add it to the list of runs in the project. 
@@ -38,7 +36,7 @@ extnMakeRun <- function (prjDir=getwd(),title=NULL,standIDs=NULL,
   if (!file.exists("FVS_Data.db"))
   {
     warning("FVS_Data.db did not exist, default training data was loaded.")
-    frm=system.file("extdata", "FVS_Data.db.default", package=if (devVersion) "fvsOLdev" else "fvsOL")
+    frm=system.file("extdata", "FVS_Data.db.default", package="fvsOL")
     file.copy(frm,dbfile)
   }
   if (!file.exists(dbfile)) stop ("FVS_Data.db must exist")
@@ -668,7 +666,7 @@ extnMakeKeyfile <- function(prjDir=getwd(),runUUID,fvsBin="FVSBin",
   prjDir = normalizePath(prjDir)
   prjDB = file.path(prjDir, "FVSProject.db")
   db=dbConnect(SQLite(), dbname = "FVS_Data.db")
-  rtn = writeKeyFile(globals,db,newSum=TRUE,keyFileName,verbose=verbose)
+  rtn = writeKeyFile(globals,db,keyFileName,verbose=verbose)
   if(rtn=="Run data query returned no data to run.") return("wrong active database")
   dbDisconnect(db)
   rtn
@@ -681,7 +679,7 @@ extnMakeKeyfile <- function(prjDir=getwd(),runUUID,fvsBin="FVSBin",
 #' @param prjDir is the path name to the project directory, if null the 
 #'   current directory is the project directory.
 #' @param runUUID a character string of the run uuid that is processed
-#' @return a vector of stand ids that are in the run.
+#' @return data.frame of stand ids and corresponding uuids that are in the run.
 #' @examples  
 #' runID <- extnMakeRun(title="Make a run, list the stands",
 #'             standIDs=c("01100202010068","01100205010076","01100202010146"),
@@ -695,9 +693,42 @@ extnListStands <- function(prjDir=getwd(),runUUID)
   on.exit(dbDisconnect(db)) 
   fvsRun = loadFVSRun(db,runUUID)
   if (!exists("fvsRun")) stop("runUUID run data not loaded")
-  stands = c()
-  for (std in fvsRun$stands) stands=c(stands,std$sid)
-  return(stands)
+  return(data.frame(uuid= unlist(lapply(fvsRun$stands,function(x) x$uuid)),
+                    stand=unlist(lapply(fvsRun$stands,function(x) x$sid ))))
+}
+
+#' Given a project directory a run uuid, this function deletes stands using
+#' the stand's UUIDs. 
+#'
+#' @param prjDir is the path name to the project directory, if null the 
+#'   current directory is the project directory.
+#' @param runUUID a character string of the run uuid that is processed
+#' @param a vector of stand UUIDs that are in the run that you want deleted.
+#' @return the number of stands deleted.
+#' @examples  
+#' runID <- extnMakeRun(title="Make a run, list the stands",
+#'             standIDs=c("01100202010068","01100205010076","01100202010146"),
+#'             variant="ie")                   
+#' thestands <- extnListStands(runUUID=runID)
+#' todel <- thestands[1,2]  # delete the second stand
+#' extnDeleteStands(prjDir=getwd(),runUUID,todel)
+#' @export
+extnDeleteStands <- function(prjDir=getwd(),runUUID,deleteStandUUIDs)
+{
+  if (missing(runUUID)) stop("runUUID required")
+  if (missing(deleteStandUUIDs)) stop("deleteStandUUIDs required")
+  db = connectFVSProjectDB(prjDir)
+  on.exit(dbDisconnect(db)) 
+  fvsRun = loadFVSRun(db,runUUID)
+  if (!exists("fvsRun")) stop("runUUID run data not loaded")
+  uuids=unlist(lapply(fvsRun$stands,function(x) x$uuid))
+  del=na.omit(match(deleteStandUUIDs,uuids))
+  if (length(del)) 
+  {
+    fvsRun$stands[del]=NULL
+    storeFVSRun(db,fvsRun)
+  }
+  return(length(del))
 }
 
 #' Fetch a run
@@ -812,8 +843,6 @@ extnAddStands <- function(prjDir=getwd(),runUUID,stands,
   }
   allNeed = c("Groups","Inv_Year","AddFiles","FVSKeywords","Sam_Wt",needFs)
   fields = intersect(toupper(fields),toupper(allNeed))
-  if (length(fields) < length(allNeed)) stop("required db fields are missing")
-
   getStds = data.frame(getStds=if (addStandReps) stands else setdiff(stands,
             unlist(lapply(fvsRun$stands,function(x) x$sid))))
   if (nrow(getStds) == 0) return(nadd)
@@ -844,7 +873,7 @@ extnAddStands <- function(prjDir=getwd(),runUUID,stands,
     newstd <- mkfvsStd(sid=sid,uuid=uuidgen(),rep=0,repwt=1,invyr=as.character(invyr))
 
     addfiles = fvsInit[row,"ADDFILES"]
-    if (!is.na(addfiles)) for (addf in names(addfiles))                            
+    if (!is.null(addfiles)) for (addf in names(addfiles))                            
     {                                                  
       nadd$ncmps=nadd$ncmps+1
       newstd$cmps <- append(newstd$cmps,
@@ -970,6 +999,16 @@ extnSimulateRun <- function(prjDir=getwd(),runUUID,fvsBin="FVSBin",ncpu=detectCo
   # adjust location of the input database in the keyword file.  
   indb=grep ("FVS_Data.db$",kwds)
   if (length(indb)) kwds[indb]=paste0("../",kwds[indb])
+  if (length(.libPaths()) > 1)
+  {
+    libpaths=""
+    for (l in .libPaths()) 
+    {
+      libpaths = if (nchar(libpaths)) paste0(libpaths,",") else ".libPaths(c("
+      libpaths=paste0(libpaths,'"',l,'"')
+    }
+    libpaths=paste0(libpaths,"))")
+  } else libpaths=NA
   clindx=1
   for (set in names(asign))
   {
@@ -987,7 +1026,8 @@ extnSimulateRun <- function(prjDir=getwd(),runUUID,fvsBin="FVSBin",ncpu=detectCo
     close(opnout)
     # make the run script
     opnout = file(file.path(rundir,sub(".key$",".Rscript",keyFileName)),open="wt")
-    cat ("library(rFVS)\n",file=opnout)
+    if (!is.na(libpaths)) cat(libpaths,"\n",file=opnout,append=TRUE)   
+    cat ("library(rFVS)\n",file=opnout,append=TRUE)
     if (dir.exists(fvsBin)) fvsBin=gsub(pattern="\\\\",replacement="/",x=normalizePath(fvsBin))
     cat ("rtn=try(fvsLoad('",fvsRun$FVSpgm,"',bin='",fvsBin,
          "'))\nif(class(rtn)=='try-error') stop('fvs load failed')\n",sep="",file=opnout) 
@@ -997,7 +1037,7 @@ extnSimulateRun <- function(prjDir=getwd(),runUUID,fvsBin="FVSBin",ncpu=detectCo
        # look in the system extdata directory to find it in the package
        cmdfil=paste0("customRun_",fvsRun$runScript,".R")
        if (!file.exists(cmdfil)) cmdfil=system.file("extdata", cmdfil, 
-         package = if (devVersion) "fvsOLdev" else "fvsOL")
+         package = "fvsOL")
        if (file.exists(paste=cmdfil))
        {
          cat ("curdir=getwd();setwd('..')\n",file=opnout)
@@ -1021,13 +1061,12 @@ extnSimulateRun <- function(prjDir=getwd(),runUUID,fvsBin="FVSBin",ncpu=detectCo
   cat ('cat (Sys.getpid()," ',fvsRun$title,'; ',ncpu,' CPUs; ",',
        'format(Sys.time(),"%Y-%m-%d_%H_%M_%S"),"\\n",sep="",file="',
        pidStat,'")\n',sep="",file=rscript)
-  if (devVersion) cat('require(fvsOLdev)\n',file=rscript,append=TRUE) else
-                  cat('require(fvsOL)\n',   file=rscript,append=TRUE)
+  if (!is.na(libpaths)) cat(libpaths,"\n",file=rscript,append=TRUE) 
+  cat('require(fvsOL)\n',file=rscript,append=TRUE)
   cat('fvsprocs = makePSOCKcluster(',ncpu,')\n',sep="",file=rscript,append=TRUE)
   cat('pids = unlist(clusterEvalQ(fvsprocs,Sys.getpid()))\n',sep="",file=rscript,append=TRUE)
   cat('cat ("fvsPids:",pids,"\\n",file="',pidStat,'",append=TRUE)\n',sep="",file=rscript,append=TRUE)
-  cat(paste0('clusterEvalQ(fvsprocs,library(',if (devVersion) 'fvsOLdev' else 'fvsOL',
-             '))\n'),sep="",file=rscript,append=TRUE)
+## ??? cat(paste0('clusterEvalQ(fvsprocs,library(fvsOL))\n'),sep="",file=rscript,append=TRUE)
   for (i in 1:ncpu) cat('clusterEvalQ(fvsprocs[',i,'],setwd("',paste0(runUUID,names(asign)[i]),'"))\n',
         sep="",file=rscript,append=TRUE)     
   cat ('try(clusterEvalQ(fvsprocs,source("',runUUID,'.Rscript")))\n',sep="",file=rscript,append=TRUE)
@@ -1056,8 +1095,7 @@ extnSimulateRun <- function(prjDir=getwd(),runUUID,fvsBin="FVSBin",ncpu=detectCo
       }
     }
     dbDisconnect(dbcon)\n',
-  file=rscript,append=TRUE) 
-  
+  file=rscript,append=TRUE)  
   cat ('file.remove("',paste0(runUUID,".pidStatus"),'")\n',sep="",file=rscript,append=TRUE)
 
   rsloc = if (exists("RscriptLocation")) RscriptLocation else

fvsOL/R/externalCallable.R

@@ -1,5 +1,3 @@
-# $Id$
-
 initTableGraphTools <- function (globals,session,output,fvsOutData)
 {
 cat ("initTableGraphTools\n")