# Direct Standardization

## Introduction

Consider a set of observations $$(x_i,y_i)$$ drawn non-uniformly from an unknown distribution. We know the expected value of the columns of $$X$$, denoted by $$b \in {\mathbf R}^n$$, and want to estimate the true distribution of $$y$$. This situation may arise, for instance, if we wish to analyze the health of a population based on a sample skewed toward young males, knowing the average population-level sex, age, etc. The empirical distribution that places equal probability $$1/m$$ on each $$y_i$$ is not a good estimate.

So, we must determine the weights $$w \in {\mathbf R}^m$$ of a weighted empirical distribution, $$y = y_i$$ with probability $$w_i$$, which rectifies the skewness of the sample . We can pose this problem as

$\begin{array}{ll} \underset{w}{\mbox{maximize}} & \sum_{i=1}^m -w_i\log w_i \\ \mbox{subject to} & w \geq 0, \quad \sum_{i=1}^m w_i = 1,\quad X^Tw = b. \end{array}$

Our objective is the total entropy, which is concave on $${\mathbf R}_+^m$$, and our constraints ensure $$w$$ is a probability distribution that implies our known expectations on $$X$$.

To illustrate this method, we generate $$m = 1000$$ data points $$x_{i,1} \sim \mbox{Bernoulli}(0.5)$$, $$x_{i,2} \sim \mbox{Uniform}(10,60)$$, and $$y_i \sim N(5x_{i,1} + 0.1x_{i,2},1)$$. Then we construct a skewed sample of $$m = 100$$ points that overrepresent small values of $$y_i$$, thus biasing its distribution downwards. This can be seen in Figure $$\ref{fig:direct-std}$$, where the sample probability distribution peaks around $$y = 2.0$$, and its cumulative distribution is shifted left from the populationâ€™s curve. Using direct standardization, we estimate $$w_i$$ and reweight our sample; the new empirical distribution cleaves much closer to the true distribution shown in red.

In the CVXR code below, we import data from the package and solve for $$w$$.

## Import problem data
data(dspop)   # Population
data(dssamp)  # Skewed sample

ypop <- dspop[,1]
Xpop <- dspop[,-1]
y <- dssamp[,1]
X <- dssamp[,-1]
m <- nrow(X)

## Given population mean of features
b <- as.matrix(apply(Xpop, 2, mean))

## Construct the direct standardization problem
w <- Variable(m)
objective <- sum(entr(w))
constraints <- list(w >= 0, sum(w) == 1, t(X) %*% w == b)
prob <- Problem(Maximize(objective), constraints)

## Solve for the distribution weights
result <- solve(prob)
weights <- result$getValue(w) result$value
## [1] 4.223305

We can plot the density functions using linear approximations for the range of $$y$$.

## Plot probability density functions
dens1 <- density(ypop)
dens2 <- density(y)
dens3 <- density(y, weights = weights)
yrange <- seq(-3, 15, 0.01)
d <- data.frame(x = yrange,
True = approx(x = dens1$x, y = dens1$y, xout = yrange)$y, Sample = approx(x = dens2$x, y = dens2$y, xout = yrange)$y,
Weighted = approx(x = dens3$x, y = dens3$y, xout = yrange)\$y)
plot.data <- gather(data = d, key = "Type", value = "Estimate", True, Sample, Weighted,
factor_key = TRUE)
ggplot(plot.data) +
geom_line(mapping = aes(x = x, y = Estimate, color = Type)) +
theme(legend.position = "top")
## Warning: Removed 300 row(s) containing missing values (geom_path).

Followed by the cumulative distribution function.

## Return the cumulative distribution function
get_cdf <- function(data, probs, color = 'k') {
if(missing(probs))
probs <- rep(1.0/length(data), length(data))
distro <- cbind(data, probs)
dsort <- distro[order(distro[,1]),]
ecdf <- base::cumsum(dsort[,2])
cbind(dsort[,1], ecdf)
}

## Plot cumulative distribution functions
d1 <- data.frame("True", get_cdf(ypop))
d2 <- data.frame("Sample", get_cdf(y))
d3 <- data.frame("Weighted", get_cdf(y, weights))

names(d1) <- names(d2) <- names(d3) <- c("Type", "x", "Estimate")
plot.data <- rbind(d1, d2, d3)

ggplot(plot.data) +
geom_line(mapping = aes(x = x, y = Estimate, color = Type)) +
theme(legend.position = "top")

## Session Info

sessionInfo()
## R version 4.2.1 (2022-06-23)
## Platform: x86_64-apple-darwin21.6.0 (64-bit)
## Running under: macOS Ventura 13.0
##
## Matrix products: default
## BLAS:   /usr/local/Cellar/openblas/0.3.21/lib/libopenblasp-r0.3.21.dylib
## LAPACK: /usr/local/Cellar/r/4.2.1_4/lib/R/lib/libRlapack.dylib
##
## locale:
## [1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8
##
## attached base packages:
## [1] stats     graphics  grDevices datasets  utils     methods   base
##
## other attached packages:
## [1] tidyr_1.2.1   ggplot2_3.3.6 CVXR_1.0-11
##
## loaded via a namespace (and not attached):
##  [1] tidyselect_1.2.0 xfun_0.34        bslib_0.4.0      slam_0.1-50
##  [5] purrr_0.3.5      lattice_0.20-45  Rmosek_10.0.25   colorspace_2.0-3
##  [9] vctrs_0.5.0      generics_0.1.3   htmltools_0.5.3  yaml_2.3.6
## [13] gmp_0.6-6        utf8_1.2.2       rlang_1.0.6      jquerylib_0.1.4
## [17] pillar_1.8.1     glue_1.6.2       Rmpfr_0.8-9      withr_2.5.0
## [21] DBI_1.1.3        Rcplex_0.3-5     bit64_4.0.5      lifecycle_1.0.3
## [25] stringr_1.4.1    munsell_0.5.0    blogdown_1.13    gtable_0.3.1
## [29] gurobi_9.5-2     codetools_0.2-18 evaluate_0.17    labeling_0.4.2
## [33] knitr_1.40       fastmap_1.1.0    cccp_0.2-9       fansi_1.0.3
## [37] highr_0.9        Rcpp_1.0.9       scales_1.2.1     cachem_1.0.6
## [41] jsonlite_1.8.3   farver_2.1.1     bit_4.0.4        digest_0.6.30
## [45] stringi_1.7.8    bookdown_0.29    dplyr_1.0.10     Rglpk_0.6-4
## [49] grid_4.2.1       ECOSolveR_0.5.4  cli_3.4.1        tools_4.2.1
## [53] magrittr_2.0.3   sass_0.4.2       tibble_3.1.8     pkgconfig_2.0.3
## [57] ellipsis_0.3.2   rcbc_0.1.0.9001  Matrix_1.5-1     assertthat_0.2.1
## [61] rmarkdown_2.17   R6_2.5.1         compiler_4.2.1

R Markdown

## References

Fleiss, J. L., B. Levin, and M. C. Paik. 2003. Statistical Methods for Rates and Proportions. Wiley-Interscience.