R/cdf.est.R

Defines functions cdf.est

Documented in cdf.est

################################################################################
# Function: cdf.est
# Programmer: Tom Kincaid
# Date: July 12, 2000
# Last Revised: October 10, 2012
#
#' Cumulative Distribution Function Estimate for Survey Design
#'
#' This function calculates an estimate of the cumulative distribution function
#' (CDF) for the proportion (expressed as percent) and the total of a response
#' variable, where the response variable may be defined for either a finite or
#' an extensive resource.  Optionally, for a finite resource, the size- weighted
#' CDF can be calculated.  In addition the standard error of the estimated CDF
#' and confidence bounds are calculated.  The user can supply the set of values
#' at which the CDF is estimated.  For the CDF of a proportion, the
#' Horvitz-Thompson ratio estimator, i.e., the ratio of two Horvitz-Thompson
#' estimators, is used to calculate the CDF estimate.  For the CDF of a total,
#' the user can supply the known size of the resource or the known sum of the
#' size-weights of the resource, as appropriate.  For the CDF of a total when
#' either the size of the resource or the sum of the size-weights of the
#' resource is provided, the classic ratio estimator is used to calculate the
#' CDF estimate, where that estimator is the product of the known value and the
#' Horvitz-Thompson ratio estimator.   For the CDF of a total when neither the
#' size of the resource nor the sum of the size-weights of the resource is
#' provided, the Horvitz-Thompson estimator is used to calculate the CDF
#' estimate.  Variance estimates for the estimated CDF are calculated using
#' either the local mean variance estimator or the simple random sampling (SRS)
#' variance estimator.  The choice of variance estimator is subject to user
#' control. The local mean variance estimator requires the x-coordinate and the
#' y-coordinate of each site.  The SRS variance estimator uses the independent
#' random sample approximation to calculate joint inclusion probabilities.
#' Confidence bounds are calculated using a Normal distribution multiplier. In
#' addition the function uses the estimated CDF to calculate percentile
#' estimates.  Estimated confidence bounds for the percentile estimates are
#' calculated.  The user can supply the set of values for which percentiles
#' estimates are desired.  Optionally, the user can use the default set of
#' percentiles.  The function can accommodate a stratified sample.  For a
#' stratified sample, separate estimates and standard errors are calculated for
#' each stratum, which are used to produce estimates and standard errors for all
#' strata combined.  Strata that contain a single value are removed. For a
#' stratified sample, when either the size of the resource or the sum of the
#' size-weights of the resource is provided for each stratum, those values are
#' used as stratum weights for calculating the estimates and standard errors for
#' all strata combined.  For a stratified sample when neither the size of the
#' resource nor the sum of the size-weights of the resource is provided for each
#' stratum, estimated values are used as stratum weights for calculating the
#' estimates and standard errors for all strata combined.  The function can
#' accommodate single-stage and two-stage samples for both stratified and
#' unstratified sampling designs.  Finite population and continuous population
#' correction factors can be utilized in variance estimation.  The function
#' checks for compatibility of input values and removes missing values.
#'
#' @param z Vector of the response value for each site.
#'
#' @param wgt Vector of the final adjusted weight (inverse of the sample
#'   inclusion probability) for each site, which is either the weight for a
#'   single-stage sample or the stage two weight for a two-stage sample.
#'
#' @param x Vector of the x-coordinate for location for each site, which is
#'   either the x-coordinate for a single-stage sample or the stage two
#'   x-coordinate for a two-stage sample.  The default is NULL.
#'
#' @param  y Vector y-coordinate for location for each site, which is either
#'   the y-coordinate for a single-stage sample or the stage two y-coordinate
#'   for a two-stage sample.  The default is NULL.
#'
#' @param stratum Vector of the stratum for each site.  The default is NULL.
#'
#' @param cluster Vector of the stage one sampling unit (primary sampling unit
#'   or cluster) code for each site.  The default is NULL.
#'
#' @param wgt1 Vector of the final adjusted stage one weight for each site.
#'   The default is NULL.
#'
#' @param x1 Vector of the stage one x-coordinate for location for each site.
#'   The default is NULL.
#'
#' @param y1 Vector of the stage one y-coordinate for location for each site.
#'   The default is NULL.
#'
#' @param popsize Known size of the resource, which is used to perform ratio
#'   adjustment to estimators expressed using measurement units for the resource
#'   and to calculate strata proportions for calculating estimates for a
#'   stratified sample.  For a finite resource, this argument is either the
#'   total number of sampling units or the known sum of size-weights.  For an
#'   extensive resource, this argument is the measure of the resource, i.e.,
#'   either known total length for a linear resource or known total area for an
#'   areal resource.  For a stratified sample this variable must be a vector
#'   containing a value for each stratum and must have the names attribute set
#'   to identify the stratum codes.  The default is NULL.
#'
#' @param popcorrect Logical value that indicates whether finite or continuous
#'   population correction factors should be employed during variance
#'   estimation, where TRUE = use the correction factor and FALSE = do not use
#'   the correction factor.  The default is FALSE.  To employ the correction
#'   factor for a single-stage sample, values must be supplied for arguments
#'   pcfsize and support.  To employ the correction factor for a two-stage
#'   sample, values must be supplied for arguments N.cluster, stage1size, and
#'   support.
#'
#' @param pcfsize Size of the resource, which is required for calculation of
#'   finite and continuous population correction factors for a single-stage
#'   sample. For a stratified sample this argument must be a vector containing a
#'   value for each stratum and must have the names attribute set to identify
#'   the stratum codes.  The default is NULL.
#'
#' @param N.cluster The number of stage one sampling units in the resource,
#'   which is required for calculation of finite and continuous population
#'   correction factors for a two-stage sample.  For a stratified sample this
#'   argument must be a vector containing a value for each stratum and must have
#'   the names attribute set to identify the stratum codes.  The default is
#'   NULL.
#'
#' @param stage1size Size of the stage one sampling units of a two-stage
#'   sample, which is required for calculation of finite and continuous
#'   population correction factors for a two-stage sample and must have the
#'   names attribute set to identify the stage one sampling unit codes.  For a
#'   stratified sample, the names attribute must be set to identify both stratum
#'   codes and stage one sampling unit codes using a convention where the two
#'   codes are separated by the & symbol, e.g., "Stratum 1&Cluster 1". The
#'   default is NULL.
#'
#' @param support The support value for each site - the value one (1) for a
#'   site from a finite resource or the measure of the sampling unit associated
#'   with a site from an extensive resource, which is required for calculation
#'   of finite and continuous population correction factors.  The default is
#'   NULL.
#'
#' @param sizeweight Logical value that indicates whether size-weights should
#'   be used in the analysis, where TRUE = use the size-weights and FALSE = do
#'   not use the size-weights.  The default is FALSE.
#'
#' @param swgt The size-weight for each site, which is the stage two
#'   size-weight for two-stage sample.  The default is NULL.
#'
#' @param swgt1 Vector of the stage one size-weight for each site.  The
#'   default is NULL.
#'
#' @param vartype  The choice of variance estimator, where "Local" = local mean
#'   estimator and "SRS" = SRS estimator.  The default is "Local".
#'
#' @param conf  Numeric value for the confidence level.  The default is 95.
#'
#' @param cdfval The set of values at which the CDF is estimated.  If a set of
#'   values is not provided, then the sorted set of unique values of the
#'   response variable is used.  The default is NULL.
#'
#' @param pctval The set of values at which percentiles are estimated.  The
#'   default set is: {5, 10, 25, 50, 75, 90, 95}.
#'
#' @param check.ind Logical value that indicates whether compatability
#'   checking of the input values is conducted, where TRUE = conduct
#'   compatibility checking and FALSE = do not conduct compatibility checking.
#'   The default is TRUE.
#'
#' @param warn.ind Logical value that indicates whether warning messages were
#'   generated, where TRUE = warning messages were generated and FALSE = warning
#'   messages were not generated.  The default is NULL.
#'
#' @param warn.df A data frame for storing warning messages.  The default is
#'   NULL.
#'
#' @param warn.vec A vector that contains names of the population type, the
#'   subpopulation, and an indicator.  The default is NULL.
#'
#' @return If the function was called by the cont.analysis function, then
#'   output is an object in list format composed of a list named Results, which
#'   contains estimates and confidence bounds, and a data frame named warn.df,
#'   which contains warning messages.  The Results list is composed of two data
#'   frames: one data frame named CDF, which contains the CDF estimates, and a
#'   second data frame named Pct, which contains the percentile estimates.  If
#'   the function was called directly, then output is the Results list.
#'
#' @section Other Functions Required:
#'   \describe{
#'     \item{\code{\link{input.check}}}{check input values for errors,
#'       consistency, and compatibility with analytical functions}
#'     \item{\code{\link{wnas}}}{remove missing values}
#'     \item{\code{\link{vecprint}}}{takes an input vector and outputs a
#'       character string with line breaks inserted}
#'     \item{\code{\link{cdf.nresp}}}{calculate the number of response values
#'       less than or equal to each of the set of values at which the CDF is
#'       estimated}
#'     \item{\code{\link{cdf.prop}}}{calculate the CDF for the proportion}
#'     \item{\code{\link{cdf.total}}}{calculate the CDF for the total}
#'     \item{\code{\link{cdf.size.prop}}}{calculate the size-weighted CDF for
#'       the proportion}
#'     \item{\code{\link{cdf.size.total}}}{calculate the size-weighted CDF for
#'       the total}
#'     \item{\code{\link{cdfvar.prop}}}{calculate variance of the CDF for the
#'       proportion}
#'     \item{\code{\link{cdfvar.total}}}{calculate variance of the CDF for the
#'       total}
#'     \item{\code{\link{cdfvar.size.prop}}}{calculate variance of the
#'       size-weighted CDF for the proportion}
#'     \item{\code{\link{cdfvar.size.total}}}{calculate variance of the
#'       size-weighted CDF for the total}
#'   }
#'
#' @author Tom Kincaid \email{Kincaid.Tom@epa.gov}
#'
#' @keywords survey
#'
#' @examples
#' z <- rnorm(100, 10, 1)
#' wgt <- runif(100, 10, 100)
#' cdfval <- seq(min(z), max(z), length=20)
#' cdf.est(z, wgt, vartype="SRS", cdfval=cdfval)
#'
#' x <- runif(100)
#' y <- runif(100)
#' cdf.est(z, wgt, x, y, cdfval=cdfval)
#'
#' @export
################################################################################

cdf.est <- function(z, wgt, x = NULL, y = NULL, stratum = NULL, cluster = NULL,
   wgt1 = NULL, x1 = NULL, y1 = NULL, popsize = NULL, popcorrect = FALSE,
   pcfsize = NULL, N.cluster = NULL, stage1size = NULL, support = NULL,
   sizeweight = FALSE, swgt = NULL, swgt1 = NULL, vartype = "Local", conf = 95,
   cdfval = NULL, pctval = c(5,10,25,50,75,90,95), check.ind = TRUE,
   warn.ind = NULL, warn.df = NULL, warn.vec = NULL) {

# As necessary, create a data frame for warning messages

   if(is.null(warn.ind)) {
      warn.ind <- FALSE
      warn.df <- NULL
      warn.vec <- rep(NA, 3)
   }
   fname <- "cdf.est"

# Check for existence of the response variable and determine the number of
# values

   if(is.null(z))
      stop("\nValues must be provided for the response variable.")
   if(!is.numeric(z))
      stop("\nValues for the response variable must be numeric.")
   nresp <- length(z)

# Assign a logical value to the indicator variable for a stratified sample

   stratum.ind <- length(unique(stratum)) > 1

# If the sample is stratified, convert stratum to a factor, determine stratum
# levels, and calculate number of strata,

   if(stratum.ind) {
      stratum <- factor(stratum)
      stratum.levels <- levels(stratum)
      nstrata <- length(stratum.levels)
   } else {
      stratum.levels <- NULL
      nstrata <- NULL
   }

# Assign a logical value to the indicator variable for a two stage sample

   cluster.ind <- length(unique(cluster)) > 1

# Assign the value of popcorrect to the indicator variable for use of the
# population correction factor

   pcfactor.ind <- popcorrect

# Assign the value of sizeweight to the indicator variable for use of size
# weights

   swgt.ind <- sizeweight

# Begin the section that checks for compatibility of input values

   if(check.ind) {

# If the sample has two stages, convert cluster to a factor, determine cluster
# levels, and calculate number of clusters

   if(cluster.ind) {
      if(stratum.ind) {
         cluster.in <- cluster
         cluster <- tapply(cluster, stratum, factor)
         cluster.levels <- sapply(cluster, levels, simplify=FALSE)
         ncluster <- sapply(cluster.levels, length)
      } else {
         cluster <- factor(cluster)
         cluster.levels <- levels(cluster)
         ncluster <- length(cluster.levels)
      }
   }

# Check for compatibility of input values

      temp <- input.check(nresp, wgt, NULL, NULL, x, y, stratum.ind, stratum,
         stratum.levels, nstrata, cluster.ind, cluster, cluster.levels,
         ncluster, wgt1, x1, y1, popsize, pcfactor.ind, pcfsize, N.cluster,
         stage1size, support, swgt.ind, swgt, swgt1, vartype, conf, cdfval,
         pctval)

      popsize <- temp$popsize
      pcfsize <- temp$pcfsize
      N.cluster <- temp$N.cluster
      stage1size <- temp$stage1size

# If the sample was stratified and had two stages, then reset cluster to its
# input value

   if(stratum.ind && cluster.ind)
      cluster <- cluster.in

# End the section that checks for compatibility of input values

   }

# Remove missing values

   if(vartype == "Local") {
      if(swgt.ind) {
         if(stratum.ind) {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y, stratum=stratum,
                   cluster=cluster, wgt1=wgt1, x1=x1, y1=y1, swgt=swgt,
                   swgt1=swgt1))
            else
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y, stratum=stratum,
                  swgt=swgt))
         } else {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y, cluster=cluster,
                  wgt1=wgt1, x1=x1, y1=y1, swgt=swgt, swgt1=swgt1))
            else
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y, swgt=swgt))
         }
         z <- temp$z
         wgt <- temp$wgt
         x <- temp$x
         y <- temp$y
         if(stratum.ind)
            stratum <- temp$stratum
         if(cluster.ind) {
            cluster <- temp$cluster
            wgt1 <- temp$wgt1
            x1 <- temp$x1
            y1 <- temp$y1
            swgt1 <- temp$swgt1
         }
         swgt <- temp$swgt
      } else {
         if(stratum.ind) {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y, stratum=stratum,
                  cluster=cluster, wgt1=wgt1, x1=x1, y1=y1))
            else
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y, stratum=stratum))
         } else {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y, cluster=cluster,
                  wgt1=wgt1, x1=x1, y1=y1))
            else
               temp <- wnas(list(z=z, wgt=wgt, x=x, y=y))
         }
         z <- temp$z
         wgt <- temp$wgt
         x <- temp$x
         y <- temp$y
         if(stratum.ind)
            stratum <- temp$stratum
         if(cluster.ind) {
            cluster <- temp$cluster
            wgt1 <- temp$wgt1
            x1 <- temp$x1
            y1 <- temp$y1
         }
      }
   } else {
      if(swgt.ind) {
         if(stratum.ind) {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, stratum=stratum, cluster=cluster,
                  wgt1=wgt1, swgt=swgt, swgt1=swgt1))
            else
               temp <- wnas(list(z=z, wgt=wgt, stratum=stratum, swgt=swgt))
         } else {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, cluster=cluster, wgt1=wgt1,
                  swgt=swgt, swgt1=swgt1))
            else
               temp <- wnas(list(z=z, wgt=wgt, swgt=swgt))
         }
         z <- temp$z
         wgt <- temp$wgt
         if(stratum.ind)
            stratum <- temp$stratum
         if(cluster.ind) {
            cluster <- temp$cluster
            wgt1 <- temp$wgt1
            swgt1 <- temp$swgt1
         }
         swgt <- temp$swgt
      } else {
         if(stratum.ind) {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, stratum=stratum, cluster=cluster,
                  wgt1=wgt1))
            else
               temp <- wnas(list(z=z, wgt=wgt, stratum=stratum))
         } else {
            if(cluster.ind)
               temp <- wnas(list(z=z, wgt=wgt, cluster=cluster, wgt1=wgt1))
            else
               temp <- wnas(list(z=z, wgt=wgt))
         }
         z <- temp$z
         wgt <- temp$wgt
         if(stratum.ind)
            stratum <- temp$stratum
         if(cluster.ind) {
            cluster <- temp$cluster
            wgt1 <- temp$wgt1
         }
      }
   }

# For a stratified sample, check for strata that no longer contain any values,
# as necesssary adjust popsize, remove strata that contain a single value, and
# output a warning message

   if(stratum.ind) {
      stratum <- factor(stratum)
      stratum.levels.old <- stratum.levels
      stratum.levels <- levels(stratum)
      nstrata.old <- nstrata
      nstrata <- length(stratum.levels)
      if(nstrata < nstrata.old) {
         warn.ind <- TRUE
         temp <- match(stratum.levels, stratum.levels.old)
         temp.str <- vecprint(stratum.levels.old[-temp])
         warn <- paste("The following strata no longer contain any values and were removed from the \nanalysis:\n", temp.str, sep="")
         act <- "Strata were removed from the analysis.\n"
         warn.df <- rbind(warn.df, data.frame(func=I(fname),
            subpoptype=warn.vec[1], subpop=warn.vec[2], indicator=warn.vec[3],
            stratum=NA, warning=I(warn), action=I(act)))
         if(!is.null(popsize))
            popsize <- popsize[temp]
      }

      ind <- FALSE
      for(i in 1:nstrata) {
         stratum.i <- stratum == stratum.levels[i]
         if(sum(stratum.i) == 1) {
            warn.ind <- TRUE
            warn <- paste("The stratum named", stratum.levels[i], "contains a single value and was removed from the analysis.\n")
            act <- "Stratum was removed from the analysis.\n"
            warn.df <- rbind(warn.df, data.frame(func=I(fname),
               subpoptype=warn.vec[1], subpop=warn.vec[2],
               indicator=warn.vec[3], stratum=NA, warning=I(warn),
               action=I(act)))
            z <- z[!stratum.i]
            wgt <- wgt[!stratum.i]
            if(vartype == "Local") {
               x <- x[!stratum.i]
               y <- y[!stratum.i]
            }
            stratum <- stratum[!stratum.i]
            if(cluster.ind) {
               cluster <- cluster[!stratum.i]
               wgt1 <- wgt1[!stratum.i]
               if(vartype == "Local") {
                  x1 <- x1[!stratum.i]
                  y1 <- y1[!stratum.i]
               }
            }
            if(swgt.ind) {
               swgt <- swgt[!stratum.i]
               if(cluster.ind)
                  swgt1 <- swgt1[!stratum.i]
            }
            if(!is.null(popsize))
               popsize <- popsize[names(popsize) != stratum.levels[i]]
            ind <- TRUE
         }
      }
      if(ind) {
         stratum <- factor(stratum)
         stratum.levels <- levels(stratum)
         nstrata <- length(stratum.levels)
      }

# Check whether the number of strata is one

      if(nstrata == 1) {
         warn.ind <- TRUE
         warn <- "Only a single stratum was available for the analysis.\n"
         act <- "An unstratified data analysis was used.\n"
         warn.df <- rbind(warn.df, data.frame(func=I(fname),
            subpoptype=warn.vec[1], subpop=warn.vec[2], indicator=warn.vec[3],
            stratum=NA, warning=I(warn), action=I(act)))
         stratum.ind <- FALSE
      }
   }

# Check whether the vector of response values is empty

   if(length(z) == 0)
      stop("\nEstimates cannot be calculated since the vector of response values is empty.")

# If the sample has two stages, determine whether there are any stage one
# sampling units with a sufficient number of sites to allow variance calculation

   if(cluster.ind) {
      temp <- sapply(split(cluster, cluster), length) == 1
      if(all(temp)) {
         stop("\nA variance estimate cannot be calculated since all of the stage one sampling \nunit(s) contain a single stage two sampling unit.")
      }
      if(any(temp)) {
         temp.str <- vecprint(names(temp)[temp])
         warn <- paste("Since the following stage one sampling units contain a single stage two \nsampling unit, a variance estimate cannot be calculated and the mean of the \nvariance estimates for stage one sampling units with two or more sites will \nbe used:\n", temp.str, sep="")
         act <- "The mean of the variance estimates will be used.\n"
         warn.df <- rbind(warn.df, data.frame(func=I(fname), subpoptype=NA,
            subpop=NA, indicator=NA, stratum=NA, warning=I(warn),
            action=I(act)))
      }
   }

# Calculate the confidence bound multiplier

   mult <- qnorm(0.5 + (conf/100)/2)

# Calculate additional required values

   if(is.null(cdfval))
      cdfval <- sort(unique(z))
   ncdfval <- length(cdfval)
   nvec <- 1:ncdfval
   npctval <- length(pctval)
   if(swgt.ind) {
      if(!is.null(popsize)) {
         sum.popsize <- sum(popsize)
      } else {
         if(stratum.ind) {
            if(cluster.ind) {
               popsize.hat <- tapply(wgt*swgt*wgt1*swgt1, stratum, sum)
               sum.popsize.hat <- sum(wgt*swgt*wgt1*swgt1)
            } else {
               popsize.hat <- tapply(wgt*swgt, stratum, sum)
               sum.popsize.hat <- sum(wgt*swgt)
            }
         } else {
            if(cluster.ind)
               popsize.hat <- sum(wgt*swgt*wgt1*swgt1)
            else
               popsize.hat <- sum(wgt*swgt)
         }
      }
   } else {
      if(!is.null(popsize)) {
         sum.popsize <- sum(popsize)
      } else {
         if(stratum.ind) {
            if(cluster.ind) {
               popsize.hat <- tapply(wgt*wgt1, stratum, sum)
               sum.popsize.hat <- sum(wgt*wgt1)
            } else {
               popsize.hat <- tapply(wgt, stratum, sum)
               sum.popsize.hat <- sum(wgt)
            }
         } else {
            if(cluster.ind)
               popsize.hat <- sum(wgt*wgt1)
            else
               popsize.hat <- sum(wgt)
         }
      }
   }

# Branch to handle stratified and unstratified data

   if(stratum.ind) {

# Begin the section for stratified data

# Create the object for the estimates

   Results <- vector("list", 2)
   names(Results) <- c("CDF", "Pct")

# Begin subsection for CDF estimates

# Create the data frame for CDF estimates

   rslt <- data.frame(array(0, c(ncdfval, 10)))
   dimnames(rslt) <- list(1:ncdfval, c("Value", "NResp", "Estimate.P",
      "StdError.P", paste("LCB", conf, "Pct.P", sep=""), paste("UCB", conf,
      "Pct.P", sep=""), "Estimate.U", "StdError.U", paste("LCB", conf, "Pct.U",
      sep=""), paste("UCB", conf, "Pct.U", sep="")))
   rslt[,1] <- cdfval

# Begin the subsection for individual strata

   for(i in 1:nstrata) {

# Calculate the CDF estimates and variance estimates

   stratum.i <- stratum == stratum.levels[i]
   if(swgt.ind) {
      cdfest.p <- cdf.size.prop(z[stratum.i], wgt[stratum.i], cdfval,
         cluster.ind, cluster[stratum.i], wgt1[stratum.i], swgt[stratum.i],
         swgt1[stratum.i])
      temp <- cdfvar.size.prop(z[stratum.i], wgt[stratum.i], x[stratum.i],
         y[stratum.i], cdfval, cdfest.p, stratum.ind, stratum.levels[i],
         cluster.ind, cluster[stratum.i], wgt1[stratum.i], x1[stratum.i],
         y1[stratum.i], pcfactor.ind, pcfsize[i], N.cluster[i], stage1size[[i]],
         support[stratum.i], swgt[stratum.i], swgt1[stratum.i], vartype,
         warn.ind, warn.df, warn.vec)
      varest.p <- temp$varest
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df

      cdfest.u <- cdf.size.total(z[stratum.i], wgt[stratum.i], cdfval,
         cluster.ind, cluster[stratum.i], wgt1[stratum.i], popsize[i],
         swgt[stratum.i], swgt1[stratum.i])
      temp <- cdfvar.size.total(z[stratum.i], wgt[stratum.i], x[stratum.i],
         y[stratum.i], cdfval, cdfest.u, stratum.ind, stratum.levels[i],
         cluster.ind, cluster[stratum.i], wgt1[stratum.i], x1[stratum.i],
         y1[stratum.i], popsize[i], pcfactor.ind, pcfsize[i], N.cluster[i],
         stage1size[[i]], support[stratum.i], swgt[stratum.i], swgt1[stratum.i],
         vartype, warn.ind, warn.df, warn.vec)
      varest.u <- temp$varest
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df
   } else {
      cdfest.p <- cdf.prop(z[stratum.i], wgt[stratum.i], cdfval, cluster.ind,
         cluster[stratum.i], wgt1[stratum.i])
      temp <- cdfvar.prop(z[stratum.i], wgt[stratum.i], x[stratum.i],
         y[stratum.i], cdfval, cdfest.p, stratum.ind, stratum.levels[i],
         cluster.ind, cluster[stratum.i], wgt1[stratum.i], x1[stratum.i],
         y1[stratum.i], pcfactor.ind, pcfsize[i], N.cluster[i], stage1size[[i]],
         support[stratum.i], vartype, warn.ind, warn.df, warn.vec)
      varest.p <- temp$varest
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df

      cdfest.u <- cdf.total(z[stratum.i], wgt[stratum.i], cdfval, cluster.ind,
         cluster[stratum.i], wgt1[stratum.i], popsize[i])
      temp <- cdfvar.total(z[stratum.i], wgt[stratum.i], x[stratum.i],
         y[stratum.i], cdfval, cdfest.u, stratum.ind, stratum.levels[i],
         cluster.ind, cluster[stratum.i], wgt1[stratum.i], x1[stratum.i],
         y1[stratum.i], popsize[i], pcfactor.ind, pcfsize[i], N.cluster[i],
         stage1size[[i]], support[stratum.i], vartype, warn.ind, warn.df,
         warn.vec)
      varest.u <- temp$varest
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df
   }

# Add estimates to the data frame for all strata combined

   if(!is.null(popsize)) {
      rslt[,3] <- rslt[,3] + (popsize[i]/sum.popsize)*cdfest.p
      rslt[,4] <- rslt[,4] + ((popsize[i]/sum.popsize)^2)*varest.p
   } else {
      rslt[,3] <- rslt[,3] + (popsize.hat[i]/sum.popsize.hat)*cdfest.p
      rslt[,4] <- rslt[,4] + ((popsize.hat[i]/sum.popsize.hat)^2)*varest.p
   }
   rslt[,7] <- rslt[,7] + cdfest.u
   rslt[,8] <- rslt[,8] + varest.u

# End the subsection for individual strata

   }

# Begin the subsection for all strata combined

# Calculate the number of response values, standard errors, and confidence
# bounds

   rslt[,2] <- cdf.nresp(z, cdfval)

   rslt[,4] <- sqrt(rslt[,4])

   rslt[,8] <- sqrt(rslt[,8])

   rslt[,5] <- 100*pmax(rslt[,3] - mult*rslt[,4], 0)
   rslt[,6] <- 100*pmin(rslt[,3] + mult*rslt[,4], 1)
   rslt[,3] <- 100*rslt[,3]
   rslt[,4] <- 100*rslt[,4]

   rslt[,9] <- pmax(rslt[,7] - mult*rslt[,8], 0)
   if(!is.null(popsize))
      rslt[,10] <- pmin(rslt[,7] + mult*rslt[,8], sum.popsize)
   else
      rslt[,10] <- rslt[,7] + mult*rslt[,8]

# Assign results to the data frame for estimates

   Results$CDF <- data.frame(rslt)

# End the subsection for all strata combined

# End subsection for CDF estimates

# Begin subsection for percentile estimates

# Create the data frame for percentile estimates

   rslt <- data.frame(array(0, c(npctval, 10)))
   dimnames(rslt) <- list(1:npctval, c("Statistic", "NResp", "Estimate.P",
      "StdError.P", paste("LCB", conf, "Pct.P", sep=""), paste("UCB", conf,
      "Pct.P", sep=""), "Estimate.U", "StdError.U", paste("LCB", conf, "Pct.U",
      sep=""), paste("UCB", conf, "Pct.U", sep="")))
   rslt[,1] <- paste(pctval, "Pct", sep="")
   rslt[,4] <- I(character(npctval))
   rslt[,8] <- I(character(npctval))

# Convert the input percentile values to proportions and to percentage of total,
# as appropriate

   pctval.p <- pctval/100
   if(!is.null(popsize))
      pctval.u <- (pctval/100)*sum.popsize
   else
      pctval.u <- (pctval/100)*sum.popsize.hat

# Determine whether all response values are equal and assign estimates when true

   if(min(z) == max(z)) {
      rslt[,2] <- length(z)
      rslt[,c(3,5,6,7,9,10)] <- max(z)

   } else {

# Calculate percentile estimates

      cdfest.p <- Results$CDF$Estimate.P/100
      cdfest.u <- Results$CDF$Estimate.U
      for(j in 1:npctval) {
         high <- ifelse(length(nvec[cdfest.p >= pctval.p[j]]) > 0,
            min(nvec[cdfest.p >= pctval.p[j]]), NA)
         low <- ifelse(length(nvec[cdfest.p <= pctval.p[j]]) > 0,
            max(nvec[cdfest.p <= pctval.p[j]]), NA)
         if(is.na(high)) {
            rslt[j,3] <- NA
         } else if(is.na(low)) {
            rslt[j,3] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (pctval.p[j] - cdfest.p[low]) / (cdfest.p[high] -
                  cdfest.p[low])
            else
               ival <- 1
            rslt[j,3] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }

         high <- ifelse(length(nvec[cdfest.u >= pctval.u[j]]) > 0,
            min(nvec[cdfest.u >= pctval.u[j]]), NA)
         low <- ifelse(length(nvec[cdfest.u <= pctval.u[j]]) > 0,
            max(nvec[cdfest.u <= pctval.u[j]]), NA)
         if(is.na(high)) {
            rslt[j,7] <- NA
         } else if(is.na(low)) {
            rslt[j,7] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (pctval.u[j] - cdfest.u[low]) / (cdfest.u[high] -
                  cdfest.u[low])
            else
               ival <- 1
            rslt[j,7] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }
      }

# Determine number of response values

      rslt[,2] <- cdf.nresp(z, rslt[,3])

# Calculate variance of the inverse percentile estimates

      temp.p <- !is.na(rslt[,3])
      varest.p <- ifelse(temp.p, 0, NA)
      lbound.p <- rep(NA, npctval)
      ubound.p <- rep(NA, npctval)
      temp.u <- !is.na(rslt[,7])
      varest.u <- ifelse(temp.u, 0, NA)
      lbound.u <- rep(NA, npctval)
      ubound.u <- rep(NA, npctval)
      for(i in 1:nstrata) {
         stratum.i <- stratum == stratum.levels[i]
         if(swgt.ind) {
            if(!is.null(popsize)) {
               temp <- cdfvar.size.prop(z[stratum.i], wgt[stratum.i],
                  x[stratum.i], y[stratum.i], rslt[temp.p,3], pctval.p[temp.p],
                  stratum.ind, stratum.levels[i], cluster.ind,
                  cluster[stratum.i], wgt1[stratum.i], x1[stratum.i],
                  y1[stratum.i], pcfactor.ind, pcfsize[i], N.cluster[i],
                  stage1size[[i]], support[stratum.i], swgt[stratum.i],
                  swgt1[stratum.i], vartype, warn.ind, warn.df, warn.vec)
               varest.p[temp.p] <- varest.p[temp.p] +
                  ((popsize[i]/sum.popsize)^2)*temp$varest
               warn.ind <- temp$warn.ind
               warn.df <- temp$warn.df
            } else {
               temp <- cdfvar.size.prop(z[stratum.i], wgt[stratum.i],
                  x[stratum.i], y[stratum.i], rslt[temp.p,3], pctval.p[temp.p],
                  stratum.ind, stratum.levels[i], cluster.ind,
                  cluster[stratum.i], wgt1[stratum.i], x1[stratum.i],
                  y1[stratum.i], pcfactor.ind, pcfsize[i], N.cluster[i],
                  stage1size[[i]], support[stratum.i], swgt[stratum.i],
                  swgt1[stratum.i], vartype, warn.ind, warn.df, warn.vec)
               varest.p[temp.p] <- varest.p[temp.p] + ((popsize.hat[i]/
                  sum.popsize.hat)^2)*temp$varest
               warn.ind <- temp$warn.ind
               warn.df <- temp$warn.df
            }
            temp <- cdfvar.size.total(z[stratum.i], wgt[stratum.i],
               x[stratum.i], y[stratum.i], rslt[temp.u,7], pctval.u[temp.u],
               stratum.ind, stratum.levels[i], cluster.ind, cluster[stratum.i],
               wgt1[stratum.i], x1[stratum.i], y1[stratum.i], popsize[i],
               pcfactor.ind, pcfsize[i], N.cluster[i], stage1size[[i]],
               support[stratum.i], swgt[stratum.i], swgt1[stratum.i], vartype,
               warn.ind, warn.df, warn.vec)
            varest.u[temp.u] <- varest.u[temp.u] + temp$varest
            warn.ind <- temp$warn.ind
            warn.df <- temp$warn.df
         } else {
            if(!is.null(popsize)) {
               temp <- cdfvar.prop(z[stratum.i], wgt[stratum.i], x[stratum.i],
                  y[stratum.i], rslt[temp.p,3], pctval.p[temp.p], stratum.ind,
                  stratum.levels[i], cluster.ind, cluster[stratum.i],
                  wgt1[stratum.i], x1[stratum.i], y1[stratum.i], pcfactor.ind,
                  pcfsize[i], N.cluster[i], stage1size[[i]], support[stratum.i],
                  vartype, warn.ind, warn.df, warn.vec)
               varest.p[temp.p] <- varest.p[temp.p] +
                  ((popsize[i]/sum.popsize)^2)*temp$varest
               warn.ind <- temp$warn.ind
               warn.df <- temp$warn.df
            } else {
               temp <- cdfvar.prop(z[stratum.i], wgt[stratum.i], x[stratum.i],
                  y[stratum.i], rslt[temp.p,3], pctval.p[temp.p], stratum.ind,
                  stratum.levels[i], cluster.ind, cluster[stratum.i],
                  wgt1[stratum.i], x1[stratum.i], y1[stratum.i], pcfactor.ind,
                  pcfsize[i], N.cluster[i], stage1size[[i]], support[stratum.i],
                  vartype, warn.ind, warn.df, warn.vec)
               varest.p[temp.p] <- varest.p[temp.p] + ((popsize.hat[i]/
                  sum.popsize.hat)^2)*temp$varest
               warn.ind <- temp$warn.ind
               warn.df <- temp$warn.df
            }
            temp <- cdfvar.total(z[stratum.i], wgt[stratum.i], x[stratum.i],
               y[stratum.i], rslt[temp.u,7], pctval.u[temp.u], stratum.ind,
               stratum.levels[i], cluster.ind, cluster[stratum.i],
               wgt1[stratum.i], x1[stratum.i], y1[stratum.i], popsize[i],
               pcfactor.ind, pcfsize[i], N.cluster[i], stage1size[[i]],
               support[stratum.i], vartype, warn.ind, warn.df, warn.vec)
            varest.u[temp.u] <- varest.u[temp.u] + temp$varest
            warn.ind <- temp$warn.ind
            warn.df <- temp$warn.df
         }
      }

# Calculate confidence bounds of the inverse percentile estimates

      lbound.p[temp.p] <- pmax(pctval.p[temp.p] - mult*sqrt(varest.p[temp.p]),
         0)
      ubound.p[temp.p] <- pmin(pctval.p[temp.p] + mult*sqrt(varest.p[temp.p]),
         1)
      lbound.u[temp.u] <- pmax(pctval.u[temp.u] - mult*sqrt(varest.u[temp.u]),
         0)
      if(!is.null(popsize))
         ubound.u[temp.u] <- pmin(pctval.u[temp.u] +
            mult*sqrt(varest.u[temp.u]), sum.popsize)
      else
         ubound.u[temp.u] <- pctval.u[temp.u] + mult*sqrt(varest.u[temp.u])

# Calculate confidence bounds of the percentile estimates

      for(j in 1:npctval) {
         if(temp.p[j]) {
            high <- ifelse(length(nvec[cdfest.p >= lbound.p[j]]) > 0,
               min(nvec[cdfest.p >= lbound.p[j]]), NA)
            low <- ifelse(length(nvec[cdfest.p <= lbound.p[j]]) > 0,
               max(nvec[cdfest.p <= lbound.p[j]]), NA)
            if(is.na(high)) {
               rslt[j,5] <- NA
            } else if(is.na(low)) {
               rslt[j,5] <- cdfval[high]
            } else {
               if(high > low)
                  ival <- (lbound.p[j] - cdfest.p[low]) / (cdfest.p[high] -
                     cdfest.p[low])
               else
                  ival <- 1
               rslt[j,5] <- ival*cdfval[high] + (1-ival)*cdfval[low]
            }

            high <- ifelse(length(nvec[cdfest.p >= ubound.p[j]]) > 0,
               min(nvec[cdfest.p >= ubound.p[j]]), NA)
            low <- ifelse(length(nvec[cdfest.p <= ubound.p[j]]) > 0,
               max(nvec[cdfest.p <= ubound.p[j]]), NA)
            if(is.na(high)) {
               rslt[j,6] <- NA
            } else if(is.na(low)) {
               rslt[j,6] <- cdfval[high]
            } else {
               if(high > low)
                  ival <- (ubound.p[j] - cdfest.p[low]) / (cdfest.p[high] -
                     cdfest.p[low])
               else
                  ival <- 1
               rslt[j,6] <- ival*cdfval[high] + (1-ival)*cdfval[low]
            }
         } else {
            rslt[j,5] <- NA
            rslt[j,6] <- NA
         }

         if(temp.u[j]) {
            high <- ifelse(length(nvec[cdfest.u >= lbound.u[j]]) > 0,
               min(nvec[cdfest.u >= lbound.u[j]]), NA)
            low <- ifelse(length(nvec[cdfest.u <= lbound.u[j]]) > 0,
               max(nvec[cdfest.u <= lbound.u[j]]), NA)
            if(is.na(high)) {
               rslt[j,9] <- NA
            } else if(is.na(low)) {
               rslt[j,9] <- cdfval[high]
            } else {
               if(high > low)
                  ival <- (lbound.u[j] - cdfest.u[low]) / (cdfest.u[high] -
                     cdfest.u[low])
               else
                  ival <- 1
               rslt[j,9] <- ival*cdfval[high] + (1-ival)*cdfval[low]
            }

            high <- ifelse(length(nvec[cdfest.u >= ubound.u[j]]) > 0,
               min(nvec[cdfest.u >= ubound.u[j]]), NA)
            low <- ifelse(length(nvec[cdfest.u <= ubound.u[j]]) > 0,
               max(nvec[cdfest.u <= ubound.u[j]]), NA)
            if(is.na(high)) {
               rslt[j,10] <- NA
            } else if(is.na(low)) {
               rslt[j,10] <- cdfval[high]
            } else {
               if(high > low)
                  ival <- (ubound.u[j] - cdfest.u[low]) / (cdfest.u[high] -
                     cdfest.u[low])
               else
                  ival <- 1
               rslt[j,10] <- ival*cdfval[high] + (1-ival)*cdfval[low]
            }
         } else {
            rslt[j,9] <- NA
            rslt[j,10] <- NA
         }
      }
   }

# Assign results to the data frame for estimates

   Results$Pct <- rslt

# End the subsection for percentile estimates

# End the section for stratified data

   } else {

# Begin the section for unstratified data

# Check whether the vector of response values contains a single element

   if(length(z) == 1)
      stop("\nEstimates cannot be calculated since the vector of response values contains a \nsingle element.")

# Begin subsection for CDF estimates

# Create the object for the estimates

   Results <- vector("list", 2)
   names(Results) <- c("CDF", "Pct")

# Calculate the number of response values, CDF estimates, standard error
# estimates, and confidence bounds

   nresp <- cdf.nresp(z, cdfval)

   if(swgt.ind) {
      cdfest.p <- cdf.size.prop(z, wgt, cdfval, cluster.ind, cluster, wgt1,
         swgt, swgt1)
      temp <- cdfvar.size.prop(z, wgt, x, y, cdfval, cdfest.p, stratum.ind,
         NULL, cluster.ind, cluster, wgt1, x1, y1, pcfactor.ind, pcfsize,
         N.cluster, stage1size, support, swgt, swgt1, vartype, warn.ind,
         warn.df, warn.vec)
      sdest.p <- sqrt(temp$varest)
      lbound.p <- pmax(cdfest.p - mult*sdest.p, 0)
      ubound.p <- pmin(cdfest.p + mult*sdest.p, 1)
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df

      cdfest.u <- cdf.size.total(z, wgt, cdfval, cluster.ind, cluster, wgt1,
         popsize, swgt, swgt1)
      temp <- cdfvar.size.total(z, wgt, x, y, cdfval, cdfest.u, stratum.ind,
         NULL, cluster.ind, cluster, wgt1, x1, y1, popsize, pcfactor.ind,
         pcfsize, N.cluster, stage1size, support, swgt, swgt1, vartype,
         warn.ind, warn.df, warn.vec)
      sdest.u <- sqrt(temp$varest)
      lbound.u <- pmax(cdfest.u - mult*sdest.u, 0)
      if(!is.null(popsize))
         ubound.u <- pmin(cdfest.u + mult*sdest.u, popsize)
      else
         ubound.u <- cdfest.u + mult*sdest.u
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df
   } else {
      cdfest.p <- cdf.prop(z, wgt, cdfval, cluster.ind, cluster, wgt1)
      temp <- cdfvar.prop(z, wgt, x, y, cdfval, cdfest.p, stratum.ind, NULL,
         cluster.ind, cluster, wgt1, x1, y1, pcfactor.ind, pcfsize, N.cluster,
         stage1size, support, vartype, warn.ind, warn.df, warn.vec)
      sdest.p <- sqrt(temp$varest)
      lbound.p <- pmax(cdfest.p - mult*sdest.p, 0)
      ubound.p <- pmin(cdfest.p + mult*sdest.p, 1)
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df

      cdfest.u <- cdf.total(z, wgt, cdfval, cluster.ind, cluster, wgt1, popsize)
      temp <- cdfvar.total(z, wgt, x, y, cdfval, cdfest.u, stratum.ind, NULL,
         cluster.ind, cluster, wgt1, x1, y1, popsize, pcfactor.ind, pcfsize,
         N.cluster, stage1size, support, vartype, warn.ind, warn.df, warn.vec)
      sdest.u <- sqrt(temp$varest)
      lbound.u <- pmax(cdfest.u - mult*sdest.u, 0)
      if(!is.null(popsize))
         ubound.u <- pmin(cdfest.u + mult*sdest.u, popsize)
      else
         ubound.u <- cdfest.u + mult*sdest.u
      warn.ind <- temp$warn.ind
      warn.df <- temp$warn.df
   }

   rslt <- cbind(cdfval, nresp, 100*cdfest.p, 100*sdest.p, 100*lbound.p,
      100*ubound.p, cdfest.u, sdest.u, lbound.u, ubound.u)
   dimnames(rslt) <- list(1:ncdfval, c("Value", "NResp", "Estimate.P",
      "StdError.P", paste("LCB", conf, "Pct.P", sep=""), paste("UCB", conf,
      "Pct.P", sep=""), "Estimate.U", "StdError.U", paste("LCB", conf, "Pct.U",
      sep=""), paste("UCB", conf, "Pct.U", sep="")))

# Assign results to the data frame for estimates

   Results$CDF <- data.frame(rslt)

# End subsection for CDF estimates

# Begin subsection for percentile estimates

# Create the data frame for percentile estimates

   rslt <- data.frame(array(0, c(npctval, 10)))
   dimnames(rslt) <- list(1:npctval, c("Statistic", "NResp", "Estimate.P",
      "StdError.P", paste("LCB", conf, "Pct.P", sep=""), paste("UCB", conf, "Pct.P",
      sep=""), "Estimate.U", "StdError.U", paste("LCB", conf, "Pct.U", sep=""),
      paste("UCB", conf, "Pct.U", sep="")))
   rslt[,1] <- paste(pctval, "Pct", sep="")
   rslt[,4] <- I(character(npctval))
   rslt[,8] <- I(character(npctval))


# Convert the input percentile values to proportions or to percentage of total,
# as appropriate

   pctval.p <- pctval/100
   if(!is.null(popsize))
      pctval.u <- (pctval/100)*popsize
   else
      pctval.u <- (pctval/100)*popsize.hat

# Determine whether all response values are equal and assign estimates when true

   if(min(z) == max(z)) {
      rslt[,2] <- length(z)
      rslt[,c(3,5,6,7,9,10)] <- max(z)

   } else {

# Calculate percentile estimates

      cdfest.p <- Results$CDF$Estimate.P/100
      cdfest.u <- Results$CDF$Estimate.U
      for(j in 1:npctval) {
         high <- ifelse(length(nvec[cdfest.p >= pctval.p[j]]) > 0,
            min(nvec[cdfest.p >= pctval.p[j]]), NA)
         low <- ifelse(length(nvec[cdfest.p <= pctval.p[j]]) > 0,
            max(nvec[cdfest.p <= pctval.p[j]]), NA)
         if(is.na(high)) {
            rslt[j,3] <- NA
         } else if(is.na(low)) {
            rslt[j,3] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (pctval.p[j] - cdfest.p[low]) / (cdfest.p[high] -
                  cdfest.p[low])
            else
               ival <- 1
            rslt[j,3] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }

         high <- ifelse(length(nvec[cdfest.u >= pctval.u[j]]) > 0,
            min(nvec[cdfest.u >= pctval.u[j]]), NA)
         low <- ifelse(length(nvec[cdfest.u <= pctval.u[j]]) > 0,
            max(nvec[cdfest.u <= pctval.u[j]]), NA)
         if(is.na(high)) {
            rslt[j,7] <- NA
         } else if(is.na(low)) {
            rslt[j,7] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (pctval.u[j] - cdfest.u[low]) / (cdfest.u[high] -
                  cdfest.u[low])
            else
               ival <- 1
            rslt[j,7] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }
      }

# Determine number of response values

      rslt[,2] <- cdf.nresp(z, rslt[,3])

# Calculate confidence bounds of the inverse percentile estimates

      temp.p <- !is.na(rslt[,3])
      sdest.p <- rep(NA, npctval)
      lbound.p <- rep(NA, npctval)
      ubound.p <- rep(NA, npctval)
      temp.u <- !is.na(rslt[,7])
      sdest.u <- rep(NA, npctval)
      lbound.u <- rep(NA, npctval)
      ubound.u <- rep(NA, npctval)
      if(swgt.ind) {
         temp <- cdfvar.size.prop(z, wgt, x, y, rslt[temp.p,3],
            pctval.p[temp.p], stratum.ind, NULL, cluster.ind, cluster, wgt1, x1,
            y1, pcfactor.ind, pcfsize, N.cluster, stage1size, support, swgt,
            swgt1, vartype, warn.ind, warn.df, warn.vec)
         sdest.p[temp.p] <- sqrt(temp$varest)
         lbound.p[temp.p] <- pmax(pctval.p[temp.p] - mult*sdest.p[temp.p], 0)
         ubound.p[temp.p] <- pmin(pctval.p[temp.p] + mult*sdest.p[temp.p], 1)
         warn.ind <- temp$warn.ind
         warn.df <- temp$warn.df

         if(!is.null(popsize)) {
            temp <- cdfvar.size.total(z, wgt, x, y, rslt[temp.u,7],
               pctval.u[temp.u], stratum.ind, NULL, cluster.ind, cluster, wgt1,
               x1, y1, popsize, pcfactor.ind, pcfsize, N.cluster, stage1size,
               support, swgt, swgt1, vartype, warn.ind, warn.df, warn.vec)
            sdest.u[temp.u] <- sqrt(temp$varest)
            ubound.u[temp.u] <- pmin(pctval.u[temp.u] + mult*sdest.u[temp.u],
               popsize)
            warn.ind <- temp$warn.ind
            warn.df <- temp$warn.df
         } else {
            temp <- cdfvar.size.total(z, wgt, x, y, rslt[temp.u,7],
               pctval.u[temp.u], stratum.ind, NULL, cluster.ind, cluster, wgt1,
               x1, y1, popsize, pcfactor.ind, pcfsize, N.cluster, stage1size,
               support, swgt, swgt1, vartype, warn.ind, warn.df, warn.vec)
            sdest.u[temp.u] <- sqrt(temp$varest)
            ubound.u[temp.u] <- pctval.u[temp.u] + mult*sdest.u[temp.u]
            warn.ind <- temp$warn.ind
            warn.df <- temp$warn.df
         }
         lbound.u[temp.u] <- pmax(pctval.u[temp.u] - mult*sdest.u[temp.u], 0)
      } else {
         temp <- cdfvar.prop(z, wgt, x, y, rslt[temp.p,3], pctval.p[temp.p],
            stratum.ind, NULL, cluster.ind, cluster, wgt1, x1, y1, pcfactor.ind,
            pcfsize, N.cluster, stage1size, support, vartype, warn.ind, warn.df,
            warn.vec)
         sdest.p[temp.p] <- sqrt(temp$varest)
         lbound.p[temp.p] <- pmax(pctval.p[temp.p] - mult*sdest.p[temp.p], 0)
         ubound.p[temp.p] <- pmin(pctval.p[temp.p] + mult*sdest.p[temp.p], 1)
         warn.ind <- temp$warn.ind
         warn.df <- temp$warn.df

         if(!is.null(popsize)) {
            temp <- cdfvar.total(z, wgt, x, y, rslt[temp.u,7], pctval.u[temp.u],
               stratum.ind, NULL, cluster.ind, cluster, wgt1, x1, y1, popsize,
               pcfactor.ind, pcfsize, N.cluster, stage1size, support, vartype,
               warn.ind, warn.df, warn.vec)
            sdest.u[temp.u] <- sqrt(temp$varest)
            ubound.u[temp.u] <- pmin(pctval.u[temp.u] + mult*sdest.u[temp.u],
               popsize)
            warn.ind <- temp$warn.ind
            warn.df <- temp$warn.df
         } else {
            temp <- cdfvar.total(z, wgt, x, y, rslt[temp.u,7], pctval.u[temp.u],
               stratum.ind, NULL, cluster.ind, cluster, wgt1, x1, y1, popsize,
               pcfactor.ind, pcfsize, N.cluster, stage1size, support, vartype,
               warn.ind, warn.df, warn.vec)
            sdest.u[temp.u] <- sqrt(temp$varest)
            ubound.u[temp.u] <- pctval.u[temp.u] + mult*sdest.u[temp.u]
            warn.ind <- temp$warn.ind
            warn.df <- temp$warn.df
         }
         lbound.u[temp.u] <- pmax(pctval.u[temp.u] - mult*sdest.u[temp.u], 0)
      }

# Calculate confidence bounds of the percentile estimates

      for(j in 1:npctval) {
         high <- ifelse(length(nvec[cdfest.p >= lbound.p[j]]) > 0,
            min(nvec[cdfest.p >= lbound.p[j]]), NA)
         low <- ifelse(length(nvec[cdfest.p <= lbound.p[j]]) > 0,
            max(nvec[cdfest.p <= lbound.p[j]]), NA)
         if(is.na(high)) {
            rslt[j,5] <- NA
         } else if(is.na(low)) {
            rslt[j,5] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (lbound.p[j] - cdfest.p[low]) / (cdfest.p[high] -
                  cdfest.p[low])
            else
               ival <- 1
            rslt[j,5] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }

         high <- ifelse(length(nvec[cdfest.p >= ubound.p[j]]) > 0,
            min(nvec[cdfest.p >= ubound.p[j]]), NA)
         low <- ifelse(length(nvec[cdfest.p <= ubound.p[j]]) > 0,
            max(nvec[cdfest.p <= ubound.p[j]]), NA)
         if(is.na(high)) {
            rslt[j,6] <- NA
         } else if(is.na(low)) {
            rslt[j,6] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (ubound.p[j] - cdfest.p[low]) / (cdfest.p[high] -
                  cdfest.p[low])
            else
               ival <- 1
            rslt[j,6] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }

         high <- ifelse(length(nvec[cdfest.u >= lbound.u[j]]) > 0,
            min(nvec[cdfest.u >= lbound.u[j]]), NA)
         low <- ifelse(length(nvec[cdfest.u <= lbound.u[j]]) > 0,
            max(nvec[cdfest.u <= lbound.u[j]]), NA)
         if(is.na(high)) {
            rslt[j,9] <- NA
         } else if(is.na(low)) {
            rslt[j,9] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (lbound.u[j] - cdfest.u[low]) / (cdfest.u[high] -
                  cdfest.u[low])
            else
               ival <- 1
            rslt[j,9] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }

         high <- ifelse(length(nvec[cdfest.u >= ubound.u[j]]) > 0,
            min(nvec[cdfest.u >= ubound.u[j]]), NA)
         low <- ifelse(length(nvec[cdfest.u <= ubound.u[j]]) > 0,
            max(nvec[cdfest.u <= ubound.u[j]]), NA)
         if(is.na(high)) {
            rslt[j,10] <- NA
         } else if(is.na(low)) {
            rslt[j,10] <- cdfval[high]
         } else {
            if(high > low)
               ival <- (ubound.u[j] - cdfest.u[low]) / (cdfest.u[high] -
                  cdfest.u[low])
            else
               ival <- 1
            rslt[j,10] <- ival*cdfval[high] + (1-ival)*cdfval[low]
         }
      }
   }

# Assign results to the data frame for estimates

   Results$Pct <- rslt

# End subsection for percentile estimates

# End section for unstratified data

   }

# Depending on whether the function was called directly or was called by
# cont.analysis, return appropriate results

   if(is.na(warn.vec[1])) {

# As necessary, output a message indicating that warning messages were generated
# during execution of the program

      if(warn.ind) {
         warn.df <<- warn.df
         if(nrow(warn.df) == 1)
            cat("During execution of the program, a warning message was generated.  The warning \nmessage is stored in a data frame named 'warn.df'.  Enter the following command \nto view the warning message: warnprnt()\n")
         else
            cat(paste("During execution of the program,", nrow(warn.df), "warning messages were generated.  The warning \nmessages are stored in a data frame named 'warn.df'.  Enter the following \ncommand to view the warning messages: warnprnt() \nTo view a subset of the warning messages (say, messages number 1, 3, and 5), \nenter the following command: warnprnt(m=c(1,3,5))\n"))
      }

# Return the Results data frame

      Results

   } else {

# Return the Results data frame, the warn.ind logical value, and the warn.df
# data frame

      names(Results$Pct)[3:6] <- substr(names(Results$Pct)[3:6], 1,
         nchar(names(Results$Pct)[3:6])-2)
      list(Results=Results, warn.ind=warn.ind, warn.df=warn.df)
   }
}
mhweber/spsurvey documentation built on Sept. 17, 2020, 4:24 a.m.