tests/testthat/test-svyatk.R

In DjalmaPessoa/convey: Income Concentration Analysis with Complex Survey Samples

context("Atk output")

skip_on_cran()


# function from the IC2 library 1.0-1
# removed from CRAN but available at
# https://cran.r-project.org/src/contrib/Archive/IC2/
IC2_calcAtkinson <- function(x, w = NULL, epsilon = 1)
{
  if (epsilon < 0)
    return(NULL)
  if (!is.numeric(x))
    return(NULL)
  xNA <- sum(as.numeric(is.na(x)))
  weighted <- FALSE
  wNA <- NULL
  if (is.null(w))
    w <- rep(1, length(x))
  else
  {
    if (!is.numeric(w))
      return(NULL)
    weighted <- TRUE
    wNA <- sum(as.numeric(is.na(w)))
  }
  df <- cbind("x" = x, "w" = w)
  df <- df[complete.cases(df), , drop = FALSE]
  if (nrow(df) == 0)
    return (NULL)
  if (any(df[, "x"] < 0) || sum(df[, "x"]) == 0)
    return(NULL)
  if (any(df[, "x"] == 0) && epsilon == 1)
    return(NULL)
  index <- 0
  names(index) <- "Atk"
  names(epsilon) <- "epsilon"
  Atk <- list(
    ineq =   list(index = index,
                  parameter = epsilon),
    nas =    list(
      xNA = xNA,
      wNA = wNA,
      totalNA = length(x) - nrow(df)
    )
  )
  class(Atk) <- "ICI"
  if (nrow(df) == 1)
    return(Atk)
  if (epsilon == 1)
  {
    w <- df[, "w"] / sum(df[, "w"])
    xMean <- weighted.mean(df[, "x"], w)
    index <- 1 - (prod(exp(w * log(df[, "x"]))) / xMean)
  }
  else
  {
    xMean <- weighted.mean(df[, "x"], df[, "w"])
    x1 <- df[, "x"] / xMean
    w <- df[, "w"] / sum(df[, "w"])
    param <- 1 - epsilon
    index <- 1 - (weighted.mean((x1 ^ param), w) ^ (1 / param))
  }
  names(index) <- "Atk"
  Atk[["ineq"]][["index"]] <- index
  return(Atk)
}








library(survey)
library(laeken)
data(eusilc)
dati = data.frame(IDd = seq(10000 , 10000 + nrow(eusilc) - 1) , eusilc)
dati_nz <- subset(dati, eqIncome > 0)

des_eusilc <-
  svydesign(
    ids = ~ rb030,
    strata =  ~ db040,
    weights = ~ rb050,
    data = eusilc
  )

des_eusilc <- convey_prep(des_eusilc)
convey_atk <- svyatk( ~ eqIncome, subset(des_eusilc, eqIncome > 0))

IC2_atk <-
  IC2_calcAtkinson(x = dati_nz$eqIncome, w = dati_nz$rb050)$ineq$index

# point estiamte
vardest <- as.numeric(IC2_atk)
convest <- as.numeric(coef(convey_atk)[1])
#domain
# IC2 point estimates
vardestd <-
  sapply(split(dati_nz, dati_nz$hsize), function(x) {
    IC2_calcAtkinson(x = x$eqIncome, w = x$rb050)$ineq$index[[1]]
  })
vardestd <- as.numeric(vardestd)

# convey point estimates
convestd <-
  as.numeric(coef(svyby(
    ~ eqIncome,
    ~ factor(hsize),
    subset(des_eusilc, eqIncome > 0),
    svyatk
  )))

test_that("compare results convey vs vardpoor", {
  expect_equal(vardest, convest)
  expect_equal(vardestd, convestd)
})