item_weights.R

library(testthat)
devtools::load_all()

names_to_levels = function(item_names, gt_names) {
  vapply(item_names, function(item_name) {
    sum(grepl(paste0('^', item_name, '_gt[0-9]+$'), gt_names))
  }, integer(1))
}
test_that('names_to_levels recovers number of choices per item given item names', {
  expect_equal(names_to_levels('abortion', 'abortion_gt1'), c('abortion' = 1))
  expect_equal(names_to_levels('abortion', c('abortion_gt1', 'abortion_gt2')),
      c('abortion' = 2))
})

lookup_gt_names = function(item_name, gt_names) {
  gt_names[grepl(paste0('^', item_name, '_gt[0-9]+$'), gt_names)]
}
test_that('given an item name, lookup_gt_names returns its _gt variable names', {
  expect_equal(lookup_gt_names('abortion', c('abortion_gt1', 'foo')),
    'abortion_gt1')
})


add_item_weights = function(item_data, item_names) {
  # Add a variable counting non-missing item responses
  item_data[, c("n_item_responses") := list(rowSums(!is.na(.SD))), .SDcols = item_names]
  n_levels = names_to_levels(item_names, names(item_data))
  # Iterate over the _gt variables
  for (item_name in item_names) {
    for (gt_item in lookup_gt_names(item_name, names(item_data))) {
      # Create for each _gt variable a _gt_weight variable indicating the weight
      # given the item response
      item_data[, paste0(gt_item, '_weight') := 1 /
        # Divide by number of item levels
        n_levels[item_name] /
        # Divide by number of non-missing item responses
        n_item_responses]
      item_data[, paste0(gt_item, '_weighted') := list(get(gt_item) *
        get(paste0(gt_item, '_weight')))]
    }
  }
  item_data[]
}

test_that('adding item weights works as expected with a single item', {
  # Create minimal test data
  item_data = data.table::data.table(
      abortion = c(0, 0, 1, 1, 1, 1),
      affirmative_action = c(2, 1, 0, 1, 1, 2))
  item_data[, abortion_gt1 := as.integer(abortion > 0)]
  item_data[, affirmative_action_gt1 := as.integer(affirmative_action > 0)]
  item_data[, affirmative_action_gt2 := as.integer(affirmative_action > 1)]
  single_item = add_item_weights(item_data, item_names = 'abortion')
  expect_true('abortion_gt1_weight' %in% names(single_item))
  expect_true('abortion_gt1_weighted' %in% names(single_item))
  expect_true('n_item_responses' %in% names(single_item))
  expect_equal(single_item$abortion_gt1_weighted,
    single_item$abortion_gt1 * single_item$abortion_gt1_weight)
  expect_equal(single_item$n_item_responses, rep(1, 6))
  expect_equal(single_item$abortion_gt1_weight, rep(1, 6))
})

test_that('adding item weights works as expected with multiple items', {
  ## Create minimal test data
  item_data = data.table::data.table(
      abortion = c(0, 0, 1, 1, 1, 1),
      affirmative_action = c(2, 1, 0, 1, 1, 2))
  item_data[, abortion_gt1 := as.integer(abortion > 0)]
  item_data[, affirmative_action_gt1 := as.integer(affirmative_action > 0)]
  item_data[, affirmative_action_gt2 := as.integer(affirmative_action > 1)]
  two_items = add_item_weights(item_data, item_names = c('abortion',
      'affirmative_action'))
  expect_true('abortion_gt1_weight' %in% names(two_items))
  expect_true('affirmative_action_gt1_weight' %in% names(two_items))
  expect_true('affirmative_action_gt2_weight' %in% names(two_items))
  expect_true('n_item_responses' %in% names(two_items))
  expect_equal(two_items$n_item_responses, rep(2, 6))
  expect_equal(two_items$abortion_gt1_weight, rep(0.5, 6))
  expect_equal(two_items$affirmative_action_gt1_weight, rep(0.25, 6))
  expect_equal(two_items$affirmative_action_gt2_weight, rep(0.25, 6))
  expect_equal(two_items$abortion_gt1_weighted,
    two_items$abortion_gt1 * two_items$abortion_gt1_weight)
  expect_equal(two_items$affirmative_action_gt1_weighted,
    two_items$affirmative_action_gt1 * two_items$affirmative_action_gt1_weight)
  expect_equal(two_items$affirmative_action_gt2_weighted,
    two_items$affirmative_action_gt2 * two_items$affirmative_action_gt2_weight)
})

test_that('adding item weights works as expected with missingness', {
  ## Create minimal test data
  item_data = data.table::data.table(
      abortion = c(NA, 0, 1, 1, 1, 1),
      affirmative_action = c(2, 1, NA, 1, 1, 2))
  item_data[, abortion_gt1 := as.integer(abortion > 0)]
  item_data[, affirmative_action_gt1 := as.integer(affirmative_action > 0)]
  item_data[, affirmative_action_gt2 := as.integer(affirmative_action > 1)]
  two_items = add_item_weights(item_data, item_names = c('abortion',
      'affirmative_action'))
  expect_true('abortion_gt1_weight' %in% names(two_items))
  expect_true('affirmative_action_gt1_weight' %in% names(two_items))
  expect_true('affirmative_action_gt2_weight' %in% names(two_items))
  expect_true('n_item_responses' %in% names(two_items))
  expect_equal(two_items$n_item_responses, c(1, 2, 1, 2, 2, 2))
  expect_equal(two_items$abortion_gt1_weight, c(1, .5, 1, .5, .5, .5))
  expect_equal(two_items$affirmative_action_gt1_weight, c(.5, .25, .5, rep(.25, 3)))
  expect_equal(two_items$affirmative_action_gt2_weight, c(.5, .25, .5, rep(.25, 3)))
  expect_equal(two_items$abortion_gt1_weighted,
    two_items$abortion_gt1 * two_items$abortion_gt1_weight)
  expect_equal(two_items$affirmative_action_gt1_weighted,
    two_items$affirmative_action_gt1 * two_items$affirmative_action_gt1_weight)
  expect_equal(two_items$affirmative_action_gt2_weighted,
    two_items$affirmative_action_gt2 * two_items$affirmative_action_gt2_weight)
})