fixed popFilter bug

USDAForestService · Oct 23, 2023 · 397142e · 397142e
1 parent 87005a7
commit 397142e
Show file tree

Hide file tree

Showing 5 changed files with 47 additions and 30 deletions.
diff --git a/R/check.popdataPLT.R b/R/check.popdataPLT.R
@@ -1,5 +1,5 @@
 check.popdataPLT <- function(dsn, tabs, tabIDs, pltassgn, pltassgnid, 
-	pjoinid, module, popType, popevalid, adj, popFilter=popFilters(), 
+	pjoinid, module, popType, popevalid, adj, popFilter, 
 	nonsamp.pfilter=NULL, unitarea=NULL, areavar, unitvar, unitvar2=NULL, 
 	areaunits, unit.action="keep", removetext="unitarea", strata=FALSE, 
 	stratalut=NULL, strvar=NULL, stratcombine=TRUE, pivot=FALSE, nonresp=FALSE, 

diff --git a/R/modGBpop.R b/R/modGBpop.R
@@ -352,10 +352,11 @@ modGBpop <- function(popType = "VOL",
   }
 
   ## Set user-supplied popFilters values
+  popFilter2 <- popFilters_defaults_list
   if (length(popFilter) > 0) {
     for (i in 1:length(popFilter)) {
       if (names(popFilter)[[i]] %in% names(popFilters_defaults_list)) {
-        assign(names(popFilter)[[i]], popFilter[[i]])
+		popFilter2[[names(popFilter)[[i]]]] <- popFilter[[i]]
       } else {
         stop(paste("Invalid parameter: ", names(popFilter)[[i]]))
       }
@@ -507,18 +508,18 @@ modGBpop <- function(popType = "VOL",
                   "CHNG", "GRM", "GROW", "MORT", "REMV")
   popType <- pcheck.varchar(var2check=popType, varnm="popType", gui=gui,
 		checklst=evalTyplst, caption="popType", multiple=FALSE, stopifnull=TRUE)
-  if (!is.null(evalid)) {
-    popevalid <- as.character(evalid)
+  if (!is.null(popFilter2$evalid)) {
+    popevalid <- as.character(popFilter2$evalid)
     substr(popevalid, nchar(popevalid)-1, nchar(popevalid)) <- 
-		formatC(FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"], width=2, flag="0")
+		formatC(FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"], 
+		width=2, flag="0")
     #evalid <- as.character(evalid)
     #substr(evalid, nchar(evalid)-1, nchar(evalid)) <- "01"
   } 
   if (popType %in% c("GROW", "MORT", "REMV")) {
     popType <- "GRM"
   }
 
-
   ###################################################################################
   ## Load data
   ###################################################################################
@@ -661,7 +662,7 @@ modGBpop <- function(popType = "VOL",
       popTabIDs[[nm]] <- popTableIDs_defaults_list[[nm]]
     }
   }
- 
+
   ###################################################################################
   ## CHECK PLOT PARAMETERS AND DATA
   ## Generate table of sampled/nonsampled plots and conditions
@@ -671,7 +672,7 @@ modGBpop <- function(popType = "VOL",
   pltcheck <- check.popdataPLT(dsn=dsn, tabs=popTabs, tabIDs=popTabIDs, 
       pltassgn=pltassgn, pltassgnid=pltassgnid, pjoinid=pjoinid, 
       module="GB", popType=popType, popevalid=popevalid, adj=adj, 
-	  popFilter=popFilter, nonsamp.pfilter=nonsamp.pfilter, 
+	  popFilter=popFilter2, nonsamp.pfilter=nonsamp.pfilter, 
       unitarea=unitarea, areavar=areavar, unitvar=unitvar, 
       unitvar2=unitvar2, areaunits=areaunits, unit.action=unit.action, 
       strata=strata, stratalut=stratalut, strvar=strvar, pivot=pivot)
@@ -704,7 +705,7 @@ modGBpop <- function(popType = "VOL",
   if (ACI) {
     nfplotsampcnt <- pltcheck$nfplotsampcnt
   }
- 
+
   if (popType %in% c("ALL", "CURR", "VOL")) {
     ###################################################################################
     ## Check parameters and data for popType AREA/VOL

diff --git a/R/modMApop.R b/R/modMApop.R
@@ -322,10 +322,11 @@ modMApop <- function(popType="VOL",
   }
 
   ## Set user-supplied popFilters values
+  popFilter2 <- popFilters_defaults_list
   if (length(popFilter) > 0) {
     for (i in 1:length(popFilter)) {
       if (names(popFilter)[[i]] %in% names(popFilters_defaults_list)) {
-        assign(names(popFilter)[[i]], popFilter[[i]])
+		popFilter2[[names(popFilter)[[i]]]] <- popFilter[[i]]
       } else {
         stop(paste("Invalid parameter: ", names(popFilter)[[i]]))
       }
@@ -464,12 +465,17 @@ modMApop <- function(popType="VOL",
   evalTyplst <- c("ALL", "CURR", "VOL", "LULC", "P2VEG", "INV", "DWM", "CHNG", "GRM")
   popType <- pcheck.varchar(var2check=popType, varnm="popType", gui=gui,
 		checklst=evalTyplst, caption="popType", multiple=FALSE, stopifnull=TRUE)
-  popevalid <- as.character(evalid)
-  if (!is.null(evalid)) {
+  if (!is.null(popFilter2$evalid)) {
+    popevalid <- as.character(popFilter2$evalid)
     substr(popevalid, nchar(popevalid)-1, nchar(popevalid)) <- 
-		formatC(FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"], width=2, flag="0")
+		formatC(FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"], 
+		width=2, flag="0")
+    #evalid <- as.character(evalid)
+    #substr(evalid, nchar(evalid)-1, nchar(evalid)) <- "01"
   } 
-
+  if (popType %in% c("GROW", "MORT", "REMV")) {
+    popType <- "GRM"
+  }
 
   ###################################################################################
   ## Load data
@@ -588,7 +594,7 @@ modMApop <- function(popType="VOL",
   pltcheck <- check.popdataPLT(dsn=dsn, tabs=popTabs, tabIDs=popTabIDs, 
       pltassgn=pltassgn, pltassgnid=pltassgnid, pjoinid=pjoinid, 
       module="MA", popType=popType, popevalid=popevalid, adj=adj, 
-	  popFilter=popFilter, nonsamp.pfilter=nonsamp.pfilter, 
+	  popFilter=popFilter2, nonsamp.pfilter=nonsamp.pfilter, 
 	  unitarea=unitarea, areavar=areavar, unitvar=unitvar, 
 	  unitvar2=unitvar2, areaunits=areaunits, unit.action=unit.action, 
       prednames=prednames, predfac=predfac)

diff --git a/R/modSApop.R b/R/modSApop.R
@@ -289,10 +289,11 @@ modSApop <- function(popType="VOL",
   }
 
   ## Set user-supplied popFilters values
+  popFilter2 <- popFilters_defaults_list
   if (length(popFilter) > 0) {
     for (i in 1:length(popFilter)) {
       if (names(popFilter)[[i]] %in% names(popFilters_defaults_list)) {
-        assign(names(popFilter)[[i]], popFilter[[i]])
+		popFilter2[[names(popFilter)[[i]]]] <- popFilter[[i]]
       } else {
         stop(paste("Invalid parameter: ", names(popFilter)[[i]]))
       }
@@ -372,12 +373,17 @@ modSApop <- function(popType="VOL",
   evalTyplst <- c("ALL", "CURR", "VOL", "LULC", "P2VEG", "INV", "DWM", "CHNG", "GRM")
   popType <- pcheck.varchar(var2check=popType, varnm="popType", gui=gui,
 		checklst=evalTyplst, caption="popType", multiple=FALSE, stopifnull=TRUE)
-  popevalid <- as.character(evalid)
-  if (!is.null(evalid)) {
+  if (!is.null(popFilter2$evalid)) {
+    popevalid <- as.character(popFilter2$evalid)
     substr(popevalid, nchar(popevalid)-1, nchar(popevalid)) <- 
-		formatC(FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"], width=2, flag="0")
+		formatC(FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"], 
+		width=2, flag="0")
+    #evalid <- as.character(evalid)
+    #substr(evalid, nchar(evalid)-1, nchar(evalid)) <- "01"
   } 
-
+  if (popType %in% c("GROW", "MORT", "REMV")) {
+    popType <- "GRM"
+  }
 
   ###################################################################################
   ## Load data
@@ -527,7 +533,7 @@ modSApop <- function(popType="VOL",
   pltcheck <- check.popdataPLT(dsn=dsn, tabs=popTabs, tabIDs=popTabIDs, 
       pltassgn=pltassgn, pltassgnid=pltassgnid, pjoinid=pjoinid, 
       module="SA", popType=popType, popevalid=popevalid, adj=adj, 
-	  popFilter=popFilter, nonsamp.pfilter=nonsamp.pfilter, 
+	  popFilter=popFilter2, nonsamp.pfilter=nonsamp.pfilter, 
 	  unitarea=dunitarea, areavar=areavar, unitvar=dunitvar, 
 	  unitvar2=dunitvar2, areaunits=areaunits, unit.action=unit.action, 
       prednames=prednames, predfac=predfac, pvars2keep="AOI")

diff --git a/R/modWFpop.R b/R/modWFpop.R
@@ -318,16 +318,17 @@ modWFpop <- function(popType = "VOL",
   }
 
   ## Set user-supplied popFilters values
+  popFilter2 <- popFilters_defaults_list
   if (length(popFilter) > 0) {
     for (i in 1:length(popFilter)) {
       if (names(popFilter)[[i]] %in% names(popFilters_defaults_list)) {
-        assign(names(popFilter)[[i]], popFilter[[i]])
+		popFilter2[[names(popFilter)[[i]]]] <- popFilter[[i]]
       } else {
         stop(paste("Invalid parameter: ", names(popFilter)[[i]]))
       }
     }
   }
-
+   
   ## Set savedata defaults
   savedata_defaults_list <- formals(savedata_options)[-length(formals(savedata_options))]
 
@@ -470,14 +471,17 @@ modWFpop <- function(popType = "VOL",
   evalTyplst <- c("ALL", "CURR", "VOL", "LULC", "P2VEG", "INV", "DWM", "CHNG", "GRM")
   popType <- pcheck.varchar(var2check=popType, varnm="popType", gui=gui,
 		checklst=evalTyplst, caption="popType", multiple=FALSE, stopifnull=TRUE)
-  if (!is.null(evalid)) {
-    popevalid <- as.character(evalid)
+  if (!is.null(popFilter2$evalid)) {
+    popevalid <- as.character(popFilter2$evalid)
     substr(popevalid, nchar(popevalid)-1, nchar(popevalid)) <- 
-		FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"]
-    evalid <- as.character(evalid)
-    substr(evalid, nchar(evalid)-1, nchar(evalid)) <- "01"
+		formatC(FIESTAutils::ref_popType[FIESTAutils::ref_popType$popType %in% popType, "EVAL_TYP_CD"], 
+		width=2, flag="0")
+    #evalid <- as.character(evalid)
+    #substr(evalid, nchar(evalid)-1, nchar(evalid)) <- "01"
   } 
-
+  if (popType %in% c("GROW", "MORT", "REMV")) {
+    popType <- "GRM"
+  }
 
   ###################################################################################
   ## Load data
@@ -626,7 +630,7 @@ modWFpop <- function(popType = "VOL",
   pltcheck <- check.popdataPLT(dsn=dsn, tabs=popTabs, tabIDs=popTabIDs, 
       pltassgn=pltassgn, pltassgnid=pltassgnid, pjoinid=pjoinid, 
       module="GB", popType=popType, popevalid=popevalid, adj=adj, 
-	  popFilter=popFilter, nonsamp.pfilter=nonsamp.pfilter, 
+	  popFilter=popFilter2, nonsamp.pfilter=nonsamp.pfilter, 
 	  unitarea=unitarea, areavar=areavar, unitvar=unitvar, 
 	  unitvar2=unitvar2, areaunits=areaunits, unit.action=unit.action, 
 	  strata=strata, stratalut=stratalut, strvar=strvar, pivot=pivot,