tests/testthat/test-pivot-demand-data.R

In beezdemand: Behavioral Economic Easy Demand

test_that("apt roundtrip: long -> wide -> long preserves data", {
  data(apt, package = "beezdemand")

  wide <- pivot_demand_data(apt, format = "wide")
  long <- pivot_demand_data(wide, format = "long")

  # Sort both for comparison
  apt_sorted <- apt[order(apt$id, apt$x), ]
  long_sorted <- long[order(long$id, long$x), ]

  expect_equal(nrow(apt_sorted), nrow(long_sorted))
  expect_equal(apt_sorted$id, long_sorted$id)
  expect_equal(apt_sorted$x, long_sorted$x)
  expect_equal(apt_sorted$y, long_sorted$y)
})

test_that("ko roundtrip: extra columns preserved through wide -> long", {
  data(ko, package = "beezdemand")

  # Drop y_ll4 (derived column that varies per observation, breaks wide pivot)
  ko_sub <- ko[, c("monkey", "x", "y", "drug", "dose")]

  wide <- pivot_demand_data(ko_sub, format = "wide",
                            id_var = "monkey", x_var = "x", y_var = "y")
  # monkey gets renamed to id on the way back
  long <- pivot_demand_data(wide, format = "long", id_var = "monkey")

  # Extra columns should be preserved
  expect_true("drug" %in% names(long))
  expect_true("dose" %in% names(long))

  # Sort both for comparison (monkey -> id in long output)
  ko_sorted <- ko_sub[order(ko_sub$monkey, ko_sub$drug, ko_sub$dose, ko_sub$x), ]
  long_sorted <- long[order(long$id, long$drug, long$dose, long$x), ]

  expect_equal(nrow(ko_sorted), nrow(long_sorted))
  expect_equal(ko_sorted$x, long_sorted$x)
  expect_equal(ko_sorted$y, long_sorted$y)
})

test_that("etm roundtrip: target and group columns preserved", {
  data(etm, package = "beezdemand")

  wide <- pivot_demand_data(etm, format = "wide")
  long <- pivot_demand_data(wide, format = "long")

  expect_true("target" %in% names(long))
  expect_true("group" %in% names(long))

  # Sort and compare
  etm_sorted <- etm[order(etm$id, etm$target, etm$group, etm$x), ]
  long_sorted <- long[order(long$id, long$target, long$group, long$x), ]

  expect_equal(nrow(etm_sorted), nrow(long_sorted))
  expect_equal(etm_sorted$x, long_sorted$x)
  expect_equal(etm_sorted$y, long_sorted$y)
})

test_that("numeric column names auto-parse correctly", {
  wide <- data.frame(
    id = 1:3,
    "0" = c(10, 8, 12),
    "0.5" = c(9, 7, 11),
    "1" = c(8, 6, 9),
    check.names = FALSE
  )

  long <- pivot_demand_data(wide, format = "long")

  expect_equal(sort(unique(long$x)), c(0, 0.5, 1))
  expect_equal(nrow(long), 9)
  expect_true(is.numeric(long$x))
  expect_true(is.numeric(long$y))
})

test_that("shinybeez-style wide: extra id column auto-detected", {
  wide <- data.frame(
    id = c(1, 1, 2, 2),
    group = c("A", "B", "A", "B"),
    "0" = c(10, 8, 12, 9),
    "0.25" = c(9, 7, 11, 8),
    "0.5" = c(8, 6, 9, 7),
    check.names = FALSE
  )

  long <- pivot_demand_data(wide, format = "long")

  expect_true("group" %in% names(long))
  expect_equal(sort(unique(long$x)), c(0, 0.25, 0.5))
  # 4 rows * 3 prices = 12

  expect_equal(nrow(long), 12)
})

test_that("non-parseable column names error without x_values", {
  wide <- data.frame(
    id = 1:2,
    price_1 = c(10, 8),
    price_2 = c(5, 4),
    price_3 = c(3, 2)
  )

  expect_error(
    pivot_demand_data(wide, format = "long"),
    "Cannot parse prices from column names"
  )
})

test_that("x_values override works with non-numeric column names", {
  wide <- data.frame(
    id = 1:2,
    price_1 = c(10, 8),
    price_2 = c(5, 4),
    price_3 = c(3, 2)
  )

  long <- pivot_demand_data(wide, format = "long",
                            x_values = c(0, 0.5, 1))

  expect_equal(sort(unique(long$x)), c(0, 0.5, 1))
  expect_equal(nrow(long), 6)
})

test_that("NA handling: drop_na = TRUE warns and drops", {
  wide <- data.frame(
    id = 1:2,
    "0" = c(10, NA),
    "1" = c(5, 4),
    check.names = FALSE
  )

  expect_warning(
    long <- pivot_demand_data(wide, format = "long", drop_na = TRUE),
    "Dropped 1 rows with NA"
  )
  expect_equal(nrow(long), 3)
  expect_false(any(is.na(long$y)))
})

test_that("NA handling: drop_na = FALSE warns but retains", {
  wide <- data.frame(
    id = 1:2,
    "0" = c(10, NA),
    "1" = c(5, 4),
    check.names = FALSE
  )

  expect_warning(
    long <- pivot_demand_data(wide, format = "long", drop_na = FALSE),
    "1 rows have NA"
  )
  expect_equal(nrow(long), 4)
  expect_true(any(is.na(long$y)))
})

test_that("mismatched x_values length errors", {
  wide <- data.frame(
    id = 1:2,
    price_1 = c(10, 8),
    price_2 = c(5, 4)
  )

  expect_error(
    pivot_demand_data(wide, format = "long",
                      x_values = c(0, 0.5, 1)),
    "Length of x_values"
  )
})

test_that("format = 'wide' works with custom column names", {
  long <- data.frame(
    subject = c(1, 1, 2, 2),
    price = c(0, 1, 0, 1),
    consumption = c(10, 5, 8, 4)
  )

  wide <- pivot_demand_data(long, format = "wide",
                            id_var = "subject",
                            x_var = "price",
                            y_var = "consumption")

  expect_equal(nrow(wide), 2)
  expect_true("0" %in% names(wide))
  expect_true("1" %in% names(wide))
})

test_that("missing id_var column gives clear error", {
  wide <- data.frame(
    subject = 1:2,
    "0" = c(10, 8),
    "1" = c(5, 4),
    check.names = FALSE
  )

  expect_error(
    pivot_demand_data(wide, format = "long"),
    "Column 'id' not found"
  )
})

test_that("missing columns in format = 'wide' gives clear error", {
  long <- data.frame(id = 1:4, x = c(0, 1, 0, 1), y = c(10, 5, 8, 4))

  expect_error(
    pivot_demand_data(long, format = "wide", y_var = "consumption"),
    "not found in data"
  )
})

test_that("explicit price_cols works correctly", {
  wide <- data.frame(
    id = 1:2,
    group = c("A", "B"),
    p1 = c(10, 8),
    p2 = c(5, 4)
  )

  long <- pivot_demand_data(wide, format = "long",
                            price_cols = c("p1", "p2"),
                            x_values = c(0, 0.5))

  expect_true("group" %in% names(long))
  expect_equal(sort(unique(long$x)), c(0, 0.5))
  expect_equal(nrow(long), 4)
})

test_that("invalid price_cols gives clear error", {
  wide <- data.frame(id = 1:2, a = c(10, 8))

  expect_error(
    pivot_demand_data(wide, format = "long",
                      price_cols = c("a", "b")),
    "not found in data"
  )
})

test_that("non-numeric x_values errors", {
  wide <- data.frame(id = 1:2, p1 = c(10, 8))

  expect_error(
    pivot_demand_data(wide, format = "long",
                      price_cols = "p1",
                      x_values = "zero"),
    "x_values must be a numeric"
  )
})