tests/testthat/test-svyrmpg.R

In convey: Income Concentration Analysis with Complex Survey Samples

context("Rmpg output")

skip_on_cran()

library(laeken)
library(survey)
library(vardpoor)
data(eusilc) ; names( eusilc ) <- tolower( names( eusilc ) )
dati = data.frame(IDd = seq( 10000 , 10000 + nrow( eusilc ) - 1 ) , eusilc)

SE_lin2 <- function(t,des){
  variance<-survey::svyrecvar(t/des$prob, des$cluster,des$strata, des$fpc,postStrata = des$postStrata)
  sqrt(variance)
}
des_eusilc <- svydesign(ids = ~rb030, strata =~db040,  weights = ~rb050, data = eusilc)

des_eusilc <- convey_prep(des_eusilc)

vardpoor_linrmpgw <- linrmpg(Y="eqincome", id="IDd", weight = "rb050", Dom=NULL,
  dataset=dati, percentage=60, order_quant=50L)
vardest<- vardpoor_linrmpgw$value
attributes(vardest)<- NULL
vardest<- unlist(vardest)
varse<- SE_lin2(vardpoor_linrmpgw$lin$lin_rmpg, des_eusilc)
attributes(varse)<- NULL
fun_svyrmpgw <- svyrmpg(~eqincome, design = des_eusilc, 0.5, 0.6)
convest<-coef(fun_svyrmpgw)
attributes(convest)<-NULL
convse<- SE(fun_svyrmpgw)
attributes(convse)<-NULL
#domain
vardpoor_rmpgd <- linrmpg(Y = "eqincome", id = "IDd", weight = "rb050", Dom = c("hsize"),    dataset = dati)
#  point estimates
vardestd<-unlist(vardpoor_rmpgd$value$rmpg)
#  se estimates
varsed<-sapply(data.frame(vardpoor_rmpgd$lin)[,2:10],function(t) SE_lin2(t,des_eusilc))
attributes (varsed) <- NULL
# library convey

fun_rmpgd <- svyby(~eqincome, by = ~hsize, design = subset(des_eusilc,hsize<8),
FUN = svyrmpg, deff = FALSE)

convestd<- coef(fun_rmpgd)
attributes(convestd) <- NULL
convsed<- SE(fun_rmpgd)



test_that("compare results convey vs vardpoor",{
  expect_equal(vardest,100*convest)
  expect_equal(varse, 100*convse)
  expect_equal(vardestd[1:7], 100*convestd)
  expect_equal(vardestd[8:9], as.numeric(c(NA,NA)))
  expect_equal(varsed[8:9], c(0,0) )
  skip('different arpr se')
  expect_equal(varsed[1:7], 100*convsed )
})