Merge branch 'development' of https://github.com/USDAForestService/ForestVegetationSimulator-Interface into open_staging

Author: wagnerds

fvsOL/DESCRIPTION

@@ -1,6 +1,6 @@
 Package: fvsOL
 Title: Forest Vegetation Simulator
-Version: 2025.09.30
+Version: 2026.04.01
 Authors@R: c(person("Nicholas", "Crookston", email = "ncrookston.fs@gmail.com",
                   role = c("aut")),
              person("FVS", "Staff", email = "sm.fs.fvs-support@usda.gov",

fvsOL/R/change_project_dir.R

@@ -93,4 +93,42 @@ change_project_dir <- function(new_proj_dir) {
       cat("cmd for launch project=", cmd, "\nrtn=", rtn, "\n")
      }
   }
+}
+
+getVolumes2 <- function(exclude) {
+  if (missing(exclude)) exclude <- NULL
+
+  function() {
+    osSystem <- Sys.info()["sysname"]
+    if (osSystem == "Darwin") {
+      volumes <- dir_ls("/Volumes")
+      names(volumes) <- basename(volumes)
+    } else if (osSystem == "Linux") {
+      volumes <- c("Computer" = "/")
+      if (isTRUE(dir_exists("/media"))) {
+        media <- dir_ls("/media")
+        names(media) <- basename(media)
+        volumes <- c(volumes, media)
+      }
+    } else if (osSystem == "Windows") {
+        volumes_info <- system2("powershell", "$dvr=[System.IO.DriveInfo]::GetDrives();Write-Output $dvr.length $dvr.name $dvr.VolumeLabel;", stdout = TRUE)
+        num = as.integer(volumes_info[1])
+        if(num == 0) return(NULL)
+        mat <- matrix(volumes_info[-1], nrow = num, ncol = 2)
+        mat[, 1] <- gsub(":\\\\$", ":/", mat[, 1])
+        sel <- mat[, 2] == ""
+        mat[sel, 2] <- mat[sel, 1]
+        volumes <- mat[, 1]
+        volNames <- mat[, 2]
+        volNames <- paste0(volNames, " (", gsub(":/$", ":", volumes), ")")
+        names(volumes) <- volNames
+        volumes <- gsub(":$", ":/", volumes)
+    } else {
+      stop("unsupported OS")
+    }
+    if (!is.null(exclude)) {
+      volumes <- volumes[!names(volumes) %in% exclude]
+    }
+    volumes
+  }
 }

fvsOL/R/fvsRunUtilities.R

@@ -13,7 +13,7 @@ loadStandTableData <- function (globals, dbIcon)
 
 loadVarData <- function(globals,input,dbIcon)
 isolate({
-cat ("in loadVarData, input$inTabs=",input$inTabs," globals$activeVariants=",globals$activeVariants,"\n") 
+cat ("in loadVarData, input$inTabs=",input$inTabs," globals$activeVariants=",globals$activeVariants,"\n")
   dbtabs = dbGetQuery(dbIcon,"select name from sqlite_master where type='table';")[,1]
   dbtabsU = toupper(dbtabs)
   intab = if (is.null(input$inTabs)) toupper("FVS_StandInit") else toupper(input$inTabs)
@@ -169,17 +169,17 @@ cat("findCmp, cmp=",cmp,"\n")
 }
 
 
-mkSimCnts <- function (fvsRun,sels=NULL,foundStand=0L,justGrps=FALSE)
+mkSimCnts <- function(fvsRun,sels=NULL,foundStand=0L,justGrps=FALSE)
 {
   tmpcnts = list()
-  tmptags = list()                         
+  tmptags = list()
   if (!is.null(sels)) if (length(sels) == 0) sels = NULL
-  if (!is.null(sels)) if (length(sels) && is.null(sels[[1]])) sels = NULL 
-  if (justGrps) 
+  if (!is.null(sels)) if (length(sels) && is.null(sels[[1]])) sels = NULL
+  if (justGrps)
   {
     start=1
     end=0
-    for (grp in fvsRun$grps) 
+    for (grp in fvsRun$grps)
     {
       end=end+1+length(grp$cmps)
       tmpcnts <- append(tmpcnts,paste(">",grp$grp))
@@ -382,6 +382,8 @@ resetActiveFVS <- function(globals)
               "climate", "econ", "wrd3", "phewrd3",  "armwrd3", "ardwrd3"), 
     FVSem = c("em", "estb", "dbs", "cover",  "mist", "fire", "climate", 
               "econ", "wrd3", "phewrd3", "armwrd3", "ardwrd3" ), 
+    FVShi = c("hi", "strp", "dbs",  "mist", "fire", "econ", "climate", 
+              "cover", "wrd3", "armwrd3", "phewrd3",  "ardwrd3"), 
     FVSie = c("ie", "estb", "dbs", "cover", "mist", "fire", "climate",  
               "econ", "wrd3", "armwrd3", "phewrd3", "ardwrd3"), 
     FVSkt = c("kt", "estb",  "dbs", "cover", "mist", "fire", "climate", 
@@ -436,6 +438,7 @@ cat ("in resetActiveFVS, avalFVS=",avalFVS,"\nglobals$lastRunVar=",globals$lastR
            "ut: Utah"="ut",                        
            "wc: West Cascades"="wc",
            "pn: Pacific Northwest Coast"="pn",     
+           "hi: Hawaii (modified Pacific Northwest Coast)"="hi",   
            "ws: Western Sierra Nevada,CA"="ws",
            "cs: Central States"="cs",
            "kt: Kootenai/Kaniksu/Tally LK,ID - MT"="kt",
@@ -717,8 +720,7 @@ mkMgmtCats <- function(globals)
     "Seedtree" = "SeedTreeWin",
     "Shelterwood" = "ShelterwoodWin"),
   "Regeneration Methods: Uneven-aged"=c(
-    "Thin to a Q-factor" = "uneven-aged_Q",
-    "Group Selection, Distance-independent" = "uneven-aged_grp_select"),
+    "Thin to a Q-factor" = "uneven-aged_Q"),
   "Thinning & Pruning Operations"=c(
     "Thin from below" = "ThinFromBelowWin",
     "Thin from above" = "ThinFromAboveWin",
@@ -1936,3 +1938,17 @@ DupSpGrpKwdFormat <- function(orgName, dupName, orgKwd){
 
   return(replacementkwd)
 }  
+
+initializeUserGroups <- function(glbs){
+  for(i in glbs$fvsRun$simcnts){
+    cmp <- findCmp(glbs$fvsRun, i)
+    if(!is.null(cmp) && 
+        (cmp$kwdName == "GenGroup")){
+        if(!length(glbs$GrpNum)) glbs$GrpNum[1] <- 1 else
+          glbs$GrpNum[(length(glbs$GrpNum)+1)] <- length(glbs$GrpNum)+1
+          glbs$GenGrp[length(glbs$GrpNum)]<-cmp$title
+      cat("Found Group\n")
+      cat(paste(i,"\n"))
+    }
+  }
+}

fvsOL/R/mkInputElements.R

@@ -179,10 +179,10 @@ mkSelForest <- function (pkey,prms,pmt,fpvs,choices,globals)
   fors[1]="blank"
   myInlineListButton (pkey, pmt, fors, selected =  if (is.null(fpvs)) choices else fpvs, NULL)
 }
-  
-    
-mkSelSpecies <- function (pkey,prms,pmt,fpvs,choices,globals)
-{ 
+
+
+mkSelSpecies <- function(pkey,prms,pmt,fpvs,choices,globals)
+{
   variant <- globals$activeVariants[1]
   spGrp <- as.numeric()
   spkeys <- prms[[paste0("species_",variant)]]
@@ -389,7 +389,7 @@ myInlineListButton <- function (inputId, label, mklist, selected=NULL, deltll)
     # all dropdowns where a blank is not allowed (no deleteAll pkey)
     # applies to most keywords, and when editing previously saved selections (deltll==2).
       # Remove duplicate SpGroup names in species dropdowns due to cut/paste
-      if(names(mklist[1])=="All species"){
+      if(!is.null(names(mklist[1])) && names(mklist[1])=="All species"){
         spgsidxs <- grep("SpGroup", names(mklist))
         spgs <- mklist[spgsidxs]
         if(length(spgsidxs) > 1 && length(spgs)!=length(unique(spgs))){
@@ -491,6 +491,7 @@ mkVarList <- function (globals)
      "BNumSS: Before thin number of valid strata (StrClass keyword required)"="BNumSS", 
      "BRDen: Before thin relative density (Curtis 1982)"="BRDen", 
      "BRDen2: Before thin relative density, SILVAH (Marquis and Ernst 1992)"="BRDen2", 
+     "BGMD: Before thin generalized mean diameter"="BGMD",
      "BSClass: Before thin stand structural classification (StrClass keyword required)"="BSClass", 
      "BSawBio: Before thin sawlog biomass" = "BSawBio",
      "BSawCrb: Before thin sawlog carbon" = "BSawCrb",
@@ -546,6 +547,7 @@ mkVarList <- function (globals)
      "ANumSS: After thin number of valid strata (StrClass keyword required)"="ANumSS", 
      "ARDEN: After thin relative density (Curtis 1982)"="ARDEN", 
      "ARDen2: After thin relative density, SILVAH (Marquis and Ernst 1992)"="ARDen2", 
+     "AGMD: After thin generalized mean diameter"="AGMD",
      "ASClass: After thin stand structural classification (StrClass keyword required)"="ASClass", 
      "ASawBio: After thin sawlog biomass" = "ASawBio",
      "ASawCrb: After thin sawlog carbon" = "ASawCrb",