library(lme4)
library(Matrix)
### Prediction of the subpopulation mean based on the cross-sectional data
data(invData)
# data from one period are considered:
invData2018 <- invData[invData$year == 2018,]
attach(invData2018)
N <- nrow(invData2018) # population size
n <- 100 # sample size
# subpopulation of interest: NUTS4type==2
Nd <- sum(NUTS4type == 2) # subpopulation size
set.seed(123456)
sampled_elements <- sample(N,n)
con <- rep(0,N)
con[sampled_elements] <- 1 # elements in the sample
YS <- investments[sampled_elements]
fixed.part <- 'newly_registered'
random.part <- '(1| NUTS2)'
reg = invData2018[, -which(names(invData2018) == 'investments')]
gamma <- rep(0,N)
gamma[NUTS4type == 2] <- 1/Nd
weights <- rep(1,N) # homoscedastic random components
estMSE <- TRUE
# Predicted value of the mean in the following subpopulation: NUTS4type==2
EBLUP(YS, fixed.part, random.part, reg, con, gamma, weights, estMSE)$thetaP
# All results
EBLUP(YS, fixed.part, random.part, reg, con, gamma, weights, estMSE)
detach(invData2018)
##########################################################
### Prediction of the subpopulation total based on the longitudinal data
data(invData)
attach(invData)
N <- nrow(invData[(year == 2013),]) # population size in the first period
n <- 38 # sample size in the first period
# subpopulation and time period of interest: NUTS2 == '02' & year == 2018
# subpopulation size in the period of interest:
Ndt <- sum(NUTS2 == '02' & year == 2018)
set.seed(123456)
sampled_elements_in_2013 <- sample(N,n)
con2013 <- rep(0,N)
con2013[sampled_elements_in_2013] <- 1 # elements in the sample in 2013
# balanced panel sample - the same elements in all 6 periods:
con <- rep(con2013,6)
YS <- investments[con == 1]
fixed.part <- 'newly_registered'
random.part <- '(newly_registered | NUTS4)'
reg <- invData[, -which(names(invData) == 'investments')]
gamma <- rep(0,nrow(invData))
gamma[NUTS2 == '02' & year == 2018] <- 1
weights <- rep(1,nrow(invData)) # homoscedastic random components
estMSE <- TRUE
# Predicted value of the total
# in the following subpopulation: NUTS4type == 2
# in the following time period: year == 2018
EBLUP(YS, fixed.part, random.part, reg, con, gamma, weights, estMSE)$thetaP
# All results
EBLUP(YS, fixed.part, random.part, reg, con, gamma, weights, estMSE)
detach(invData)
Run the code above in your browser using DataLab