Nothing
R/check.popdataPLT.R
In FIESTA: Forest Inventory Estimation and Analysis
Defines functions
check.popdataPLT
check.popdataPLT <- function(dsn,
tabs,
tabIDs,
pltassgn,
pltassgnid,
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,
prednames=NULL,
predfac=NULL,
pvars2keep=NULL,
pdoms2keep=NULL,
nullcheck=FALSE,
defaultVars=TRUE,
unitlevels=NULL,
gui=FALSE) {
##############################################################################
## DESCRIPTION: Checks plot data inputs
## - Set plt domains to add to cond (pdoms2keep) - STATECD, UNITCD, COUNTYCD,
## INVYR, MEASYEAR, PLOT_STATUS_CD, RDDISTCD, WATERCD, ELEV, ELEV_PUBLIC,
## ECOSUBCD, CONGCD, INTENSITY, DESIGNCD
## Check logical parameters: ACI, strata, stratcombine (if strata=TRUE)
## - If ACI, add NF_PLOT_STATUS_CD to pvars2keep and NF_COND_STATUS_CD to cvars2keep
## - If unit.action='combine', estimation units are combined if less than 10 plots
## - If strata, only 1 auxvar allowed, add to pvars2keep
## - If module = SA or MA-greg, add prednames to pvars2keep
## - If adj="samp", nonsample adjustment factors calculated at strata level
## - If adj="plot", nonsample adjustment factors calculated at plot level
## Check unit.action ('keep', 'remove', 'combine').
## Check predfac, if module = SA, MA-greg
## Import and check plt and pltassgn tables
## Check corresponding unique identifiers (puniqueid, pltassgnid)
## Merge plt, pltassgn tables to check necessary variables
## Check plot data
## - Check for missing pvars2keep variables
## - Check for missing pdoms2keep variables (STATE, INTENSITY, INVYR, DESIGNCD)
## - Get state(s) and inventory year(s) (for titles)
## - Generate table of sampled/nonsampled plots (if PLOT_STATUS_CD included)
## - If ACI, add table of sampled/nonsampled nonforest plots (if NF_PLOT_STATUS_CD included)
## - Generate table of plots by strata, including nonsampled plots (P2POINTCNT)
## - If nonresp, generate table of nonsampled plots by strata, substrvar
## - Generate and apply nonsamp.pfilter (PLOT_STATUS_CD != 3)
## - Check for NA values in pvars2keep variables
## - If unitvar = NULL, add unitvar=ONEUNIT
## Subset variables for pltx and pltassgnx
##############################################################################
## Set global variables
STATECD <- PLOT_STATUS_CD <- PSTATUSCD <- plotsampcnt <- nfplotsampcnt <-
INVYR <- NF_PLOT_STATUS_CD <- NF_COND_STATUS_CD <- TPA_UNADJ <- methodlst <-
nonresplut <- plotqry <- pfromqry <- pltassgnqry <- unitareaqry <-
stratalutqry <- whereqry <- palias <- P2POINTCNT <- plt <- dbconn_pltassgn <-
popwhereqry <- NULL
##############################################################################
## Define necessary plot variables
##############################################################################
datindb <- unitindb <- stratindb <- FALSE
dbconn <- pstratvars <- plotqry <- NULL
unitvars <- unique(c(unitvar, unitvar2))
pltassgnvars <- unique(c(pltassgnid, unitvars))
## Define plt variables
##############################################################################
pvars2keep <- unique(pvars2keep)
pdoms <- unique(c("STATECD", "UNITCD", "COUNTYCD", "INVYR", "PLOT_STATUS_CD",
"PLOT_NONSAMPLE_REASN_CD", "PSTATUSCD", "INTENSITY", "MEASYEAR",
"RDDISTCD", "WATERCD", "ELEV", "ELEV_PUBLIC", "ECOSUBCD", "CONGCD",
"DESIGNCD", "EMAP_HEX", pdoms2keep))
## Get tables from tabs
##############################################################################
for (tabnm in names(tabs)) {
assign(tabnm, tabs[[tabnm]])
}
puniqueid <- tabIDs[["plt"]]
##############################################################################
## Check parameters
##############################################################################
## Check adj
##############################################################################
adjlst <- c("samp", "plot", "none")
adj <- pcheck.varchar(var2check=adj, varnm="adj", gui=gui,
checklst=adjlst, caption="adj", multiple=FALSE, stopifnull=TRUE)
if (adj == "plot" && module == "GB") {
message("adj='plot' is not typical for GB modules")
}
if (adj != "none") {
pvars2keep <- c(pvars2keep, "MACRO_BREAKPOINT_DIA")
}
## Check ACI (if ACI=FALSE, need to filter COND_STATUS_CD == 1)
##############################################################################
ACI <- pcheck.logical(popFilter$ACI, varnm="ACI",
title="ACI?", first="NO", gui=gui)
if (ACI) {
pvars2keep <- c(pvars2keep, "NF_SAMPLING_STATUS_CD", "NF_PLOT_STATUS_CD")
}
## Check unit.action
########################################################
unit.actionlst <- c("keep", "remove", "combine")
unit.action <- pcheck.varchar(var2check=unit.action, varnm="unit.action",
gui=gui, checklst=unit.actionlst,
caption="unit.action",
multiple=FALSE, stopifnull=TRUE)
## Set additional pvars2keep
##############################################################################
if (popType %in% c("GRM", "CHNG", "LULC")) {
pvars2keep <- unique(c(pvars2keep, c("PREV_PLT_CN", "REMPER")))
} else if (popType == "P2VEG") {
pvars2keep <- c(pvars2keep, "P2VEG_SAMPLING_STATUS_CD",
"P2VEG_SAMPLING_LEVEL_DETAIL_CD","SAMP_METHOD_CD")
} else if (popType == "INV") {
pvars2keep <- c(pvars2keep, "INVASIVE_SAMPLING_STATUS_CD",
"INVASIVE_SPECIMEN_RULE_CD")
}
## Check strata, strvars
##############################################################################
strata <- pcheck.logical(strata, varnm="strata",
title="Post stratify?", first="YES", gui=gui, stopifnull=TRUE)
## Check strata parameters
##############################################################################
if (strata) {
## pivot
pivot <- pcheck.logical(pivot, varnm="pivot",
title="Pivot stratalut?", first="NO", gui=gui)
## Check nonresp
nonresp <- pcheck.logical(nonresp, varnm="nonresp",
title="Post stratify?", first="YES", gui=gui)
## Check stratcombine
stratcombine <- pcheck.logical(stratcombine, varnm="stratcombine",
title="Combine strata?", first="YES", gui=gui, stopifnull=TRUE)
## Check strvar
if (is.null(strvar)) stop("must include strvar for post-strat estimates")
if (length(strvar) > 1) stop("invalid strvar... only 1 variable allowed")
pltassgnvars <- unique(c(pltassgnvars, strvar))
if (nonresp) {
pstratvars <- unique(c(pstratvars, c("PLOT_STATUS_CD", "SAMP_METHOD_CD")))
}
} else {
strvar <- NULL
pltassgnvars <- unique(c(pltassgnvars, prednames))
}
## Check predfac
##############################################################################
if (!is.null(predfac)) {
if (!is.character(predfac)) {
stop("invalid predfac... must be character string")
}
notin <- predfac[!predfac %in% prednames]
if (length(notin) > 0) {
warning("invalid predfac... not in prednames: ", toString(notin))
predfac <- predfac[predfac %in% prednames]
if (length(predfac) == 0) predfac <- NULL
}
}
##############################################################################
## Database queries
##############################################################################
evalid <- popFilter$evalid
invyrs <- popFilter$invyrs
if (!is.null(dsn) && (getext(dsn) %in% c("sqlite", "db", "db3", "sqlite3", "gpkg"))) {
datindb <- TRUE
dbconn <- DBtestSQLite(dsn, dbconnopen=TRUE, showlist=FALSE)
tablst <- DBI::dbListTables(dbconn)
ppsanm <- pltassgnqry <- NULL
## Check name of plt
if (!is.null(plt)) {
if (plt == "plot" && "plt" %in% tablst) {
plt <- "plt"
} else if (plt == "plt" && "plot" %in% tablst) {
plt <- "plot"
}
pltflds <- DBI::dbListFields(dbconn, plt)
} else if (popType == "CHNG" && !is.null(pltu)) {
plt <- pltu
puniqueid <- "CN"
}
## Check name of pltassgn
if (!is.null(pltassgn)) {
if (!is.data.frame(pltassgn) && is.character(pltassgn)) {
dbconn_pltassgn <- dbconn
ppsanm <- chkdbtab(tablst, pltassgn, stopifnull=TRUE)
ppsaflds <- DBI::dbListFields(dbconn_pltassgn, ppsanm)
}
pltassgnid <- findnm(pltassgnid, ppsaflds, returnNULL = TRUE)
if (is.null(pltassgnid)) stop("pltassgnid is invalid")
}
if (!is.null(evalid)) {
## Filter for population data
evalidnm <- chkdbtab(ppsaflds, "EVALID", stopifnull=TRUE)
if (is.data.frame(pltassgn)) {
evalidvals <- sort(unique(pltassgn[[evalidnm]]))
} else {
evalidvals <-
DBI::dbGetQuery(dbconn_pltassgn,
paste("SELECT DISTINCT", evalidnm, "FROM", ppsanm))[[1]]
}
if (any(!evalid %in% evalidvals)) {
stop("evalids are missing: ", toString(evalid[!evalid %in% evalidvals]))
}
#whereqry <- paste0("\nWHERE ", evalidnm, " IN(", toString(evalid), ")")
whereqry <- paste0("\nWHERE ", evalidnm, " IN(", toString(popevalid), ")")
pltassgnqry <- paste0("SELECT * FROM ", ppsanm, whereqry)
if (is.null(plt)) {
palias <- "ppsa"
pfromqry <- paste(ppsanm, "ppsa")
pjoinid <- pltassgnid
} else {
palias <- "p"
pfromqry <- getpfromqry(evalid=evalid, popevalid, ppsanm=ppsanm,
ppsaid=pltassgnid, pjoinid=pjoinid,
plotnm=plt, dbconn=dbconn)
}
} else if (!is.null(popFilter$measCur) && popFilter$measCur) {
palias <- "p"
pfromqry <- getpfromqry(varCur="MEASYEAR", Endyr=popFilter$measEndyr,
dsn=dsn, plotnm=plt, dbconn=dbconn)
if (!is.null(ppsanm)) {
ppsaalias <- "ppsa"
pltassgnqry <- paste0("SELECT ", ppsaalias, ".* ",
"\nFROM ", pfromqry,
"\nJOIN ", ppsanm, " ", ppsaalias,
" ON(", palias, ".", puniqueid, " = ", ppsaalias, ".", pltassgnid, ")",
whereqry)
}
} else if (!is.null(invyrs)) {
if (is.null(plt)) {
invyrnm <- chkdbtab(ppsaflds, "INVYR", stopifnull=TRUE)
whereqry <- paste0("\nWHERE ", invyrnm, " IN(", toString(invyrs), ")")
pltassgnqry <- paste0("SELECT ", ppsaalias, ".* ",
"\nFROM ", ppsanm, whereqry)
} else {
palias <- "p"
pfromqry <- getpfromqry(invyrs=invyrs, plotCur=FALSE, dsn=dsn,
plotnm=plt, dbconn=dbconn)
if (!is.null(ppsanm)) {
ppsaalias <- "ppsa"
invyrnmplt <- findnm("INVYR", pltflds, returnNULL=TRUE)
invyrnmppsa <- findnm("INVYR", ppsaflds, returnNULL=TRUE)
if (is.null(invyrnmplt) && is.null(invyrnmppsa)) stop("INVYR variable not in tables")
if (!is.null(invyrnmplt) && !is.null(invyrnmppsa)) {
if (!is.null(invyrnmplt)) {
invyrnm <- paste0(palias, ".", invyrnmplt)
} else {
invyrnm <- paste0(ppsaalias, ".", invyrnmppsa)
}
} else {
invyrnm <- ifelse(!is.null(invyrnmplt), invyrnmplt, invyrnmppsa)
}
whereqry <- paste0("\nWHERE ", invyrnm, " IN(", toString(invyrs), ")")
pltassgnqry <- paste0("SELECT ", ppsaalias, ".* ",
"\nFROM ", pfromqry,
"\nJOIN ", ppsanm, " ", ppsaalias, " ON(",
palias, ".", puniqueid, " = ", ppsaalias, ".", pltassgnid,
")", whereqry)
}
}
} else {
whereqry <- NULL
if (is.null(plt)) {
palias <- "ppsa"
pfromqry <- paste(ppsanm, "ppsa")
pjoinid <- pltassgnid
} else {
palias <- "p"
pfromqry <- paste0(plt, " p INNER JOIN ", ppsanm,
" ON(p.", pjoinid, " = ", ppsanm, ".", pltassgnid, ")")
}
pltassgnqry <- paste("SELECT * FROM", ppsanm)
}
if (!is.null(pfromqry)) {
pvars <- paste0(palias, ".*")
ppvars <- paste0("pplot", ".*")
plotqry <- paste0("SELECT DISTINCT ", palias, ".* ",
"\nFROM ", pfromqry)
if (popType == "TEST") {
plot1qry <- paste0("SELECT DISTINCT ", pvars,
"\nFROM ", pfromqry,
"\nJOIN ", plt, " pplot ON (pplot", ".", puniqueid, " = ",
palias, ".PREV_PLT_CN) ", whereqry)
plot2qry <- paste0("SELECT DISTINCT ", ppvars,
"\nFROM ", pfromqry,
"\nJOIN ", plt, " pplot ON (pplot", ".", puniqueid, " = ",
palias, ".PREV_PLT_CN) ", whereqry)
plotqry <- paste(plot1qry, "\nUNION", plot2qry)
} else {
plotqry <- paste0("SELECT DISTINCT ", pvars,
"\nFROM ", pfromqry, whereqry)
}
#dbqueries$plot <- plotqry
}
if (is.character(unitarea) && !is.null(chkdbtab(tablst, unitarea))) {
unitindb <- TRUE
unitarea_layer <- chkdbtab(tablst, unitarea)
unitareaflds <- DBI::dbListFields(dbconn, unitarea_layer)
unitareaqry <- paste("SELECT * FROM", unitarea_layer)
evalidnm <- findnm("EVALID", unitareaflds, returnNULL = TRUE)
if (!is.null(evalid) && !is.null(evalidnm)) {
unitareaqry <- paste(unitareaqry, "WHERE", evalidnm, "IN(", toString(popevalid), ")")
}
unitarea <- pcheck.table(unitarea, conn=dbconn,
tabnm="unitarea", caption="unitarea?",
nullcheck=nullcheck, tabqry=unitareaqry,
returnsf=FALSE)
}
if (strata && is.character(stratalut) && !is.null(chkdbtab(tablst, stratalut))) {
stratindb <- TRUE
stratalut_layer <- chkdbtab(tablst, stratalut)
stratalutflds <- DBI::dbListFields(dbconn, stratalut_layer)
stratalutqry <- paste("SELECT * FROM", stratalut_layer)
evalidnm <- findnm("EVALID", unitareaflds, returnNULL = TRUE)
if (!is.null(evalid) && !is.null(evalidnm)) {
stratalutqry <- paste(stratalutqry, "WHERE", evalidnm, "IN(", toString(popevalid), ")")
}
stratalut <- pcheck.table(stratalut, conn=dbconn,
tabnm="stratalut", caption="stratalut?",
nullcheck=nullcheck, tabqry=stratalutqry, returnsf=FALSE)
}
} else {
if (all(sapply(tabs, is.character))) {
message("all popTabs are character... but dsn is missing")
return(NULL)
}
}
##############################################################################
## Import tables
##############################################################################
pltx <- pcheck.table(plt, conn=dbconn,
tabnm="plt", caption="plot table?",
nullcheck=nullcheck, tabqry=plotqry, returnsf=FALSE)
pltassgnx <- pcheck.table(pltassgn, conn=dbconn_pltassgn,
tabnm="pltassgn", caption="plot assignments?",
nullcheck=nullcheck, tabqry=pltassgnqry, returnsf=FALSE)
##############################################################################
## Check and merge plt, pltassgn, cond
##############################################################################
pvars <- NULL
if (!is.null(pltx) || !is.null(pltassgnx)) {
if (!is.null(pltx)) {
pltnmlst <- names(pltx)
puniqueid <- pcheck.varchar(var2check=puniqueid, varnm="puniqueid",
gui=gui, checklst=names(pltx),
caption="UniqueID variable of plot",
warn=paste(puniqueid, "not in plt table"),
stopifnull=TRUE)
if (any(duplicated(pltx[[puniqueid]]))) {
dups <- pltx[[puniqueid]][duplicated(pltx[[puniqueid]])]
warning(paste("plt records are not unique in: plt:", toString(dups)))
}
pvars <- c(pvars, puniqueid)
## Check for NA values in necessary variables in plt table
pltx.na <- sum(is.na(pltx[[puniqueid]]))
if (pltx.na > 0) {
if (length(pltx.na) == 1) {
message("1 NA value in ", puniqueid)
} else {
message(pltx.na, " NA values in ", puniqueid)
}
pltx <- pltx[!is.na(pltx[[puniqueid]]), ]
}
## Set key
setkeyv(pltx, puniqueid)
}
if (!is.null(pltassgnx)) {
if (!datindb && !is.null(evalid) && !is.null(chkdbtab(names(pltassgnx), "EVALID"))) {
evalidnm <- chkdbtab(names(pltassgnx), "EVALID")
popevalid <- unlist(popevalid)
if (!all(evalid %in% unique(pltassgnx[[evalidnm]]))) {
evalid.miss <- evalid[which(!evalid %in% unique(pltassgnx[["EVALID"]]))]
message("evalid not in dataset: ", paste(evalid.miss, collapse=", "))
if (length(evalid.miss) == length(evalid)) stop("None of the evalids exist in dataset")
evalid <- evalid[!evalid %in% evalid.miss]
}
pltassgnx <- datFilter(pltassgnx, getfilter("EVALID", popevalid, syntax="R"))$xf
if (nrow(pltassgnx) == 0) {
stop("evalid removed all records")
return(NULL)
}
}
if (any(duplicated(pltassgnx[[pltassgnid]]))) {
warning("plot records are not unique in: pltassgn")
}
## Check for NA values in necessary variables in plt table
pltassgnx.na <- sum(is.na(pltassgnx[[pltassgnid]]))
if (pltassgnx.na > 0) stop("NA values in ", pltassgnid)
## Set key
setkeyv(pltassgnx, pltassgnid)
}
## Merge plot and pltassgn tables
############################################################################
if (!is.null(pltx) && !is.null(pltassgnx)) {
pjoinid <- pcheck.varchar(var2check=pjoinid, varnm="pjoinid", gui=gui,
checklst=names(pltx), caption="Joinid variable in plot",
warn=paste(pjoinid, "not in plt table"))
if (is.null(pjoinid)) pjoinid <- puniqueid
setkeyv(pltx, pjoinid)
pltassgnx <- pltassgnx[, unique(c(pltassgnid, names(pltassgnx)[!names(pltassgnx) %in% names(pltx)])), with=FALSE]
setkeyv(pltassgnx, pltassgnid)
## Check if class of pjoinid in pltx matches class of pltassgnid in pltassgnx
tabchk <- check.matchclass(pltx, pltassgnx, pjoinid, pltassgnid)
pltx <- tabchk$tab1
pltassgnx <- tabchk$tab2
#if (pjoinid %in% names(pltassgnx)) {
# pltassgnid <- pjoinid
# setkeyv(pltassgnx, pjoinid)
#}
## Check for matching unique identifiers of pltx with pltassgnx
## Subset pltx to pltassgnx ids
pltx <- check.matchval(pltx, pltassgnx, pjoinid, pltassgnid, tab1txt="plt",
tab2txt="pltassgn", subsetrows=TRUE)
pltxvars <- names(pltx)[!names(pltx) %in% names(pltassgnx)]
## Merge pltx and pltassgnx (Note: inner join)
# pltx <- merge(pltassgnx,
# pltx[, unique(c(pjoinid, pltxvars)), with=FALSE],
# by.x=pltassgnid, by.y=pjoinid)
pltx <- merge(pltx[, unique(c(pjoinid, pltxvars)), with=FALSE],
pltassgnx,
by.x=pjoinid, by.y=pltassgnid)
#pltx <- merge(pltx, pltassgnx, by.x=pjoinid, by.y=pltassgnid)
} else if (is.null(pltx)) {
pltx <- pltassgnx
puniqueid <- pltassgnid
if (is.null(pjoinid)) pjoinid <- pltassgnid
}
}
## Check for duplicate plots
locvars <- c("STATECD", "UNITCD", "COUNTYCD", "PLOT")
if (all(locvars %in% names(pltx)) && any(pltx[, duplicated(.SD), .SDcols=locvars]) && (!popType %in% c("GRM", "CHNG"))) {
warning("duplicated plot locations exist... invalid for estimation")
return(NULL)
}
##############################################################################
## Check filter(s) for population data
##############################################################################
if (!datindb) {
if (!is.null(pltx) && (!is.null(popFilter$measCur) && popFilter$measCur || !is.null(popFilter$measEndyr))) {
pltx <- getPlotCur(pltx, Endyr=popFilter$measEndyr, varCur="MEASYEAR",
Endyr.filter=popFilter$measEndyr.filter)
} else if (!is.null(invyrs)) {
if (!"INVYR" %in% names(pltx)) stop("INVYR not in pltx")
if (!all(invyrs %in% unique(pltx[["INVYR"]]))) {
invyrs.miss <- invyrs[which(!invyrs %in% unique(pltx[["INVYR"]]))]
message("invyrs not in dataset: ", paste(invyrs.miss, collapse=", "))
if (length(invyrs.miss) == length(invyrs)) stop("None of the invyrs exist in dataset")
invyrs <- invyrs[!invyrs %in% invyrs.miss]
}
invyrs.filter <- getfilter(invyrsnm, invyrs)
pltx <- datFilter(pltx, invyrs.filter)$xf
}
}
## Subset popFilter - intensity
if (!is.null(popFilter$intensity)) {
intensity <- popFilter$intensity
intensitynm <- pcheck.varchar(var2check="INTENSITY",
checklst=names(pltx),
warn="INTENSITY variable not in plt")
intensitymiss <- intensity[!all(intensity %in% unique(pltx[[intensitynm]]))]
if (length(intensitymiss) > 0) {
warning("invalid intensity: ", toString(intensitymiss))
return(NULL)
}
intensity.filter <- getfilter(intensitynm, intensity)
pltx <- datFilter(pltx, intensity.filter)$xf
if (nrow(pltx) == 0) {
warning("intensity pop filter returned 0 records")
return(NULL)
}
}
## Subset popFilter - invyrs (if additional to evalid)
if (!is.null(evalid) && !is.null(invyrs)) {
invyrsnm <- pcheck.varchar(var2check="INVYR",
checklst=names(pltx),
warn="INVYR variable not in plt")
invyrsmiss <- invyrs[!all(invyrs %in% unique(pltx[[invyrsnm]]))]
if (length(invyrsmiss) > 0) {
warning("invalid invyrs: ", toString(invyrsmiss))
return(NULL)
}
invyrs.filter <- getfilter(invyrsnm, invyrs)
pltx <- datFilter(pltx, invyrs.filter)$xf
if (nrow(pltx) == 0) {
warning("invry pop filter returned 0 records")
return(NULL)
}
}
## Subset popFilter - AOIonly
if (!is.null(popFilter$AOIonly) && popFilter$AOIonly) {
AOInm <- pcheck.varchar(var2check="AOI",
checklst=names(pltx),
warn="AOI variable not in plt")
AOI.filter <- getfilter(AOInm, 1)
pltx <- datFilter(pltx, paste(AOInm, "== 1"))$xf
if (nrow(pltx) == 0) {
warning("AOI pop filter returned 0 records")
return(NULL)
}
}
##############################################################################
## Check for missing plot variables
##############################################################################
pltnmlst <- names(pltx)
pltvars <- unique(c(pltassgnvars, pstratvars, pvars2keep))
pvarsmiss <- pltvars[which(!pltvars %in% pltnmlst)]
# if (length(pvarsmiss) > 0) {
# stop("missing variables: ", paste(pvarsmiss, collapse=", "))
# }
pdoms2keep <- ifelse(defaultVars, pdoms, pltnmlst)
## Check missing pdoms2keep variables in pltx
##############################################################################
pmissvars <- pdoms2keep[which(!pdoms2keep %in% pltnmlst)]
if (length(pmissvars) > 0) {
if ("STATECD" %in% pmissvars)
message("STATECD not in dataset.. assuming 1 state in dataset")
if ("INTENSITY" %in% pmissvars)
message("INTENSITY not in dataset.. assuming single intensity plots")
if ("INVYR" %in% pmissvars)
message("INVYR not in dataset.. assuming inventory years do not span more than 1 cycle of measurements")
if (!"DESIGNCD" %in% pltnmlst) {
message("DESIGNCD not in dataset.. assuming DESIGNCD = 1 (annual inventory)")
designcd <- 1
} else {
# NOTE: If adj='samp', make sure dataset is annual inventory only (DESIGNCD=1).
# Only adjust plots when DESIGNCD=1. Cannot have more than 1 DESIGNCD.
designcd <- unique(na.omit(pltx[["DESIGNCD"]]))
if (length(designcd) > 1) {
if (any(!designcd %in% c(1, 501:505, 230:242, 311:323, 328))) {
if (adj == "samp") {
message("designcds include: ", toString(sort(designcd)))
message("samp adjustment for trees is only for annual inventory designs... see FIA database manual")
} else {
warning("more than 1 plot design, calculate separate estimates by design")
}
}
}
}
pmissvars <- pmissvars[which(!pmissvars %in% pltnmlst)]
if (any(prednames %in% pmissvars)) {
prednames[which(!prednames %in% pmissvars)]
warning("predname not in tables: ", paste(prednames, collapse=", "))
return(NULL)
}
if (any(unitvars %in% pmissvars)) {
unitvars[which(!unitvars %in% pmissvars)]
warning("unitvar not in tables: ", paste(unitvars, collapse=", "))
return(NULL)
}
}
#pdoms2keep <- unique(pdoms2keep[which(!pdoms2keep %in% pmissvars)])
## Check for duplicate plots
if (any(duplicated(pltassgnx[[pltassgnid]]))) {
message("duplicate plots exist... returning NULL... check popFilters")
return(NULL)
}
## Get state(s) and inventory year(s) (for titles)
##############################################################################
states <- NULL
invyrs <- NULL
if ("STATECD" %in% names(pltx)) {
stcds <- unique(pltx[["STATECD"]])
states <- pcheck.states(stcds)
if ("INVYR" %in% names(pltx)) {
invyrtab <- unique(pltx[, c("STATECD", "INVYR")])
setorderv(invyrtab, c("STATECD", "INVYR"))
invyrs <- as.list(by(invyrtab$INVYR, invyrtab$STATECD, I))
names(invyrs) <- pcheck.states(names(invyrs))
}
}
## Generate table of sampled/nonsampled plots
## (if ACI, nonforest status included)
##############################################################################
if (any(c("PLOT_STATUS_CD", "PSTATUSCD") %in% pltnmlst)) {
if ("PSTATUSCD" %in% names(pltx))
names(pltx)[names(pltx) == "PSTATUSCD"] <- "PLOT_STATUS_CD"
ref_plot_status_cd <- ref_codes[ref_codes$VARIABLE == "PLOT_STATUS_CD", ]
plotsampcnt <- pltx[, list(NBRPLOT=uniqueN(get(puniqueid))), by="PLOT_STATUS_CD"]
plotsampcnt <- cbind(PLOT_STATUS_NM=ref_plot_status_cd[match(plotsampcnt$PLOT_STATUS_CD, ref_plot_status_cd$VALUE), "MEANING"],
plotsampcnt)
setkey(plotsampcnt, PLOT_STATUS_CD)
} else {
if (nonresp) stop("PLOT_STATUS_CD must be in dataset if nonresp=TRUE")
message("PLOT_STATUS_CD not in dataset.. assuming all plots are at least partially sampled")
plotsampcnt <- pltx[, list(NBRPLOT=uniqueN(get(puniqueid)))]
}
if (ACI) {
if (any(c("NF_PLOT_STATUS_CD", "PSTATUSNF") %in% pltnmlst)) {
if ("PSTATUSNF" %in% names(pltx))
names(pltx)[names(pltx) == "PSTATUSNF"] <- "NF_PLOT_STATUS_CD"
ref_nf_plot_status_cd <- ref_codes[ref_codes$VARIABLE == "NF_PLOT_STATUS_CD", ]
nfplotsampcnt <- pltx[, list(NBRPLOT=uniqueN(get(puniqueid))), by=NF_PLOT_STATUS_CD]
nfplotsampcnt <- cbind(NF_PLOT_STATUS_NM=ref_nf_plot_status_cd[match(nfplotsampcnt$NF_PLOT_STATUS_CD, ref_nf_plot_status_cd$VALUE), "MEANING"],
nfplotsampcnt)
setkey(nfplotsampcnt, NF_PLOT_STATUS_CD)
nfplotsampcnt <- nfplotsampcnt[!is.na(NF_PLOT_STATUS_CD), ]
} else {
message("NF_PLOT_STATUS_CD not in dataset.. assuming all ACI nonforest plots are at least partially sampled")
}
if (!is.null(plotsampcnt)) {
plotsampcnt <- rbindlist(list(plotsampcnt, nfplotsampcnt), use.names=FALSE)
} else {
plotsampcnt <- nfplotsampcnt
}
}
## Remove plots that have no remeasurement data
##############################################################################
if (popType %in% c("GRM", "CHNG", "LULC") && "REMPER" %in% names(pltx)) {
## Remove plots that have no remeasurement data
#pltx <- pltx[!is.na(pltx$REMPER), ]
}
##############################################################################
## Check estimation unit and strata
##############################################################################
## Check unitvar - if NULL, add unitvar=ONEUNIT to pltx
##############################################################################
if (is.null(unitvar)) {
unitvar <- checknm("ONEUNIT", names(pltx))
message("no unitvar specified... adding a variable named ", unitvar)
pltx[, (unitvar) := 1]
unitvars <- unitvar
#areavar <- NULL
pltassgnvars <- unique(c(unitvars, pltassgnvars))
}
##############################################################################
## CHECK unitarea BY ESTIMATION UNIT
## Returns: data table with unitvar and area by estimation unit (unitvar)
## and areavar (default="ACRES")
##############################################################################
vars2keep <- NULL
if (module == "SA" && "AOI" %in% names(unitarea)) {
vars2keep <- unique(c(pvars2keep, "AOI"))
}
removeunits <- ifelse(unit.action == "remove", TRUE, FALSE)
unitdat <- check.unitarea(unitarea=unitarea, pltx=pltx,
unitvars=c(unitvar, unitvar2), areavar=areavar, areaunits=areaunits,
removeunits=removeunits, removetext=removetext, gui=gui,
vars2keep=vars2keep)
unitarea <- unitdat$unitarea
areavar <- unitdat$areavar
areaunits <- unitdat$areaunits
if (!unitindb && !is.null(evalid)) {
ecol <- pcheck.varchar("EVALID", checklst=names(unitarea), stopifinvalid=FALSE)
if (!is.null(ecol)) {
unitarea <- unitarea[unitarea[[ecol]] %in% popevalid,]
if (nrow(unitarea) == 0) {
warning("evalid in unitarea does not match popevalid")
return(NULL)
}
}
}
##############################################################################
## Strata - Generate table of plots by strata,
## including nonsampled plots (P2POINTCNT)
##############################################################################
if (strata) {
stratalut <- pcheck.table(stratalut, tabnm="stratalut",
caption="stratalut table?", nullcheck=nullcheck, returnsf=FALSE)
if (!stratindb && !is.null(evalid)) {
ecol <- pcheck.varchar("EVALID", checklst=names(stratalut), stopifinvalid=FALSE)
if (!is.null(ecol)) {
stratalut <- stratalut[stratalut[[ecol]] %in% popevalid,]
if (nrow(stratalut) == 0) {
warning("evalid in stratalut does not match evalid")
return(NULL)
}
}
}
## Check unitlevels for collapsing
if (!is.null(unitlevels)) {
unitvals <- unique(stratalut[[unitvar]])
if (length(unitlevels) != length(unitvals)) {
misslevels <- unitvals[!unitvals %in% unitlevels]
message("unitlevels does not match unitvals... missing: ", toString(misslevels))
return(NULL)
} else if (any(is.na(match(unitlevels, unitvals)))) {
difflevels <- unitvals[is.na(match(unitlevels, unitvals))]
message("unitlevels does not match unitvals... missing: ", toString(difflevels))
return(NULL)
}
}
if (pivot) {
strwtvar <- "strwt"
unitvars <- unitvars[unitvars %in% names(stratalut)]
stratalut <- strat.pivot(stratalut, unitvars=unitvars,
strvar, strwtvar=strwtvar)
}
## Create table of number of plots by estimation unit and strata
P2POINTCNT <- pltx[, list(P2POINTCNT=uniqueN(get(puniqueid))), by=c(unitvars, strvar)]
setkeyv(P2POINTCNT, c(unitvars, strvar))
## If nonresp, get Response Homogeneity Groups for WestFest
############################################################################
if (nonresp) {
RHGdat <- getRHG(pltx=pltx, puniqueid=puniqueid,
unitvars=unitvars, strvar=strvar)
pltx <- RHGdat$pltx
RHGlut <- RHGdat$RHGlut
P2POINTCNT <- RHGdat$P2POINTCNT
nonresplut <- RHGdat$nonresplut
pltassgnvars <- unique(c(pltassgnvars, "RHG"))
} else {
## Create table of number of plots by estimation unit and strata
P2POINTCNT <- pltx[, list(P2POINTCNT=uniqueN(get(puniqueid))), by=c(unitvars, strvar)]
setkeyv(P2POINTCNT, c(unitvars, strvar))
}
} else {
strvar <- NULL
pltassgnvars <- unique(c(pltassgnvars, prednames))
}
##############################################################################
## Generate and apply nonsamp.pfilter
##############################################################################
if ((is.null(nonsamp.pfilter) || nonsamp.pfilter == "") && adj != "none") {
if ("PLOT_STATUS_CD" %in% names(pltx)) {
if (sum(pltx$PLOT_STATUS_CD == 3, na.rm=TRUE) > 0) {
message("removing ", sum(pltx$PLOT_STATUS_CD == 3), " nonsampled forest plots")
nonsamp.pfilter <- "PLOT_STATUS_CD != 3"
}
}
}
## Apply nonsamp.pfilter
if (!is.null(nonsamp.pfilter) && nonsamp.pfilter != "NONE") {
pltx <- datFilter(x=pltx, xfilter=nonsamp.pfilter,
title.filter="nonsamp.pfilter", gui=gui)$xf
if (is.null(pltx)) {
message(paste(nonsamp.pfilter, "removed all records"))
return(NULL)
}
}
##############################################################################
## Split tables
##############################################################################
## Subset columns for pltassgn table
pltassgnvars2 <- unique(c(puniqueid, pltassgnvars))[unique(c(puniqueid, pltassgnvars)) %in% names(pltx)]
pltassgnx <- data.table(pltx[, pltassgnvars2, with=FALSE])
if (puniqueid != pltassgnid) {
setnames(pltassgnx, puniqueid, pltassgnid)
}
setkeyv(pltassgnx, pltassgnid)
## Subset columns for pltassgn table
pvars2keep <- unique(c(puniqueid, pdoms2keep, pdoms, pvars2keep))
pvars2keep <- pvars2keep[pvars2keep %in% names(pltx)]
pltx <- data.table(pltx[, pvars2keep, with=FALSE])
setkeyv(pltx, puniqueid)
if (is.null(pvars)) {
pvars <- c(puniqueid, pdoms2keep, pvars2keep)
} else {
pvars <- c(pvars, pdoms2keep, pvars2keep)
}
returnlst <- list(pltassgnx=pltassgnx, pltassgnid=pltassgnid, pltx=pltx,
pfromqry=pfromqry, whereqry=whereqry, popwhereqry=popwhereqry,
puniqueid=puniqueid, pvars=pvars, pjoinid=pjoinid, popevalid=popevalid,
palias=palias, unitvar=unitvar, unitarea=unitarea, unitvar2=unitvar2,
areavar=areavar, areaunits=areaunits, unit.action=unit.action,
unitlevels=unitlevels, ACI=ACI, P2POINTCNT=as.data.frame(P2POINTCNT),
plotsampcnt=as.data.frame(plotsampcnt), pdoms2keep=pdoms2keep,
states=states, invyrs=lapply(invyrs,I), dbconn=dbconn)
if (module == "GB") {
returnlst$strata <- strata
if (strata) {
returnlst$stratcombine <- stratcombine
returnlst$stratalut <- stratalut
returnlst$strvar <- strvar
returnlst$nonresp <- nonresp
}
if (nonresp) {
returnlst$RHGlut <- RHGlut
returnlst$nonresplut <- nonresplut
}
}
if (module %in% c("MA", "SA")) {
returnlst$prednames <- prednames
returnlst$predfac <- predfac
}
if (ACI) {
returnlst$nfplotsampcnt <- nfplotsampcnt
}
return(returnlst)
}
Try the FIESTA package in your browser
Any scripts or data that you put into this service are public.
FIESTA documentation built on June 22, 2024, 7:37 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions check.popdataPLT
check.popdataPLT <- function(dsn,
tabs,
tabIDs,
pltassgn,
pltassgnid,
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,
prednames=NULL,
predfac=NULL,
pvars2keep=NULL,
pdoms2keep=NULL,
nullcheck=FALSE,
defaultVars=TRUE,
unitlevels=NULL,
gui=FALSE) {
##############################################################################
## DESCRIPTION: Checks plot data inputs
## - Set plt domains to add to cond (pdoms2keep) - STATECD, UNITCD, COUNTYCD,
## INVYR, MEASYEAR, PLOT_STATUS_CD, RDDISTCD, WATERCD, ELEV, ELEV_PUBLIC,
## ECOSUBCD, CONGCD, INTENSITY, DESIGNCD
## Check logical parameters: ACI, strata, stratcombine (if strata=TRUE)
## - If ACI, add NF_PLOT_STATUS_CD to pvars2keep and NF_COND_STATUS_CD to cvars2keep
## - If unit.action='combine', estimation units are combined if less than 10 plots
## - If strata, only 1 auxvar allowed, add to pvars2keep
## - If module = SA or MA-greg, add prednames to pvars2keep
## - If adj="samp", nonsample adjustment factors calculated at strata level
## - If adj="plot", nonsample adjustment factors calculated at plot level
## Check unit.action ('keep', 'remove', 'combine').
## Check predfac, if module = SA, MA-greg
## Import and check plt and pltassgn tables
## Check corresponding unique identifiers (puniqueid, pltassgnid)
## Merge plt, pltassgn tables to check necessary variables
## Check plot data
## - Check for missing pvars2keep variables
## - Check for missing pdoms2keep variables (STATE, INTENSITY, INVYR, DESIGNCD)
## - Get state(s) and inventory year(s) (for titles)
## - Generate table of sampled/nonsampled plots (if PLOT_STATUS_CD included)
## - If ACI, add table of sampled/nonsampled nonforest plots (if NF_PLOT_STATUS_CD included)
## - Generate table of plots by strata, including nonsampled plots (P2POINTCNT)
## - If nonresp, generate table of nonsampled plots by strata, substrvar
## - Generate and apply nonsamp.pfilter (PLOT_STATUS_CD != 3)
## - Check for NA values in pvars2keep variables
## - If unitvar = NULL, add unitvar=ONEUNIT
## Subset variables for pltx and pltassgnx
##############################################################################
## Set global variables
STATECD <- PLOT_STATUS_CD <- PSTATUSCD <- plotsampcnt <- nfplotsampcnt <-
INVYR <- NF_PLOT_STATUS_CD <- NF_COND_STATUS_CD <- TPA_UNADJ <- methodlst <-
nonresplut <- plotqry <- pfromqry <- pltassgnqry <- unitareaqry <-
stratalutqry <- whereqry <- palias <- P2POINTCNT <- plt <- dbconn_pltassgn <-
popwhereqry <- NULL
##############################################################################
## Define necessary plot variables
##############################################################################
datindb <- unitindb <- stratindb <- FALSE
dbconn <- pstratvars <- plotqry <- NULL
unitvars <- unique(c(unitvar, unitvar2))
pltassgnvars <- unique(c(pltassgnid, unitvars))
## Define plt variables
##############################################################################
pvars2keep <- unique(pvars2keep)
pdoms <- unique(c("STATECD", "UNITCD", "COUNTYCD", "INVYR", "PLOT_STATUS_CD",
"PLOT_NONSAMPLE_REASN_CD", "PSTATUSCD", "INTENSITY", "MEASYEAR",
"RDDISTCD", "WATERCD", "ELEV", "ELEV_PUBLIC", "ECOSUBCD", "CONGCD",
"DESIGNCD", "EMAP_HEX", pdoms2keep))
## Get tables from tabs
##############################################################################
for (tabnm in names(tabs)) {
assign(tabnm, tabs[[tabnm]])
}
puniqueid <- tabIDs[["plt"]]
##############################################################################
## Check parameters
##############################################################################
## Check adj
##############################################################################
adjlst <- c("samp", "plot", "none")
adj <- pcheck.varchar(var2check=adj, varnm="adj", gui=gui,
checklst=adjlst, caption="adj", multiple=FALSE, stopifnull=TRUE)
if (adj == "plot" && module == "GB") {
message("adj='plot' is not typical for GB modules")
}
if (adj != "none") {
pvars2keep <- c(pvars2keep, "MACRO_BREAKPOINT_DIA")
}
## Check ACI (if ACI=FALSE, need to filter COND_STATUS_CD == 1)
##############################################################################
ACI <- pcheck.logical(popFilter$ACI, varnm="ACI",
title="ACI?", first="NO", gui=gui)
if (ACI) {
pvars2keep <- c(pvars2keep, "NF_SAMPLING_STATUS_CD", "NF_PLOT_STATUS_CD")
}
## Check unit.action
########################################################
unit.actionlst <- c("keep", "remove", "combine")
unit.action <- pcheck.varchar(var2check=unit.action, varnm="unit.action",
gui=gui, checklst=unit.actionlst,
caption="unit.action",
multiple=FALSE, stopifnull=TRUE)
## Set additional pvars2keep
##############################################################################
if (popType %in% c("GRM", "CHNG", "LULC")) {
pvars2keep <- unique(c(pvars2keep, c("PREV_PLT_CN", "REMPER")))
} else if (popType == "P2VEG") {
pvars2keep <- c(pvars2keep, "P2VEG_SAMPLING_STATUS_CD",
"P2VEG_SAMPLING_LEVEL_DETAIL_CD","SAMP_METHOD_CD")
} else if (popType == "INV") {
pvars2keep <- c(pvars2keep, "INVASIVE_SAMPLING_STATUS_CD",
"INVASIVE_SPECIMEN_RULE_CD")
}
## Check strata, strvars
##############################################################################
strata <- pcheck.logical(strata, varnm="strata",
title="Post stratify?", first="YES", gui=gui, stopifnull=TRUE)
## Check strata parameters
##############################################################################
if (strata) {
## pivot
pivot <- pcheck.logical(pivot, varnm="pivot",
title="Pivot stratalut?", first="NO", gui=gui)
## Check nonresp
nonresp <- pcheck.logical(nonresp, varnm="nonresp",
title="Post stratify?", first="YES", gui=gui)
## Check stratcombine
stratcombine <- pcheck.logical(stratcombine, varnm="stratcombine",
title="Combine strata?", first="YES", gui=gui, stopifnull=TRUE)
## Check strvar
if (is.null(strvar)) stop("must include strvar for post-strat estimates")
if (length(strvar) > 1) stop("invalid strvar... only 1 variable allowed")
pltassgnvars <- unique(c(pltassgnvars, strvar))
if (nonresp) {
pstratvars <- unique(c(pstratvars, c("PLOT_STATUS_CD", "SAMP_METHOD_CD")))
}
} else {
strvar <- NULL
pltassgnvars <- unique(c(pltassgnvars, prednames))
}
## Check predfac
##############################################################################
if (!is.null(predfac)) {
if (!is.character(predfac)) {
stop("invalid predfac... must be character string")
}
notin <- predfac[!predfac %in% prednames]
if (length(notin) > 0) {
warning("invalid predfac... not in prednames: ", toString(notin))
predfac <- predfac[predfac %in% prednames]
if (length(predfac) == 0) predfac <- NULL
}
}
##############################################################################
## Database queries
##############################################################################
evalid <- popFilter$evalid
invyrs <- popFilter$invyrs
if (!is.null(dsn) && (getext(dsn) %in% c("sqlite", "db", "db3", "sqlite3", "gpkg"))) {
datindb <- TRUE
dbconn <- DBtestSQLite(dsn, dbconnopen=TRUE, showlist=FALSE)
tablst <- DBI::dbListTables(dbconn)
ppsanm <- pltassgnqry <- NULL
## Check name of plt
if (!is.null(plt)) {
if (plt == "plot" && "plt" %in% tablst) {
plt <- "plt"
} else if (plt == "plt" && "plot" %in% tablst) {
plt <- "plot"
}
pltflds <- DBI::dbListFields(dbconn, plt)
} else if (popType == "CHNG" && !is.null(pltu)) {
plt <- pltu
puniqueid <- "CN"
}
## Check name of pltassgn
if (!is.null(pltassgn)) {
if (!is.data.frame(pltassgn) && is.character(pltassgn)) {
dbconn_pltassgn <- dbconn
ppsanm <- chkdbtab(tablst, pltassgn, stopifnull=TRUE)
ppsaflds <- DBI::dbListFields(dbconn_pltassgn, ppsanm)
}
pltassgnid <- findnm(pltassgnid, ppsaflds, returnNULL = TRUE)
if (is.null(pltassgnid)) stop("pltassgnid is invalid")
}
if (!is.null(evalid)) {
## Filter for population data
evalidnm <- chkdbtab(ppsaflds, "EVALID", stopifnull=TRUE)
if (is.data.frame(pltassgn)) {
evalidvals <- sort(unique(pltassgn[[evalidnm]]))
} else {
evalidvals <-
DBI::dbGetQuery(dbconn_pltassgn,
paste("SELECT DISTINCT", evalidnm, "FROM", ppsanm))[[1]]
}
if (any(!evalid %in% evalidvals)) {
stop("evalids are missing: ", toString(evalid[!evalid %in% evalidvals]))
}
#whereqry <- paste0("\nWHERE ", evalidnm, " IN(", toString(evalid), ")")
whereqry <- paste0("\nWHERE ", evalidnm, " IN(", toString(popevalid), ")")
pltassgnqry <- paste0("SELECT * FROM ", ppsanm, whereqry)
if (is.null(plt)) {
palias <- "ppsa"
pfromqry <- paste(ppsanm, "ppsa")
pjoinid <- pltassgnid
} else {
palias <- "p"
pfromqry <- getpfromqry(evalid=evalid, popevalid, ppsanm=ppsanm,
ppsaid=pltassgnid, pjoinid=pjoinid,
plotnm=plt, dbconn=dbconn)
}
} else if (!is.null(popFilter$measCur) && popFilter$measCur) {
palias <- "p"
pfromqry <- getpfromqry(varCur="MEASYEAR", Endyr=popFilter$measEndyr,
dsn=dsn, plotnm=plt, dbconn=dbconn)
if (!is.null(ppsanm)) {
ppsaalias <- "ppsa"
pltassgnqry <- paste0("SELECT ", ppsaalias, ".* ",
"\nFROM ", pfromqry,
"\nJOIN ", ppsanm, " ", ppsaalias,
" ON(", palias, ".", puniqueid, " = ", ppsaalias, ".", pltassgnid, ")",
whereqry)
}
} else if (!is.null(invyrs)) {
if (is.null(plt)) {
invyrnm <- chkdbtab(ppsaflds, "INVYR", stopifnull=TRUE)
whereqry <- paste0("\nWHERE ", invyrnm, " IN(", toString(invyrs), ")")
pltassgnqry <- paste0("SELECT ", ppsaalias, ".* ",
"\nFROM ", ppsanm, whereqry)
} else {
palias <- "p"
pfromqry <- getpfromqry(invyrs=invyrs, plotCur=FALSE, dsn=dsn,
plotnm=plt, dbconn=dbconn)
if (!is.null(ppsanm)) {
ppsaalias <- "ppsa"
invyrnmplt <- findnm("INVYR", pltflds, returnNULL=TRUE)
invyrnmppsa <- findnm("INVYR", ppsaflds, returnNULL=TRUE)
if (is.null(invyrnmplt) && is.null(invyrnmppsa)) stop("INVYR variable not in tables")
if (!is.null(invyrnmplt) && !is.null(invyrnmppsa)) {
if (!is.null(invyrnmplt)) {
invyrnm <- paste0(palias, ".", invyrnmplt)
} else {
invyrnm <- paste0(ppsaalias, ".", invyrnmppsa)
}
} else {
invyrnm <- ifelse(!is.null(invyrnmplt), invyrnmplt, invyrnmppsa)
}
whereqry <- paste0("\nWHERE ", invyrnm, " IN(", toString(invyrs), ")")
pltassgnqry <- paste0("SELECT ", ppsaalias, ".* ",
"\nFROM ", pfromqry,
"\nJOIN ", ppsanm, " ", ppsaalias, " ON(",
palias, ".", puniqueid, " = ", ppsaalias, ".", pltassgnid,
")", whereqry)
}
}
} else {
whereqry <- NULL
if (is.null(plt)) {
palias <- "ppsa"
pfromqry <- paste(ppsanm, "ppsa")
pjoinid <- pltassgnid
} else {
palias <- "p"
pfromqry <- paste0(plt, " p INNER JOIN ", ppsanm,
" ON(p.", pjoinid, " = ", ppsanm, ".", pltassgnid, ")")
}
pltassgnqry <- paste("SELECT * FROM", ppsanm)
}
if (!is.null(pfromqry)) {
pvars <- paste0(palias, ".*")
ppvars <- paste0("pplot", ".*")
plotqry <- paste0("SELECT DISTINCT ", palias, ".* ",
"\nFROM ", pfromqry)
if (popType == "TEST") {
plot1qry <- paste0("SELECT DISTINCT ", pvars,
"\nFROM ", pfromqry,
"\nJOIN ", plt, " pplot ON (pplot", ".", puniqueid, " = ",
palias, ".PREV_PLT_CN) ", whereqry)
plot2qry <- paste0("SELECT DISTINCT ", ppvars,
"\nFROM ", pfromqry,
"\nJOIN ", plt, " pplot ON (pplot", ".", puniqueid, " = ",
palias, ".PREV_PLT_CN) ", whereqry)
plotqry <- paste(plot1qry, "\nUNION", plot2qry)
} else {
plotqry <- paste0("SELECT DISTINCT ", pvars,
"\nFROM ", pfromqry, whereqry)
}
#dbqueries$plot <- plotqry
}
if (is.character(unitarea) && !is.null(chkdbtab(tablst, unitarea))) {
unitindb <- TRUE
unitarea_layer <- chkdbtab(tablst, unitarea)
unitareaflds <- DBI::dbListFields(dbconn, unitarea_layer)
unitareaqry <- paste("SELECT * FROM", unitarea_layer)
evalidnm <- findnm("EVALID", unitareaflds, returnNULL = TRUE)
if (!is.null(evalid) && !is.null(evalidnm)) {
unitareaqry <- paste(unitareaqry, "WHERE", evalidnm, "IN(", toString(popevalid), ")")
}
unitarea <- pcheck.table(unitarea, conn=dbconn,
tabnm="unitarea", caption="unitarea?",
nullcheck=nullcheck, tabqry=unitareaqry,
returnsf=FALSE)
}
if (strata && is.character(stratalut) && !is.null(chkdbtab(tablst, stratalut))) {
stratindb <- TRUE
stratalut_layer <- chkdbtab(tablst, stratalut)
stratalutflds <- DBI::dbListFields(dbconn, stratalut_layer)
stratalutqry <- paste("SELECT * FROM", stratalut_layer)
evalidnm <- findnm("EVALID", unitareaflds, returnNULL = TRUE)
if (!is.null(evalid) && !is.null(evalidnm)) {
stratalutqry <- paste(stratalutqry, "WHERE", evalidnm, "IN(", toString(popevalid), ")")
}
stratalut <- pcheck.table(stratalut, conn=dbconn,
tabnm="stratalut", caption="stratalut?",
nullcheck=nullcheck, tabqry=stratalutqry, returnsf=FALSE)
}
} else {
if (all(sapply(tabs, is.character))) {
message("all popTabs are character... but dsn is missing")
return(NULL)
}
}
##############################################################################
## Import tables
##############################################################################
pltx <- pcheck.table(plt, conn=dbconn,
tabnm="plt", caption="plot table?",
nullcheck=nullcheck, tabqry=plotqry, returnsf=FALSE)
pltassgnx <- pcheck.table(pltassgn, conn=dbconn_pltassgn,
tabnm="pltassgn", caption="plot assignments?",
nullcheck=nullcheck, tabqry=pltassgnqry, returnsf=FALSE)
##############################################################################
## Check and merge plt, pltassgn, cond
##############################################################################
pvars <- NULL
if (!is.null(pltx) || !is.null(pltassgnx)) {
if (!is.null(pltx)) {
pltnmlst <- names(pltx)
puniqueid <- pcheck.varchar(var2check=puniqueid, varnm="puniqueid",
gui=gui, checklst=names(pltx),
caption="UniqueID variable of plot",
warn=paste(puniqueid, "not in plt table"),
stopifnull=TRUE)
if (any(duplicated(pltx[[puniqueid]]))) {
dups <- pltx[[puniqueid]][duplicated(pltx[[puniqueid]])]
warning(paste("plt records are not unique in: plt:", toString(dups)))
}
pvars <- c(pvars, puniqueid)
## Check for NA values in necessary variables in plt table
pltx.na <- sum(is.na(pltx[[puniqueid]]))
if (pltx.na > 0) {
if (length(pltx.na) == 1) {
message("1 NA value in ", puniqueid)
} else {
message(pltx.na, " NA values in ", puniqueid)
}
pltx <- pltx[!is.na(pltx[[puniqueid]]), ]
}
## Set key
setkeyv(pltx, puniqueid)
}
if (!is.null(pltassgnx)) {
if (!datindb && !is.null(evalid) && !is.null(chkdbtab(names(pltassgnx), "EVALID"))) {
evalidnm <- chkdbtab(names(pltassgnx), "EVALID")
popevalid <- unlist(popevalid)
if (!all(evalid %in% unique(pltassgnx[[evalidnm]]))) {
evalid.miss <- evalid[which(!evalid %in% unique(pltassgnx[["EVALID"]]))]
message("evalid not in dataset: ", paste(evalid.miss, collapse=", "))
if (length(evalid.miss) == length(evalid)) stop("None of the evalids exist in dataset")
evalid <- evalid[!evalid %in% evalid.miss]
}
pltassgnx <- datFilter(pltassgnx, getfilter("EVALID", popevalid, syntax="R"))$xf
if (nrow(pltassgnx) == 0) {
stop("evalid removed all records")
return(NULL)
}
}
if (any(duplicated(pltassgnx[[pltassgnid]]))) {
warning("plot records are not unique in: pltassgn")
}
## Check for NA values in necessary variables in plt table
pltassgnx.na <- sum(is.na(pltassgnx[[pltassgnid]]))
if (pltassgnx.na > 0) stop("NA values in ", pltassgnid)
## Set key
setkeyv(pltassgnx, pltassgnid)
}
## Merge plot and pltassgn tables
############################################################################
if (!is.null(pltx) && !is.null(pltassgnx)) {
pjoinid <- pcheck.varchar(var2check=pjoinid, varnm="pjoinid", gui=gui,
checklst=names(pltx), caption="Joinid variable in plot",
warn=paste(pjoinid, "not in plt table"))
if (is.null(pjoinid)) pjoinid <- puniqueid
setkeyv(pltx, pjoinid)
pltassgnx <- pltassgnx[, unique(c(pltassgnid, names(pltassgnx)[!names(pltassgnx) %in% names(pltx)])), with=FALSE]
setkeyv(pltassgnx, pltassgnid)
## Check if class of pjoinid in pltx matches class of pltassgnid in pltassgnx
tabchk <- check.matchclass(pltx, pltassgnx, pjoinid, pltassgnid)
pltx <- tabchk$tab1
pltassgnx <- tabchk$tab2
#if (pjoinid %in% names(pltassgnx)) {
# pltassgnid <- pjoinid
# setkeyv(pltassgnx, pjoinid)
#}
## Check for matching unique identifiers of pltx with pltassgnx
## Subset pltx to pltassgnx ids
pltx <- check.matchval(pltx, pltassgnx, pjoinid, pltassgnid, tab1txt="plt",
tab2txt="pltassgn", subsetrows=TRUE)
pltxvars <- names(pltx)[!names(pltx) %in% names(pltassgnx)]
## Merge pltx and pltassgnx (Note: inner join)
# pltx <- merge(pltassgnx,
# pltx[, unique(c(pjoinid, pltxvars)), with=FALSE],
# by.x=pltassgnid, by.y=pjoinid)
pltx <- merge(pltx[, unique(c(pjoinid, pltxvars)), with=FALSE],
pltassgnx,
by.x=pjoinid, by.y=pltassgnid)
#pltx <- merge(pltx, pltassgnx, by.x=pjoinid, by.y=pltassgnid)
} else if (is.null(pltx)) {
pltx <- pltassgnx
puniqueid <- pltassgnid
if (is.null(pjoinid)) pjoinid <- pltassgnid
}
}
## Check for duplicate plots
locvars <- c("STATECD", "UNITCD", "COUNTYCD", "PLOT")
if (all(locvars %in% names(pltx)) && any(pltx[, duplicated(.SD), .SDcols=locvars]) && (!popType %in% c("GRM", "CHNG"))) {
warning("duplicated plot locations exist... invalid for estimation")
return(NULL)
}
##############################################################################
## Check filter(s) for population data
##############################################################################
if (!datindb) {
if (!is.null(pltx) && (!is.null(popFilter$measCur) && popFilter$measCur || !is.null(popFilter$measEndyr))) {
pltx <- getPlotCur(pltx, Endyr=popFilter$measEndyr, varCur="MEASYEAR",
Endyr.filter=popFilter$measEndyr.filter)
} else if (!is.null(invyrs)) {
if (!"INVYR" %in% names(pltx)) stop("INVYR not in pltx")
if (!all(invyrs %in% unique(pltx[["INVYR"]]))) {
invyrs.miss <- invyrs[which(!invyrs %in% unique(pltx[["INVYR"]]))]
message("invyrs not in dataset: ", paste(invyrs.miss, collapse=", "))
if (length(invyrs.miss) == length(invyrs)) stop("None of the invyrs exist in dataset")
invyrs <- invyrs[!invyrs %in% invyrs.miss]
}
invyrs.filter <- getfilter(invyrsnm, invyrs)
pltx <- datFilter(pltx, invyrs.filter)$xf
}
}
## Subset popFilter - intensity
if (!is.null(popFilter$intensity)) {
intensity <- popFilter$intensity
intensitynm <- pcheck.varchar(var2check="INTENSITY",
checklst=names(pltx),
warn="INTENSITY variable not in plt")
intensitymiss <- intensity[!all(intensity %in% unique(pltx[[intensitynm]]))]
if (length(intensitymiss) > 0) {
warning("invalid intensity: ", toString(intensitymiss))
return(NULL)
}
intensity.filter <- getfilter(intensitynm, intensity)
pltx <- datFilter(pltx, intensity.filter)$xf
if (nrow(pltx) == 0) {
warning("intensity pop filter returned 0 records")
return(NULL)
}
}
## Subset popFilter - invyrs (if additional to evalid)
if (!is.null(evalid) && !is.null(invyrs)) {
invyrsnm <- pcheck.varchar(var2check="INVYR",
checklst=names(pltx),
warn="INVYR variable not in plt")
invyrsmiss <- invyrs[!all(invyrs %in% unique(pltx[[invyrsnm]]))]
if (length(invyrsmiss) > 0) {
warning("invalid invyrs: ", toString(invyrsmiss))
return(NULL)
}
invyrs.filter <- getfilter(invyrsnm, invyrs)
pltx <- datFilter(pltx, invyrs.filter)$xf
if (nrow(pltx) == 0) {
warning("invry pop filter returned 0 records")
return(NULL)
}
}
## Subset popFilter - AOIonly
if (!is.null(popFilter$AOIonly) && popFilter$AOIonly) {
AOInm <- pcheck.varchar(var2check="AOI",
checklst=names(pltx),
warn="AOI variable not in plt")
AOI.filter <- getfilter(AOInm, 1)
pltx <- datFilter(pltx, paste(AOInm, "== 1"))$xf
if (nrow(pltx) == 0) {
warning("AOI pop filter returned 0 records")
return(NULL)
}
}
##############################################################################
## Check for missing plot variables
##############################################################################
pltnmlst <- names(pltx)
pltvars <- unique(c(pltassgnvars, pstratvars, pvars2keep))
pvarsmiss <- pltvars[which(!pltvars %in% pltnmlst)]
# if (length(pvarsmiss) > 0) {
# stop("missing variables: ", paste(pvarsmiss, collapse=", "))
# }
pdoms2keep <- ifelse(defaultVars, pdoms, pltnmlst)
## Check missing pdoms2keep variables in pltx
##############################################################################
pmissvars <- pdoms2keep[which(!pdoms2keep %in% pltnmlst)]
if (length(pmissvars) > 0) {
if ("STATECD" %in% pmissvars)
message("STATECD not in dataset.. assuming 1 state in dataset")
if ("INTENSITY" %in% pmissvars)
message("INTENSITY not in dataset.. assuming single intensity plots")
if ("INVYR" %in% pmissvars)
message("INVYR not in dataset.. assuming inventory years do not span more than 1 cycle of measurements")
if (!"DESIGNCD" %in% pltnmlst) {
message("DESIGNCD not in dataset.. assuming DESIGNCD = 1 (annual inventory)")
designcd <- 1
} else {
# NOTE: If adj='samp', make sure dataset is annual inventory only (DESIGNCD=1).
# Only adjust plots when DESIGNCD=1. Cannot have more than 1 DESIGNCD.
designcd <- unique(na.omit(pltx[["DESIGNCD"]]))
if (length(designcd) > 1) {
if (any(!designcd %in% c(1, 501:505, 230:242, 311:323, 328))) {
if (adj == "samp") {
message("designcds include: ", toString(sort(designcd)))
message("samp adjustment for trees is only for annual inventory designs... see FIA database manual")
} else {
warning("more than 1 plot design, calculate separate estimates by design")
}
}
}
}
pmissvars <- pmissvars[which(!pmissvars %in% pltnmlst)]
if (any(prednames %in% pmissvars)) {
prednames[which(!prednames %in% pmissvars)]
warning("predname not in tables: ", paste(prednames, collapse=", "))
return(NULL)
}
if (any(unitvars %in% pmissvars)) {
unitvars[which(!unitvars %in% pmissvars)]
warning("unitvar not in tables: ", paste(unitvars, collapse=", "))
return(NULL)
}
}
#pdoms2keep <- unique(pdoms2keep[which(!pdoms2keep %in% pmissvars)])
## Check for duplicate plots
if (any(duplicated(pltassgnx[[pltassgnid]]))) {
message("duplicate plots exist... returning NULL... check popFilters")
return(NULL)
}
## Get state(s) and inventory year(s) (for titles)
##############################################################################
states <- NULL
invyrs <- NULL
if ("STATECD" %in% names(pltx)) {
stcds <- unique(pltx[["STATECD"]])
states <- pcheck.states(stcds)
if ("INVYR" %in% names(pltx)) {
invyrtab <- unique(pltx[, c("STATECD", "INVYR")])
setorderv(invyrtab, c("STATECD", "INVYR"))
invyrs <- as.list(by(invyrtab$INVYR, invyrtab$STATECD, I))
names(invyrs) <- pcheck.states(names(invyrs))
}
}
## Generate table of sampled/nonsampled plots
## (if ACI, nonforest status included)
##############################################################################
if (any(c("PLOT_STATUS_CD", "PSTATUSCD") %in% pltnmlst)) {
if ("PSTATUSCD" %in% names(pltx))
names(pltx)[names(pltx) == "PSTATUSCD"] <- "PLOT_STATUS_CD"
ref_plot_status_cd <- ref_codes[ref_codes$VARIABLE == "PLOT_STATUS_CD", ]
plotsampcnt <- pltx[, list(NBRPLOT=uniqueN(get(puniqueid))), by="PLOT_STATUS_CD"]
plotsampcnt <- cbind(PLOT_STATUS_NM=ref_plot_status_cd[match(plotsampcnt$PLOT_STATUS_CD, ref_plot_status_cd$VALUE), "MEANING"],
plotsampcnt)
setkey(plotsampcnt, PLOT_STATUS_CD)
} else {
if (nonresp) stop("PLOT_STATUS_CD must be in dataset if nonresp=TRUE")
message("PLOT_STATUS_CD not in dataset.. assuming all plots are at least partially sampled")
plotsampcnt <- pltx[, list(NBRPLOT=uniqueN(get(puniqueid)))]
}
if (ACI) {
if (any(c("NF_PLOT_STATUS_CD", "PSTATUSNF") %in% pltnmlst)) {
if ("PSTATUSNF" %in% names(pltx))
names(pltx)[names(pltx) == "PSTATUSNF"] <- "NF_PLOT_STATUS_CD"
ref_nf_plot_status_cd <- ref_codes[ref_codes$VARIABLE == "NF_PLOT_STATUS_CD", ]
nfplotsampcnt <- pltx[, list(NBRPLOT=uniqueN(get(puniqueid))), by=NF_PLOT_STATUS_CD]
nfplotsampcnt <- cbind(NF_PLOT_STATUS_NM=ref_nf_plot_status_cd[match(nfplotsampcnt$NF_PLOT_STATUS_CD, ref_nf_plot_status_cd$VALUE), "MEANING"],
nfplotsampcnt)
setkey(nfplotsampcnt, NF_PLOT_STATUS_CD)
nfplotsampcnt <- nfplotsampcnt[!is.na(NF_PLOT_STATUS_CD), ]
} else {
message("NF_PLOT_STATUS_CD not in dataset.. assuming all ACI nonforest plots are at least partially sampled")
}
if (!is.null(plotsampcnt)) {
plotsampcnt <- rbindlist(list(plotsampcnt, nfplotsampcnt), use.names=FALSE)
} else {
plotsampcnt <- nfplotsampcnt
}
}
## Remove plots that have no remeasurement data
##############################################################################
if (popType %in% c("GRM", "CHNG", "LULC") && "REMPER" %in% names(pltx)) {
## Remove plots that have no remeasurement data
#pltx <- pltx[!is.na(pltx$REMPER), ]
}
##############################################################################
## Check estimation unit and strata
##############################################################################
## Check unitvar - if NULL, add unitvar=ONEUNIT to pltx
##############################################################################
if (is.null(unitvar)) {
unitvar <- checknm("ONEUNIT", names(pltx))
message("no unitvar specified... adding a variable named ", unitvar)
pltx[, (unitvar) := 1]
unitvars <- unitvar
#areavar <- NULL
pltassgnvars <- unique(c(unitvars, pltassgnvars))
}
##############################################################################
## CHECK unitarea BY ESTIMATION UNIT
## Returns: data table with unitvar and area by estimation unit (unitvar)
## and areavar (default="ACRES")
##############################################################################
vars2keep <- NULL
if (module == "SA" && "AOI" %in% names(unitarea)) {
vars2keep <- unique(c(pvars2keep, "AOI"))
}
removeunits <- ifelse(unit.action == "remove", TRUE, FALSE)
unitdat <- check.unitarea(unitarea=unitarea, pltx=pltx,
unitvars=c(unitvar, unitvar2), areavar=areavar, areaunits=areaunits,
removeunits=removeunits, removetext=removetext, gui=gui,
vars2keep=vars2keep)
unitarea <- unitdat$unitarea
areavar <- unitdat$areavar
areaunits <- unitdat$areaunits
if (!unitindb && !is.null(evalid)) {
ecol <- pcheck.varchar("EVALID", checklst=names(unitarea), stopifinvalid=FALSE)
if (!is.null(ecol)) {
unitarea <- unitarea[unitarea[[ecol]] %in% popevalid,]
if (nrow(unitarea) == 0) {
warning("evalid in unitarea does not match popevalid")
return(NULL)
}
}
}
##############################################################################
## Strata - Generate table of plots by strata,
## including nonsampled plots (P2POINTCNT)
##############################################################################
if (strata) {
stratalut <- pcheck.table(stratalut, tabnm="stratalut",
caption="stratalut table?", nullcheck=nullcheck, returnsf=FALSE)
if (!stratindb && !is.null(evalid)) {
ecol <- pcheck.varchar("EVALID", checklst=names(stratalut), stopifinvalid=FALSE)
if (!is.null(ecol)) {
stratalut <- stratalut[stratalut[[ecol]] %in% popevalid,]
if (nrow(stratalut) == 0) {
warning("evalid in stratalut does not match evalid")
return(NULL)
}
}
}
## Check unitlevels for collapsing
if (!is.null(unitlevels)) {
unitvals <- unique(stratalut[[unitvar]])
if (length(unitlevels) != length(unitvals)) {
misslevels <- unitvals[!unitvals %in% unitlevels]
message("unitlevels does not match unitvals... missing: ", toString(misslevels))
return(NULL)
} else if (any(is.na(match(unitlevels, unitvals)))) {
difflevels <- unitvals[is.na(match(unitlevels, unitvals))]
message("unitlevels does not match unitvals... missing: ", toString(difflevels))
return(NULL)
}
}
if (pivot) {
strwtvar <- "strwt"
unitvars <- unitvars[unitvars %in% names(stratalut)]
stratalut <- strat.pivot(stratalut, unitvars=unitvars,
strvar, strwtvar=strwtvar)
}
## Create table of number of plots by estimation unit and strata
P2POINTCNT <- pltx[, list(P2POINTCNT=uniqueN(get(puniqueid))), by=c(unitvars, strvar)]
setkeyv(P2POINTCNT, c(unitvars, strvar))
## If nonresp, get Response Homogeneity Groups for WestFest
############################################################################
if (nonresp) {
RHGdat <- getRHG(pltx=pltx, puniqueid=puniqueid,
unitvars=unitvars, strvar=strvar)
pltx <- RHGdat$pltx
RHGlut <- RHGdat$RHGlut
P2POINTCNT <- RHGdat$P2POINTCNT
nonresplut <- RHGdat$nonresplut
pltassgnvars <- unique(c(pltassgnvars, "RHG"))
} else {
## Create table of number of plots by estimation unit and strata
P2POINTCNT <- pltx[, list(P2POINTCNT=uniqueN(get(puniqueid))), by=c(unitvars, strvar)]
setkeyv(P2POINTCNT, c(unitvars, strvar))
}
} else {
strvar <- NULL
pltassgnvars <- unique(c(pltassgnvars, prednames))
}
##############################################################################
## Generate and apply nonsamp.pfilter
##############################################################################
if ((is.null(nonsamp.pfilter) || nonsamp.pfilter == "") && adj != "none") {
if ("PLOT_STATUS_CD" %in% names(pltx)) {
if (sum(pltx$PLOT_STATUS_CD == 3, na.rm=TRUE) > 0) {
message("removing ", sum(pltx$PLOT_STATUS_CD == 3), " nonsampled forest plots")
nonsamp.pfilter <- "PLOT_STATUS_CD != 3"
}
}
}
## Apply nonsamp.pfilter
if (!is.null(nonsamp.pfilter) && nonsamp.pfilter != "NONE") {
pltx <- datFilter(x=pltx, xfilter=nonsamp.pfilter,
title.filter="nonsamp.pfilter", gui=gui)$xf
if (is.null(pltx)) {
message(paste(nonsamp.pfilter, "removed all records"))
return(NULL)
}
}
##############################################################################
## Split tables
##############################################################################
## Subset columns for pltassgn table
pltassgnvars2 <- unique(c(puniqueid, pltassgnvars))[unique(c(puniqueid, pltassgnvars)) %in% names(pltx)]
pltassgnx <- data.table(pltx[, pltassgnvars2, with=FALSE])
if (puniqueid != pltassgnid) {
setnames(pltassgnx, puniqueid, pltassgnid)
}
setkeyv(pltassgnx, pltassgnid)
## Subset columns for pltassgn table
pvars2keep <- unique(c(puniqueid, pdoms2keep, pdoms, pvars2keep))
pvars2keep <- pvars2keep[pvars2keep %in% names(pltx)]
pltx <- data.table(pltx[, pvars2keep, with=FALSE])
setkeyv(pltx, puniqueid)
if (is.null(pvars)) {
pvars <- c(puniqueid, pdoms2keep, pvars2keep)
} else {
pvars <- c(pvars, pdoms2keep, pvars2keep)
}
returnlst <- list(pltassgnx=pltassgnx, pltassgnid=pltassgnid, pltx=pltx,
pfromqry=pfromqry, whereqry=whereqry, popwhereqry=popwhereqry,
puniqueid=puniqueid, pvars=pvars, pjoinid=pjoinid, popevalid=popevalid,
palias=palias, unitvar=unitvar, unitarea=unitarea, unitvar2=unitvar2,
areavar=areavar, areaunits=areaunits, unit.action=unit.action,
unitlevels=unitlevels, ACI=ACI, P2POINTCNT=as.data.frame(P2POINTCNT),
plotsampcnt=as.data.frame(plotsampcnt), pdoms2keep=pdoms2keep,
states=states, invyrs=lapply(invyrs,I), dbconn=dbconn)
if (module == "GB") {
returnlst$strata <- strata
if (strata) {
returnlst$stratcombine <- stratcombine
returnlst$stratalut <- stratalut
returnlst$strvar <- strvar
returnlst$nonresp <- nonresp
}
if (nonresp) {
returnlst$RHGlut <- RHGlut
returnlst$nonresplut <- nonresplut
}
}
if (module %in% c("MA", "SA")) {
returnlst$prednames <- prednames
returnlst$predfac <- predfac
}
if (ACI) {
returnlst$nfplotsampcnt <- nfplotsampcnt
}
return(returnlst)
}
Try the FIESTA package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.