From 1b933867150f60f1055cdf5dfef0f18da8ca1c8b Mon Sep 17 00:00:00 2001 From: Tracey Date: Fri, 20 Dec 2024 10:07:26 -0700 Subject: [PATCH] update strata collapsing --- R/check.pltcnt.R | 1 - R/groupStrata.R | 43 +++++++++++++++++++++++++++++++++++++------ R/query_functions.R | 21 +++++++++++++-------- R/strat_collapse.R | 15 ++++++--------- man/internal_desc.Rd | 9 ++++++++- 5 files changed, 64 insertions(+), 25 deletions(-) diff --git a/R/check.pltcnt.R b/R/check.pltcnt.R index 745ded3..e539e8f 100644 --- a/R/check.pltcnt.R +++ b/R/check.pltcnt.R @@ -145,7 +145,6 @@ check.pltcnt <- function(pltx, puniqueid=NULL, unitlut, unitvars=NULL, } if (showwarnings && any(pltcnt$errtyp == "warn")) { - msg <- "## warnings/errors" message("\n################################### \n", msg, "\n###################################") diff --git a/R/groupStrata.R b/R/groupStrata.R index 1d2d6f3..29c5a05 100644 --- a/R/groupStrata.R +++ b/R/groupStrata.R @@ -44,7 +44,8 @@ groupEstunit <- function(x, minplotnum) { #' @rdname internal_desc #' @export -groupStrata <- function(x, minplotnum, nvar="n.strata") { +groupStrata <- function(x, minplotnum, nvar = "n.strata", + strvar = NULL, stratalevels = NULL) { ## DESCRIPTION: Groups strata with total plots <= minplotnum. ## Strata that have less than minplotnum are combined with the strata ## next in order (numeric or alphabetical). If there are no strata @@ -54,16 +55,34 @@ groupStrata <- function(x, minplotnum, nvar="n.strata") { ## set global variables strat=stratnew <- NULL - # print(x) # commented out by Grayson... don't think this should be here + #print(x) # commented out by Grayson... don't think this should be here + + ## make strata factor + getfactor <- FALSE + if (!is.null(strvar) && !is.factor(x[[strvar]])) { + getfactor <- TRUE + strvarclass <- class(x[[strvar]]) + if (!is.null(stratalevels)) { + x[[strvar]] <- factor(x[[strvar]], levels=stratalevels) + } else ( + x[[strvar]] <- factor(x[[strvar]]) + ) + } if (any(x[[nvar]] < minplotnum)) { strats <- x$strat agstrats <- {} + for (stratum in strats) { if (!stratum %in% agstrats) { - agstrats <- c(stratum) - if (x[strat %in% stratum][[nvar]] >= minplotnum) { - x[strat %in% stratum][["stratnew"]] <- stratum + agstrats <- stratum + if (!is.null(strvar) && strvar %in% names(x)) { + newnm <- x[strat %in% stratum, get(strvar)] + } else { + newnm <- stratum + } + if (x[x$strat %in% stratum][[nvar]] >= minplotnum) { + x[x$strat %in% stratum][["stratnew"]] <- newnm } else { maxag <- sum(x[strat %in% stratum][[nvar]]) while (maxag < minplotnum) { @@ -76,7 +95,11 @@ groupStrata <- function(x, minplotnum, nvar="n.strata") { stratag <- x[stratnew == as.character(stratnewcd)][["strat"]] agstrats <- c(stratag, agstrats) } - agstratsnm <- paste(agstrats, collapse="-") + if (!is.null(strvar)) { + agstratsnm <- paste(x[strat %in% agstrats, get(strvar)], collapse="-") + } else { + agstratsnm <- paste(agstrats, collapse="-") + } maxag <- sum(x[strat %in% agstrats][[nvar]]) x[strat %in% agstrats][["stratnew"]] <- agstratsnm } @@ -87,6 +110,14 @@ groupStrata <- function(x, minplotnum, nvar="n.strata") { } else { x$stratnew <- as.character(x$strat) } + + if (getfactor) { + if (strvarclass == "integer") { + x[[strvar]] <- as.integer(as.character(x[[strvar]])) + } else if (strvarclass == "character") { + x[[strvar]] <- as.character(x[[strvar]]) + } + } return(x) } diff --git a/R/query_functions.R b/R/query_functions.R index 4ce6930..09a4823 100644 --- a/R/query_functions.R +++ b/R/query_functions.R @@ -156,32 +156,37 @@ getcombineqry <- function(lut, tab. = "") { ## DESCRIPTION: create classification query for combining strata classify.qry <- {} - for (to in 1:length(classcols)) { - tocol <- classcols[to] - + for (col in 1:length(classcols)) { + tocol <- classcols[col] + fromcol <- fromcols[col] + case.qry <- "\n(CASE" for (i in 1:(nrow(lut))) { luti <- lut[i,] + tocolsi <- as.vector(t(luti[, tocols])) fromcolsi <- as.vector(t(luti[, fromcols])) - tocolsi <- as.vector(t(luti[, classcols])) - + + ## value to change + tocolval <- luti[[tocol]] + fromcolval <- luti[[fromcol]] + ## Build when query when.qry <- paste0("\nWHEN (", tab., fromcols[1], " = '", fromcolsi[1], "'") for (j in 2:length(fromcols)) { when.qry <- paste0(when.qry, " AND ", tab., fromcols[j], " = '", fromcolsi[j], "'") } when.qry <- paste0(when.qry, ")") - case.qry <- paste0(case.qry, when.qry, " THEN ", tocolsi) + case.qry <- paste0(case.qry, when.qry, " THEN ", tocolval) } case.qry <- paste0(case.qry, " END) AS \"", tocol, "\"") classify.qry <- paste0(classify.qry, case.qry) - if (to < length(classcols)) { + if (col < length(classcols)) { classify.qry <- paste0(classify.qry, ",") } } - return(classify.qry) + return(classify.qry) } diff --git a/R/strat_collapse.R b/R/strat_collapse.R index 322e38b..0cb97d0 100644 --- a/R/strat_collapse.R +++ b/R/strat_collapse.R @@ -2,7 +2,8 @@ #' @export strat.collapse <- function(stratacnt, pltstratx, minplotnum.unit=10, minplotnum.strat=2, unitarea, areavar, unitvar, unitvar2=NULL, strvar, - getwt=FALSE, stratcombine=TRUE, unitcombine=FALSE, vars2combine=NULL, ...) { + getwt=FALSE, stratcombine=TRUE, unitcombine=FALSE, stratalevels=NULL, + vars2combine=NULL, ...) { ## unitcombine - If TRUE, combine estimation units, If FALSE, only combine strata ## Set global variables @@ -159,13 +160,9 @@ strat.collapse <- function(stratacnt, pltstratx, minplotnum.unit=10, ############################################################################# ## If stratcombine=TRUE and number of total plots is less than minplotnum.strat ############################################################################# - if ("n.strata" %in% names(unitgrpsum) && - any(unique(unitgrpsum$n.strata) < minplotnum.strat)) { - #if ("n.strata" %in% names(unitgrpsum) && - # any(unique(unitgrpsum$n.strata) < 60)) { - + if ("n.strata" %in% names(unitgrpsum) && any(unique(unitgrpsum$n.strata) < minplotnum.strat)) { + tabprint <- TRUE - unitgrpsum$strat <- unitgrpsum[[strvar]] if (!is.factor(unitgrpsum$strat)) { unitgrpsum$strat <- factor(unitgrpsum$strat) @@ -173,8 +170,8 @@ strat.collapse <- function(stratacnt, pltstratx, minplotnum.unit=10, unitgrpsum$strat <- as.numeric(unitgrpsum$strat) unitgrpsum$stratnew <- as.character(-1) - stratgrp <- unitgrpsum[, groupStrata(.SD, minplotnum.strat), by=unitvar] - + stratgrp <- unitgrpsum[, groupStrata(.SD, minplotnum=minplotnum.strat, strvar=strvar, + stratalevels=stratalevels), by=unitvar] strlut <- stratgrp[, lapply(.SD, sum, na.rm=TRUE), by=c(unitvar, "stratnew"), .SDcols=c(vars2combine, "n.strata")] strlut[, n.total := stratgrp[match(strlut[[unitvar]], stratgrp[[unitvar]]), diff --git a/man/internal_desc.Rd b/man/internal_desc.Rd index 130468f..e8336de 100644 --- a/man/internal_desc.Rd +++ b/man/internal_desc.Rd @@ -588,7 +588,13 @@ getrhat(x) groupEstunit(x, minplotnum) -groupStrata(x, minplotnum, nvar = "n.strata") +groupStrata( + x, + minplotnum, + nvar = "n.strata", + strvar = NULL, + stratalevels = NULL +) groupUnits( tabest, @@ -680,6 +686,7 @@ strat.collapse( getwt = FALSE, stratcombine = TRUE, unitcombine = FALSE, + stratalevels = NULL, vars2combine = NULL, ... )