inst/doc/linear_weighting.R

In mcmcsae: Markov Chain Monte Carlo Small Area Estimation

## ----echo=FALSE-----------------------------------------------------------------------------------
options(width=100)  # width of output

## ----message=FALSE--------------------------------------------------------------------------------
library(survey)
data(api)
# define the regression model
model <- api00 ~ ell + meals + stype + hsg + col.grad + grad.sch
# compute corresponding population totals
XpopT <- colSums(model.matrix(model, apipop))
N <- XpopT[["(Intercept)"]]  # population size
# create the survey design object
des <- svydesign(ids=~1, data=apisrs, weights=~pw, fpc=~fpc)
# compute the calibration or GREG estimator
cal <- calibrate(des, formula=model, population=XpopT)
svymean(~ api00, des)  # equally weighted estimate
svymean(~ api00, cal)  # GREG estimate

## -------------------------------------------------------------------------------------------------
mean(apipop$api00)

## ----message=FALSE--------------------------------------------------------------------------------
library(mcmcsae)
set.seed(1)
sampler <- create_sampler(model, data=apisrs)
sim <- MCMCsim(sampler, verbose=FALSE)
(summ <- summary(sim))
compute_DIC(sim)

## -------------------------------------------------------------------------------------------------
m <- match(apisrs$cds, apipop$cds)  # population units in the sample
# use only a sample of 250 draws from each chain
predictions <- predict(sim, newdata=apipop[-m, ], iters=sample(1:1000, 250), show.progress=FALSE)
str(predictions)
samplesum <- sum(apisrs$api00)
summary(transform_dc(predictions, fun = function(x) (samplesum + sum(x))/N))

## -------------------------------------------------------------------------------------------------
summary(predict(sim, newdata=apipop[-m, ], fun=function(x, p) (samplesum + sum(x))/N,
                show.progress=FALSE)
)

## -------------------------------------------------------------------------------------------------
n <- nrow(apisrs)
XsamT <- colSums(model.matrix(model, apisrs))
XpopR <- matrix(XpopT - XsamT, nrow=1)
predictions <- predict(sim, X=list(reg1=XpopR), var=N-n, fun=function(x, p) (samplesum + x)/N,
                       show.progress=FALSE)
summary(predictions)

## ----fig.width=4, fig.height=4, fig.align="center"------------------------------------------------
sampler <- create_sampler(model, data=apisrs,
                          linpred=list(reg1=matrix(XpopT/N, nrow=1)),
                          compute.weights=TRUE)
sim <- MCMCsim(sampler, verbose=FALSE)
plot(weights(cal)/N, weights(sim)); abline(0, 1)
sum(weights(sim) * apisrs$api00)
print(summary(sim, "linpred_"), digits=6)

## ----fig.width=4, fig.height=4, fig.align="center", message=FALSE---------------------------------
sampler <- create_sampler(model, formula.V=~vfac(prior=pr_invchisq(df="modeled")),
                          linpred=list(reg1=matrix(XpopR/N, nrow=1)),
                          data=apisrs, compute.weights=TRUE)
sim <- MCMCsim(sampler, burnin=1000, n.iter=5000, thin=2, verbose=FALSE)
(summ <- summary(sim))
plot(sim, "vfac1_df")
acceptance_rates(sim)
compute_DIC(sim)
predictions <- predict(sim, newdata=apipop[-m, ], show.progress=FALSE,
                       fun=function(x, p) (samplesum + sum(x))/N)
summary(predictions)
plot(weights(cal)/N, weights(sim)); abline(0, 1)
summary(get_means(sim, "Q_")[["Q_"]])