context("test treatment for variables with missings") # load libraries library( survey ) library( convey ) library( laeken ) library( testthat ) # collect and format data data( eusilc ) names( eusilc ) <- tolower( names( eusilc ) ) # set up survey design objects des_eusilc <- svydesign( ids = ~rb030 , strata = ~db040 , weights = ~rb050 , data = eusilc ) des_eusilc_rep <-as.svrepdesign( des_eusilc , type= "bootstrap" , replicates = 50 ) # prepare for convey des_eusilc <- convey_prep( des_eusilc ) des_eusilc_rep <- convey_prep( des_eusilc_rep ) # # only striclty positive incomes # test_that( "error on income <= 0 " , expect_error( svygei( ~eqincome , des_eusilc , epsilon = .5 ) ) ) # filter positive des_eusilc <- subset( des_eusilc , py010n > 0 | is.na( py010n ) ) des_eusilc_rep <- subset( des_eusilc_rep , py010n > 0 | is.na( py010n ) ) # test for missing # make initial object out <- NULL # cycle through single-valued functions for( this_fun in c( "svyjdivdec" , "svygeidec" , "svyfgtdec" , "svyrmpg" , "svygei" , "svygpg" , "svyatk" , "svyqsr" , "svypoormed" , "svyrmir" , "svyisq" , "svyiqalpha" , "svyarpr" , "svyarpt" , "svyfgt" , "svygini" , "svyjdiv" , "svylorenz" , "svyrich" , "svywatts" , "svywattsdec" , "svyzenga" ) ){ # test across functions test_that( paste( "coef and SE matrix must return missing:" , this_fun ) , { # get function object final_fun <- FUN <- get( this_fun ) # set up arguments if( identical( FUN , svyrmpg ) ) final_fun <- function( ... ) FUN( ... , thresh = TRUE ) if( identical( FUN , svyrmir ) ) final_fun <- function( ... ) FUN( ... , age = ~ age , med_old = TRUE ) if( identical( FUN , svyisq ) ) final_fun <- function( ... ) FUN( ... , alpha = 0.2 ) if( identical( FUN , svyiqalpha ) ) final_fun <- function( ... ) FUN( ... , alpha = 0.5 ) if( identical( FUN , svywatts ) ) final_fun <- function( ... ) FUN( ... , abs_thresh = 10000 ) if( identical( FUN , svywattsdec ) ) final_fun <- function( ... ) FUN( ... , abs_thresh = 10000 ) if( identical( FUN , svyfgt ) ) final_fun <- function( ... ) FUN( ... , g = 0 , abs_thresh = 10000 ) if( identical( FUN , svyfgtdec ) ) final_fun <- function( ... ) FUN( ... , g = 2 , abs_thresh = 10000 ) if( identical( FUN , svyrich ) ) final_fun <- function( ... ) FUN( ... , type_measure = "FGTT1" , g = 1 , abs_thresh = 10000 ) if( identical( FUN , svygpg ) ) final_fun <- function( ... ) FUN( ... , sex = ~ rb090 ) if( identical( FUN , svygei ) ) final_fun <- function( ... ) FUN( ... , epsilon = 0.5 ) if( identical( FUN , svygeidec ) ) final_fun <- function( ... ) FUN( ... , subgroup = ~ rb090 ) if( identical( FUN , svyjdivdec ) ) final_fun <- function( ... ) FUN( ... , subgroup = ~ rb090 ) # evaluate function with missing # (these must return a missing value) est_lin <- final_fun( ~ py010n , des_eusilc ) est_rep <- final_fun( ~ py010n , des_eusilc_rep ) # evaluate function with missing # (these must return a missing value) est_lin_narm <- final_fun( ~ py010n , des_eusilc , na.rm = TRUE ) est_rep_narm <- final_fun( ~ py010n , des_eusilc_rep , na.rm = TRUE ) # test result in variable with missing expect_true( all( is.na( coef( est_lin ) ) ) ) expect_true( all( is.na( SE( est_lin ) ) ) ) expect_true( all( is.na( coef( est_rep ) ) ) ) expect_true( all( is.na( SE( est_rep ) ) ) ) # test result in variable with na.rm expect_true( all( !is.na( coef( est_lin_narm ) ) ) ) expect_true( all( !is.na( SE( est_lin_narm ) ) ) ) expect_true( all( !is.na( coef( est_rep_narm ) ) ) ) expect_true( all( !is.na( SE( est_rep_narm ) ) ) ) } ) }