R/est.outtabs.R

Defines functions est.outtabs

est.outtabs <- function(esttype, phototype="PCT", photoratio=FALSE, sumunits=FALSE,
	areavar, unitvar, unitvars=NULL, unit_totest, unit_rowest=NULL, unit_colest=NULL,
	unit_grpest=NULL, rowvar=NULL, colvar=NULL, uniquerow=NULL, uniquecol=NULL,
	rowgrp=FALSE, rowgrpnm=NULL, rowunit=NULL, totunit=NULL, allin1=FALSE,
	savedata=FALSE, addtitle=FALSE, returntitle=FALSE, title.ref=NULL,
	title.colvar=NULL, title.rowvar=NULL, title.rowgrp=NULL, title.unitvar=NULL,
	title.estpse=NULL, title.est=NULL, title.pse=NULL, outfn.estpse=NULL,
	outfolder=NULL, outfn.date=TRUE, overwrite=FALSE, estnm, psenm="pse",
	estround=0, pseround=2, estnull="--", psenull="--", divideby=NULL,
	coltitlerow=TRUE, rowtotal=TRUE, rawdata=FALSE, CI=TRUE, rawdat=NULL,
	char.width=NULL, rawonly=FALSE, raw.keep0=FALSE){

  ## Set global variables
  estn=pse=keepvars=TOTAL=totest=rowest=colest=grpest <- NULL
  rowvar <- ifelse(is.null(rowvar), "NONE", rowvar)
  colvar <- ifelse(is.null(colvar), "NONE", colvar)
  
  
  #####  TITLE INFO FOR TABLE COLUMNS
  ########################################################
  if (allin1) {
    title.yhatpse <- "Estimate (% Sampling Error)"
  } else {
    title.yhat <- "Estimate"
    title.yhat.pse <- "Percent Sampling Error"
  }
  
  ## Check if a total table exists
  if (!is.null(unit_totest)) gtotal <- TRUE
  
  if (!is.null(title.ref) && title.ref != "") {
    title.ref <- paste(";", title.ref)
  }
  
  ## Define est.var name
  estnm.var <- paste0(estnm, ".var")
  senm <- paste0(estnm, ".se")
  estnm2 <- ifelse(esttype == "RATIO", "rhat", estnm)
  senm2 <- paste0(estnm2, ".se")
  
  
  ## Get conversion number
  dividebynum <- NULL
  
  if (!is.null(divideby)) {
    dividebynum <- ifelse(divideby == "hundred", 100,
                          ifelse(divideby == "thousand", 1000,
                                 ifelse(divideby == "million", 1000000, 1)))
    estnmd <- paste(estnm, divideby, sep=".")
    senmd <- paste(senm, divideby, sep=".")
  } else {
    estnmd <- estnm
    senmd <- senm
  }
  estnmd <- ifelse(esttype == "RATIO", "rhat", estnmd)
  senmd <- ifelse(esttype == "RATIO", "rhat.se", senmd)
  
  rnames <- rowvar
  title.rnames <- title.rowvar
  totals <- "Total"
  if (!is.null(rowgrpnm)) {
    rnames <- c(rowgrpnm, rowvar)
    title.rnames <- c(title.rowgrp, title.rnames)
    totals <- c(totals, "Total")
  }
  rnbr <- length(rnames)
  
  ## Set up lists
  returnlst <- list()
  titlelst <- list()
  
  ## sumunits = FALSE
  if (!is.null(unit_totest)) {
    if (esttype == "RATIO") {
      unit_totest <- suppressWarnings(getrhat(unit_totest))
    } else {
      if (!is.null(dividebynum)) {
        unit_totest[[estnmd]] <- unit_totest[[estnm2]] / dividebynum
        unit_totest[[senmd]] <- unit_totest[[senm2]] / dividebynum
      } else {
        unit_totest[[estnmd]] <- unit_totest[[estnm2]]
      }
      unit_totest[[psenm]] <- unit_totest[[psenm]]
    }
    if (allin1) {
      char.width <- suppressWarnings(max(nchar(na.omit(round(unit_totest[[psenm]], pseround)))))
      if (!is.null(char.width) && char.width == -Inf) char.width <- 0
    }
  }
  
  if (!is.null(unit_rowest)) {
    if (esttype == "RATIO") {
      unit_rowest <- suppressWarnings(getrhat(unit_rowest))
    } else {
      if (!is.null(dividebynum)) {
        unit_rowest[[estnmd]] <- unit_rowest[[estnm2]] / dividebynum
        unit_rowest[[senmd]] <- unit_rowest[[senm2]] / dividebynum
      } else {
        unit_rowest[[estnmd]] <- unit_rowest[[estnm2]]
      }
      unit_rowest[[psenm]] <- unit_rowest[[psenm]]
    }
    if (allin1) {
      char.width <- max(char.width,
                        max(nchar(na.omit(round(unit_rowest[[psenm]], pseround)))))
    }
  }
  
  if (!is.null(unit_colest)) {
    if (esttype == "RATIO") {
      unit_colest <- suppressWarnings(getrhat(unit_colest))
    } else {
      if (!is.null(dividebynum)) {
        unit_colest[[estnmd]] <- unit_colest[[estnm2]] / dividebynum
        unit_colest[[senmd]] <- unit_colest[[senm2]] / dividebynum
      } else {
        unit_colest[[estnmd]] <- unit_colest[[estnm2]]
      }
      unit_colest[[psenm]] <- unit_colest[[psenm]]
    }
    if (allin1) {
      char.width <- max(char.width,
                        max(nchar(na.omit(round(unit_colest[[psenm]], pseround)))))
    }
  }
  
  if (!is.null(unit_grpest)) {
    if (esttype == "RATIO") {
      unit_grpest <- suppressWarnings(getrhat(unit_grpest))
    } else {
      if (!is.null(dividebynum)) {
        unit_grpest[[estnmd]] <- unit_grpest[[estnm2]] / dividebynum
        unit_grpest[[senmd]] <- unit_grpest[[senm2]] / dividebynum
      } else {
        unit_grpest[[estnmd]] <- unit_grpest[[estnm2]]
      }
      unit_grpest[[psenm]] <- unit_grpest[[psenm]]
    }
    if (allin1) {
      char.width <- max(char.width,
                        max(nchar(na.omit(round(unit_grpest[[psenm]], pseround)))))
    }
  }
  
  if (sumunits) {
    ## Group estimates
    #if (!is.null(uniquerow))
    #  keepvars.row <- names(uniquerow)[names(uniquerow) != rowvar]
    #if (!is.null(uniquecol))
    #  keepvars.col <- names(uniquecol)[names(uniquecol) != colvar]
	  keepvars.row=keepvars.col <- NULL

    ## GROUP TOTAL TABLE
    if (!is.null(unit_totest)) {
      totest <- 
        groupUnits(unit_totest, 
                   estncol = estnm, estncol.var = estnm.var,
		               domain = "TOTAL", esttype = esttype, 
		               rowgrpnm = rowgrpnm, 
		               unitvar = unitvar, areavar = areavar,
		               phototype = phototype, photoratio = photoratio)
      if (esttype != "RATIO" && !is.null(dividebynum)) {
        totest[[estnmd]] <- totest[[estnm2]] / dividebynum
        totest[[senmd]] <- totest[[senm2]] / dividebynum
      } else {
        totest[[estnmd]] <- totest[[estnm2]]
      }
      totest[[psenm]] <- totest[[psenm]]
      if (allin1) {
        char.width <- max(nchar(na.omit(round(totest[[psenm]], pseround))))
        if (!is.null(char.width) && char.width == -Inf) char.width <- 0
      }
    }
    if (!is.null(unit_rowest)) {
      rowest <- 
        groupUnits(tabest = unit_rowest, domain = rowvar, 
                   estncol = estnm, estncol.var = estnm.var, 
                   esttype = esttype, rowgrpnm = rowgrpnm,
			             unitvar = unitvar,  
			             phototype = phototype, photoratio = photoratio, 
			             keepvars = keepvars.row)
      if (esttype != "RATIO" && !is.null(dividebynum)) {
        rowest[[estnmd]] <- rowest[[estnm2]] / dividebynum
        rowest[[senmd]] <- rowest[[senm2]] / dividebynum
        unit_rowest[[estnmd]] <- unit_rowest[[estnm2]] / dividebynum
        unit_rowest[[senmd]] <- unit_rowest[[senm2]] / dividebynum
      } else {
        rowest[[estnmd]] <- rowest[[estnm2]]
      }
      rowest[[psenm]] <- rowest[[psenm]]
      if (allin1) {
        char.width <- max(char.width,
		        max(nchar(na.omit(round(rowest[[psenm]], pseround)))))
      }
    }
	  if (!is.null(unit_colest)) {
      colest <- 
        groupUnits(tabest = unit_colest, domain = colvar, 
                   estncol = estnm, estncol.var = estnm.var, 
                   esttype = esttype, 
                   unitvar = unitvar,  
                   phototype = phototype, photoratio = photoratio,
			             keepvars = keepvars.col)
      if (esttype != "RATIO" && !is.null(dividebynum)) {
        colest[[estnmd]] <- colest[[estnm2]] / dividebynum
        colest[[senmd]] <- colest[[senm2]] / dividebynum
        unit_colest[[estnmd]] <- unit_colest[[estnm2]] / dividebynum
        unit_colest[[senmd]] <- unit_colest[[senm2]] / dividebynum
      } else {
        colest[[estnmd]] <- colest[[estnm2]]
      }
      colest[[psenm]] <- colest[[psenm]]
      if (allin1) {
        char.width <- max(char.width,
		       max(nchar(na.omit(round(colest[[psenm]], pseround)))))
      }
	  	
      if (!is.null(unit_grpest)) {
        grpest <- 
          groupUnits(tabest = unit_grpest, domain = rowvar, 
                   estncol = estnm, estncol.var = estnm.var, 
                   domvar2 = colvar, esttype = esttype,
			             rowgrpnm = rowgrpnm, 
			             unitvar = unitvar, 
			             phototype = phototype, photoratio = photoratio,
			             keepvars = c(keepvars.row, keepvars.col))
        if (esttype != "RATIO" && !is.null(dividebynum)) {
          grpest[[estnmd]] <- grpest[[estnm2]] / dividebynum
           grpest[[senmd]] <- grpest[[senm2]] / dividebynum
          unit_grpest[[estnmd]] <- unit_grpest[[estnm2]] / dividebynum
          unit_grpest[[senmd]] <- unit_grpest[[senm2]] / dividebynum
        } else {
          grpest[[estnmd]] <- grpest[[estnm2]]
        }
        grpest[[psenm]] <- grpest[[psenm]]
        if (allin1) {
          char.width <- max(char.width,
		         max(nchar(na.omit(round(grpest[[psenm]], pseround)))))
        }
      }
    }
  }

  if (!rawonly) {
  ###################################################################
  ## GENERATE OUTPUT TABLES
  ###################################################################
  if (is.null(colvar) || colvar == "NONE") {
    if (sumunits) {
      if (rowvar == "TOTAL") {
        if (allin1) {
          estpse <- 
            data.frame(TOTAL = "Total", 
                       allin1f(round(totest[[estnmd]], estround),
			                 round(totest[[psenm]], pseround), 
			                 estnull = estnull, psenull = psenull,
			                 char.width = char.width), 
			                 stringsAsFactors = FALSE)
          setnames(estpse, c("TOTAL", title.yhatpse))
        } else {
          estpse <- 
            data.table(TOTAL = "Total",
			                 totest[, c(estnmd, psenm), with=FALSE], stringsAsFactors=FALSE)
                       estpse[[estnmd]] <- round(estpse[[estnmd]], estround)
                       estpse[[psenm]] <- round(estpse[[psenm]], pseround)
          names(estpse) <- c("TOTAL", title.yhat, title.yhat.pse)
        }
        rowtotal <- FALSE

      } else {  ##  rowvar != "TOTAL"
        
        ## Get estimates
        estcross <- 
          crosstabx(rowest, rowvar, estnmd, psenm, allin1=allin1,
		                estnull = estnull, psenull = psenull, 
		                char.width = char.width,
		                estround = estround, pseround = pseround)
        if (allin1) {
          tottab <- 
            data.frame(TOTAL = "Total", allin1f(totest[[estnmd]],
			                 totest[[psenm]], char.width=char.width, estnull=estnull,
			                 psenull=psenull, estround=estround, pseround=pseround), 
			                 stringsAsFactors=FALSE)
          setnames(tottab, c("TOTAL", title.yhatpse))

          estpse <- estcross
          estpse <- data.frame(names(estcross), estcross,
					stringsAsFactors=FALSE, row.names=NULL)
          if (rowgrp)
            estpse <- addrowgrp(estpse, uniquerow, rowvar, rowgrpnm)
          names(estpse) <- c(title.rnames, title.yhatpse)

          if (!is.null(totest)) {
            for (rname in title.rnames)
              estpse[[rname]] <- as.character(estpse[[rname]])
            estpse <- rbind(estpse, c(totals, tottab[, title.yhatpse]))
          }

        } else {
          est <- estcross$est
          pse <- estcross$pse

          estpse <- data.frame(names(est), est, pse, stringsAsFactors=FALSE, row.names=NULL)
          names(estpse) <- c(rowvar, title.yhat, title.yhat.pse)

          if (rowgrp)
            estpse <- addrowgrp(estpse, uniquerow, rowvar, rowgrpnm)
          names(estpse) <- c(title.rnames, title.yhat, title.yhat.pse)

          if (!is.null(totest)) {
            for (rname in title.rnames)
              estpse[[rname]] <- as.character(estpse[[rname]])

            tottab <- c(totals, round(totest[[estnmd]], estround), round(totest[[psenm]], pseround))
            names(tottab) <- c(totals, title.yhat, title.yhat.pse)
            estpse <- rbind(estpse, tottab)
          }
        }
      }

      ## TABLES TO RETURN
      est2return <- estpse
      pse2return <- NULL

      ## SAVE TO FILE
      if ((savedata & addtitle) | returntitle)
        title.estpse <- paste0(title.estpse, title.ref)

      if (savedata) {
        suppressWarnings(
        save1tab(tab=setDF(estpse), tab.title=title.estpse, outfn=outfn.estpse,
			           outfolder=outfolder, allin1=allin1, coltitlerow=FALSE,
			           addtitle=addtitle, rowtotal=rowtotal, outfn.date=outfn.date,
			           overwrite=overwrite, charvars=title.rnames, cols2format=title.yhat) )
      }

    } else {  ## colvar == NONE, sumunits = FALSE

      ## GET INITIAL TABLE AND TOTALS
      estnmd <- ifelse(esttype == "RATIO", "rhat", estnmd)
      senmd <- ifelse(esttype == "RATIO", "rhat.se", senmd)

      ## GET TOTAL TABLE
      if (!is.null(unit_totest)) {
        if (allin1) {
          ## Get table with estimates by unitvar
          estpsetot <- data.table(unit_totest[[unitvar]],
			            crosstabx(x = unit_totest, 
			                      xvar = "TOTAL",
			                      estnm = estnmd, psenm = psenm, allin1 = TRUE, 
			                      estnull = estnull, psenull = psenull, 
				                    char.width = char.width,
				                    estround = estround, pseround = pseround))
          setnames(estpsetot, c(title.unitvar, title.yhatpse))
        } else {
          ## GET TABLE OF ESTIMATES WITH TITLES
          estpsetot <- data.table(unit_totest[,c(unitvar, estnmd, psenm), with=FALSE])
          estpsetot[[estnmd]] <- round(estpsetot[[estnmd]], estround)
          estpsetot[[psenm]] <- round(estpsetot[[psenm]], pseround)
          setnames(estpsetot, c(title.unitvar, title.yhat, title.yhat.pse))
        }
      }

      if (!is.null(totunit)) {
        if (esttype == "RATIO") {
          totunit <- suppressWarnings(getrhat(totunit))
        } else {
          if (!is.null(divideby)) {
            totunit[, (estnmd) := round(get(estnm2) / dividebynum, estround)]
            totunit[, (senmd) := get(senm2) / dividebynum]
          }
          totunit[, (estnmd) := round(get(estnmd), estround)]
          totunit[, (psenm) := round(get(psenm), pseround)]
        }
      }

      if (rowvar == "TOTAL") {
        if (!is.null(totunit)) {
          totunit <- setDF(totunit)
          if (allin1) {
            totunit <- data.frame(TOTAL = "Total", 
                                  allin1f(totunit[[estnmd]], 
                                          totunit[[psenm]],
			                            estnull = estnull, psenull = psenull, 
			                            char.width = char.width, 
			                            estround = estround,
			                            pseround = pseround), stringsAsFactors = FALSE)
            setnames(totunit, c(unitvar, title.yhatpse))
          } else {
            totunit <- c("TOTAL", totunit[, c(estnmd, psenm)])
            names(totunit) <- c(unitvar, title.yhat, title.yhat.pse)
          }
          if (!is.null(estpsetot))
            estpsetot <- data.frame(rbind(setDF(estpsetot), totunit))
        }

        ## TABLES TO RETURN
        est2return <- estpsetot
        pse2return <- NULL

        if ((savedata & addtitle) | returntitle)
          title.estpse <- paste0(title.estpse, title.ref)

        if (savedata)
          suppressWarnings(
          save1tab(tab=est2return, tab.title=title.estpse,
			             outfn=outfn.estpse, outfolder=outfolder, allin1=allin1,
			             coltitlerow=FALSE, rowtotal=FALSE, addtitle=addtitle,
			             outfn.date=outfn.date, overwrite=overwrite, cols2format=title.yhat))

      } else {  ## rowvar != "TOTAL"

        if (!is.null(rowunit)) {
          if (esttype == "RATIO") {
            rowunit <- suppressWarnings(getrhat(rowunit))
          } else {
            if (!is.null(divideby)) {
              rowunit[, (estnmd) := get(estnm2) / dividebynum]
              rowunit[, (senmd) := get(senm2) / dividebynum]
            }
            rowunit[, (estnmd) := round(get(estnmd), estround)]
            rowunit[, (psenm) := round(get(psenm), pseround)]
          }
        }
        if (!is.null(unit_totest) && !is.null(uniquecol)) {
          unit_totest <- add0unit(x=unit_totest, xvar=unitvar, uniquex=uniquecol,
			                            xvar.add0=TRUE)
        }

        ## Get table of estimates
        estpsecross <- crossxtab(group.est = unit_rowest, 
                                 rowvar.est = rowunit, colvar.est = unit_totest, 
                                 total.est = totunit, 
			                           rowvar = rowvar, colvar = unitvar, 
			                           estnm = estnmd, psenm = psenm, allin1 = allin1,
			                           rowgrp = rowgrp, rowgrpnm = rowgrpnm, 
			                           title.rnames = title.rnames,
			                           estround = estround, pseround = pseround, 
			                           estnull = estnull, psenull = psenull, 
			                           char.width = char.width)

        if (esttype != "RATIO") {
          if (!is.null(unit_totest)) {
            ## GET TOTAL ESTIMATE TO COMPARE TO SUM OF ATTRIBUTE ESTIMATES
            totest <- sum(unit_totest[[estnm2]], na.rm=TRUE)

            ## GET SUM OF ESTIMATES TO COMPARE TO TOTAL
            sumest <- sum(unit_rowest[[estnm]], na.rm=TRUE)
            if (!(sumest < (totest + 100) & sumest > (totest - 100)))
              warning("the total estimate does not match sum of attributes.. difference of ",
			                 abs(sumest-totest))
          }
        }

        if (unitvar == "ONEUNIT" || length(unique(unit_rowest[[unitvar]])) == 1) {

          if (allin1) {
            estpsetab <- estpsecross
            names(estpsetab) <- c(title.rnames, title.yhatpse)
          } else {
            esttab <- estpsecross$est
            names(esttab) <- c(title.rnames, title.yhat)
            psetab <- estpsecross$pse
            names(psetab) <- c(title.rnames, title.yhat.pse)

            estpsetab <- data.table(esttab, psetab[[title.yhat.pse]])
            if (is.numeric(estnull)) estpsetab[[title.yhat]] <-
				                    as.numeric(estpsetab[[title.yhat]])
            if (is.numeric(psenull)) estpsetab[[title.yhat.pse]] <-
				                    as.numeric(estpsetab[[title.yhat.pse]])
            names(estpsetab) <- c(title.rnames, title.yhat, title.yhat.pse)
          }

          est2return <- setDF(estpsetab)
          pse2return <- NULL

          if ((savedata & addtitle) | returntitle)
            title.estpse <- paste0(title.estpse, title.ref)

            if (savedata)
              ## SAVE TO FILE
              suppressWarnings(
              save1tab(tab=estpsetab, tab.title=title.estpse,
			                 outfn=outfn.estpse, outfolder=outfolder, allin1=allin1,
			                 coltitlerow=FALSE, rowtotal=TRUE, addtitle=addtitle,
			                 outfn.date=outfn.date, overwrite=overwrite,
			                 charvars=title.rnames, cols2format=title.yhat))
        } else {  # > 1 unit

          if (allin1) {
            est2return <- estpsecross
            #names(est2return) <- c(title.rnames, title.yhatpse)
            pse2return <- NULL

            if (savedata)
              ## SAVE TO FILE
              suppressWarnings(
              save1tab(tab=estpsecross, tab.title=title.estpse,
 				               outfn=outfn.estpse, outfolder=outfolder, allin1=TRUE,
				               coltitlerow=FALSE, coltitle=title.unitvar, rowtotal=TRUE,
				               addtitle=addtitle, outfn.date=outfn.date, overwrite=overwrite,
				               charvars=title.rnames))
          } else {
            est2return <- estpsecross$est
            pse2return <- estpsecross$pse

            if ((savedata & addtitle) | returntitle) {
              title.est <- paste0(title.est, title.ref)
              title.pse <- paste0(title.pse, title.ref)
            }

            if (savedata)
            ## SAVE TO FILE
             suppressWarnings(
              save2tabs(tab1=est2return, tab2=pse2return,
				                tab1.title=title.est, tab2.title=title.pse, outfn.estpse=outfn.estpse,
 				                outfolder=outfolder, coltitlerow=TRUE, coltitle=title.unitvar,
				                addtitle=addtitle, rowtotal=rowtotal, rnames=rnames,
				                outfn.date=outfn.date, overwrite=overwrite))
          }
        }
      }
    }

  ### BY ROW AND COLUMN
  #######################################
  } else {    ## colvar != "NONE"

    ## Get cross tables
    ###############################################
    if (sumunits) {
#      estunits <- unique(unit_grpest[[unitvar]])
#      numunits <- length(estunits)
      numunits <- 1
      tabs <- 
        crossxbyunit(unit = NULL, unit_grpest = grpest,
		                 unit_rowest = rowest, unit_colest = colest, 
		                 unit_totest = totest,
		                 unitvar = unitvar, 
		                 rowvar = rowvar, colvar = colvar,
		                 estnm = estnmd, psenm = psenm, 
		                 allin1 = allin1, char.width = char.width, 
		                 estnull = estnull, psenull = psenull,
		                 estround = estround, pseround = pseround,
		                 rowgrp = rowgrp, rowgrpnm = rowgrpnm, 
		                 title.rnames = title.rnames, 
		                 numunits = numunits, 
		                 savedata = savedata, addtitle = addtitle,
		                 returntitle = returntitle, 
		                 outfn.estpse = outfn.estpse, 
		                 title.estpse = title.estpse, 
		                 title.est = title.est, title.pse = title.pse,
		                 title.ref = title.ref, 
		                 outfolder = outfolder, outfn.date = outfn.date, 
		                 overwrite = overwrite, 
		                 esttype = esttype, phototype = phototype,
		                 rnames = rnames, 
		                 title.colvar = title.colvar, title.unitvar = title.unitvar)
      est2return <- tabs[[1]]
      if (length(tabs) == 2)
        pse2return <- tabs[[2]]

    } else {  ## colvar != "NONE" & sumunits == FALSE
      estunits <- unique(unit_grpest[[unitvar]])
      numunits <- length(estunits)
      tabs <- lapply(estunits, crossxbyunit, 
                     unit_grpest, unit_rowest, unit_colest,
		                 unit_totest, 
		                 unitvar = unitvar, 
		                 rowvar = rowvar, colvar = colvar,
		                 estnm = estnmd, psenm = psenm, 
		                 allin1 = allin1, char.width = char.width,
		                 estnull = estnull, psenull = psenull, 
		                 estround = estround, pseround = pseround,
		                 rowgrp = rowgrp, rowgrpnm = rowgrpnm, 
		                 title.rnames = title.rnames,
		                 numunits = numunits, 
		                 savedata = savedata, addtitle = addtitle,
		                 returntitle = returntitle, 
		                 outfn.estpse = outfn.estpse,
		                 title.estpse = title.estpse, 
		                 title.est = title.est, title.pse = title.pse,
		                 title.ref = title.ref, 
		                 outfolder = outfolder, outfn.date = outfn.date,
		                 overwrite = overwrite, 
		                 esttype = esttype, phototype = phototype,
		                 rnames = rnames, 
		                 title.colvar = title.colvar, title.unitvar = title.unitvar)
      names(tabs) <- estunits
      est2return <- rbindlist(lapply(tabs, `[[`, 1), use.names=TRUE, fill=TRUE)
      if (!allin1) {
        est2return[is.na(est2return)] <- estnull
      }
      if (unique(lapply(tabs, length)) == 2) {
        pse2return <- rbindlist(lapply(tabs, `[[`, 2), use.names=TRUE, fill=TRUE)
        if (!allin1) {
          pse2return[is.na(est2return)] <- psenull
        }
      }
    }
  }

  returnlst$tabest <- est2return
  titlelst$title.estpse <- title.estpse
  if (!is.null(pse2return)) {
    returnlst$tabpse <- pse2return
    titlelst$title.est <- title.est
    titlelst$title.pse <- title.pse
  }
  }

  ## Make rawtable
  if (rawdata) {
    rawdat.tabs <- {}
    if (is.null(rawdat)) rawdat <- list()

    ## Append totest to rawdat
    if (!is.null(unit_totest)) {
      if (esttype == "RATIO") {
        unit_totest <- getrhat(unit_totest)
      }
      ## Remove total column
      if ("TOTAL" %in% names(unit_totest)) {
        unit_totest[, TOTAL := NULL]
      }
      ## Split columns if unitvars exists
      if (!is.null(unitvars) && length(unitvars) > 1) {
        suppressWarnings(unit_totest[, (unitvars) := tstrsplit(get(unitvar), "-", fixed=TRUE)])
        unit_totest[, (unitvar) := NULL]
        setcolorder(unit_totest, c(unitvars,
		    names(unit_totest)[!names(unit_totest) %in% unitvars]))
      }
      rawdat$unit_totest <- setDF(unit_totest)
      rawdat.tabs <- c(rawdat.tabs, "unit_totest")

      if (sumunits) {
        rawdat$totest <- setDF(totest)
        rawdat.tabs <- c(rawdat.tabs, "totest")
      }
    }
    if (!rowvar %in% c("NONE", "TOTAL")) {
      if (!is.null(unit_rowest)) {

        ## Split columns if unitvars exists
        if (!is.null(unitvars) && length(unitvars) > 1) {
          suppressWarnings(unit_rowest[, (unitvars) := tstrsplit(get(unitvar), "-", fixed=TRUE)])
          unit_rowest[, (unitvar) := NULL]
          setcolorder(unit_rowest, c(unitvars,
			    names(unit_rowest)[!names(unit_rowest) %in% unitvars]))
        }

        ## Set order of table
        setorderv(unit_rowest, c(unitvars, rowvar))		
        setnames(unit_rowest, rowvar, title.rowvar)
        rawdat$unit_rowest <- setDF(unit_rowest)
        rawdat.tabs <- c(rawdat.tabs, "unit_rowest")

        if (sumunits) {
          setnames(rowest, rowvar, title.rowvar)
          rawdat$rowest <- setDF(rowest)
          rawdat.tabs <- c(rawdat.tabs, "rowest")
        }
      }
    }
    if (colvar != "NONE") {
      if (!is.null(unit_colest)) {

        ## Split columns if unitvars exists
        if (!is.null(unitvars) && length(unitvars) > 1) {
          suppressWarnings(unit_colest[, (unitvars) := tstrsplit(get(unitvar), "-", fixed=TRUE)])
          unit_colest[, (unitvar) := NULL]
          setcolorder(unit_colest, c(unitvars,
			    names(unit_colest)[!names(unit_colest) %in% unitvars]))
        }
        ## Set order of table
        setorderv(unit_colest, c(unitvars, colvar))

        setnames(unit_colest, colvar, title.colvar)
        rawdat$unit_colest <- setDF(unit_colest)
        rawdat.tabs <- c(rawdat.tabs, "unit_colest")

        if (sumunits) {
          setnames(colest, colvar, title.colvar)
          rawdat$colest <- setDF(colest)
          rawdat.tabs <- c(rawdat.tabs, "colest")
        }
      }

      if (!is.null(unit_grpest)) {
        if (!raw.keep0 && "NBRPLT.gt0" %in% names(unit_grpest)) {
          unit_grpest <- unit_grpest[unit_grpest[["NBRPLT.gt0"]] > 0,]
        }

        ## Split columns if unitvars exists
        if (!is.null(unitvars) && length(unitvars) > 1) {
          suppressWarnings(unit_grpest[, (unitvars) := tstrsplit(get(unitvar), "-", fixed=TRUE)])
          unit_grpest[, (unitvar) := NULL]
          setcolorder(unit_grpest, c(unitvars,
			    names(unit_grpest)[!names(unit_grpest) %in% unitvars]))
        }
        ## Set order of table
        setorderv(unit_grpest, c(unitvars, rowvar, colvar))

        setnames(unit_grpest, rowvar, title.rowvar)
        setnames(unit_grpest, colvar, title.colvar)
        rawdat$unit_grpest <- setDF(unit_grpest)
        rawdat.tabs <- c(rawdat.tabs, "unit_grpest")
      }
      if (sumunits) {
        setnames(grpest, rowvar, title.rowvar)
        setnames(grpest, colvar, title.colvar)
        rawdat$grpest <- setDF(grpest)
        rawdat.tabs <- c(rawdat.tabs, "grpest")
      }
    }
    if (CI) {
      rawdat[rawdat.tabs] <- lapply(rawdat[rawdat.tabs], addCI, estnm=estnm2)
    }
  }

  if (!is.null(title.rowvar)) titlelst$title.rowvar <- title.rowvar
  if (!is.null(title.colvar)) titlelst$title.colvar <- title.colvar
  if (!is.null(title.rowgrp)) titlelst$title.rowgrp <- title.rowgrp
  returnlst$titlelst <- titlelst

  if (rawdata) returnlst$rawdat <- rawdat

  return(returnlst)
}
USDAForestService/FIESTA documentation built on April 5, 2025, 4:13 a.m.