library(lme4)
library(Matrix)
### Prediction of the subpopulation median
### and the subpopulation standard deviation
### 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
set.seed(123456)
sampled_elements <- sample(N,n)
con <- rep(0,N)
con[sampled_elements] <- 1 # elements in the sample
YS <- log(investments[sampled_elements]) # log-transformed values
backTrans <- function(x) exp(x) # back-transformation of the variable of interest
fixed.part <- 'log(newly_registered)'
random.part <- '(log(newly_registered) | NUTS2)'
reg <- invData2018[, -which(names(invData2018) == 'investments')]
weights <- rep(1,N) # homoscedastic random components
# Characteristics to be predicted - the median and the standard deviation
# in following subpopulation: NUTS4type == 2
thetaFun <- function(x) {c(median(x[NUTS4type == 2]),sd(x[NUTS4type == 2]))}
# Predicted values of the median and the standard deviation
# in the following subpopulation: NUTS4type == 2
plugInLMM(YS, fixed.part, random.part, reg, con, weights, backTrans, thetaFun)$thetaP
plugInLMM(YS, fixed.part, random.part, reg, con, weights, backTrans, thetaFun)
# All results
str(plugInLMM(YS, fixed.part, random.part, reg, con, weights, backTrans, thetaFun))
detach(invData2018)
##########################################################
### Prediction of the subpopulation quartiles based on 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
Ndt=sum(NUTS2=='02' & year==2018) # subpopulation size in the period of interest
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 <- log(investments[con == 1]) # log-transformed values
backTrans <- function(x) exp(x) # back-transformation of the variable of interest
fixed.part <- 'log(newly_registered)'
random.part <- '(0 + log(newly_registered) | NUTS4)'
reg <- invData[, -which(names(invData) == 'investments')]
weights <- rep(1,nrow(invData)) # homoscedastic random components
# Characteristics to be predicted - quartiles in 2018
# in the following subpopulation: NUTS4type == 2
thetaFun <- function(x) {quantile(x[NUTS2 == '02' & year == 2018],probs = c(0.25,0.5,0.75))}
# Predicted values of quartiles
# in the following subpopulation: NUTS4type == 2
# in the following time period: year == 2018
plugInLMM(YS, fixed.part, random.part, reg, con, weights, backTrans, thetaFun)$thetaP
plugInLMM(YS, fixed.part, random.part, reg, con, weights, backTrans, thetaFun)
# All results
str(plugInLMM(YS, fixed.part, random.part, reg, con, weights, backTrans, thetaFun))
detach(invData)
Run the code above in your browser using DataLab