tests/testthat/test-helpers.R

In cbsREPS: Hedonic and Multilateral Index Methods for Real Estate Price Statistics

test_that("Test calculate_geometric_average", {
  a <- c(1, 2, 3, 4)
  expect_equal(round(calculate_geometric_average(a), 4), round(2.213364, 4))
  
  # Check that NA values are ignored
  b <- c(1, 2, NA, 4)
  expect_equal(round(calculate_geometric_average(b), 4), round(exp(mean(log(c(1, 2, 4)))), 4))
  
  # Non-numeric input should trigger an error
  expect_error(calculate_geometric_average(c("a", "b", "c")), "Values is not \\(fully\\) numeric")
})

test_that("Test calculate_index", {
  periods <- c("2020Q1", "2020Q2", "2020Q3")
  values <- c(100, 110, 90)
  
  result <- calculate_index(periods, values, reference_period = "2020Q1")
  expect_equal(round(result[1], 1), 100)
  expect_equal(round(result[2], 1), 110)
  expect_equal(round(result[3], 1), 90)
  
  # Check fallback to first period if reference not specified
  result2 <- calculate_index(periods, values)
  expect_equal(result, result2)
  
  # Non-numeric values trigger an error
  expect_error(calculate_index(periods, c("a", "b", "c")), "values variable is not \\(fully\\) numeric")
  
  # Mismatch in vector lengths triggers an error
  expect_error(calculate_index(c("2020Q1", "2020Q2"), c(100, 110, 120)), "not of the same length")
})


test_that("Test validate_input", {
  # Valid input should not throw an error
  expect_silent(validate_input(
    dataset = data_constraxion,
    period_variable = c("period"),
    dependent_variable = c("price"),
    continuous_variables = c("floor_area"),
    categorical_variables = c("neighbourhood_code")
  ))
  
  expect_error(validate_input(
    dataset = data_constraxion[, -which(names(data_constraxion) == "period")],
    period_variable = c("period"),
    dependent_variable = c("price"),
    continuous_variables = c("floor_area"),
    categorical_variables = c("neighbourhood_code")
  ), "does not have all of these name")
  
  
  # Error: non-numeric continuous variable
  data_non_numeric <- data_constraxion
  data_non_numeric$floor_area <- as.character(data_non_numeric$floor_area)
  expect_error(validate_input(
    dataset = data_non_numeric,
    period_variable = c("period"),
    dependent_variable = c("price"),
    continuous_variables = c("floor_area"),
    categorical_variables = c("neighbourhood_code")
  ), "not \\(fully\\) numeric")
  
  # Error: negative price
  data_negative_price <- data_constraxion
  data_negative_price$price[1] <- -100000
  expect_error(validate_input(
    dataset = data_negative_price,
    period_variable = c("period"),
    dependent_variable = c("price"),
    continuous_variables = c("floor_area"),
    categorical_variables = c("neighbourhood_code")
  ), "contains negative values")
  
  # Error: invalid period format
  data_bad_period <- data_constraxion
  data_bad_period$period <- c("2020-01", "2020-02", rep("2020Q1", nrow(data_bad_period) - 2))
  expect_error(validate_input(
    dataset = data_bad_period,
    period_variable = c("period"),
    dependent_variable = c("price"),
    continuous_variables = c("floor_area"),
    categorical_variables = c("neighbourhood_code")
  ), "correct format")
})

test_that("Test calculate_hedonic_imputation", {
  save_refs <- FALSE  # Set to TRUE to save reference output
  ref_file <- test_path("test_data", "hedonic_imputation_output.rds")
  
  # Input variables
  period_variable <- c("period")
  dependent_variable <- c("price")
  continuous_variables <- c("floor_area")
  categorical_variables <- c("neighbourhood_code")
  independent_variables <- c(continuous_variables, categorical_variables)
  number_of_observations <- TRUE
  
  
  # Prepare dataset in right format
  dataset <- data_constraxion |>
    dplyr::rename(period_var_temp = dplyr::all_of(period_variable)) |>
    dplyr::mutate(
      period_var_temp = as.character(period_var_temp),
      dplyr::across(dplyr::all_of(categorical_variables), as.factor)
    )
  
  period_list <- sort(unique(dataset$period_var_temp), decreasing = FALSE)
  
  # Run function
  tbl_output <- calculate_hedonic_imputation(
    dataset_temp = dataset,
    period_temp = "period_var_temp",
    dependent_variable_temp = dependent_variable,
    independent_variables_temp = independent_variables,
    number_of_observations_temp = number_of_observations,
    period_list_temp = period_list
  )
  
  if (save_refs) {
    dir.create(dirname(ref_file), showWarnings = FALSE, recursive = TRUE)
    saveRDS(tbl_output, ref_file)
    succeed("Reference output saved.")
  } else {
    ref_tbl <- readRDS(ref_file)
    expect_equal(tbl_output, ref_tbl, tolerance = 1e-8)
  }
})

test_that("Test calculate_hmts_index", {
  save_refs <- FALSE  # Set to TRUE to save the reference output
  ref_file <- test_path("test_data", "hmts_index_output.rds")
  
  # Parameters
  period_variable <- "period"
  dependent_variable <- "price"
  continuous_variables <- c("floor_area")
  categorical_variables <- c("neighbourhood_code")
  reference_period <- 2015
  periods_in_year <- 4
  production_since <- NULL
  number_preliminary_periods <- 2
  number_of_observations <- TRUE
  resting_points <- FALSE  # Set to FALSE as requested
  
  # Prepare dataset as expected by the function
  dataset <- data_constraxion |>
    dplyr::rename(period = dplyr::all_of(period_variable)) |>
    dplyr::mutate(
      period = as.character(period),
      dplyr::across(dplyr::all_of(categorical_variables), as.factor)
    )
  
  # Run the function
  tbl_output <- calculate_hmts_index(
    dataset = dataset,
    period_variable = period_variable,
    dependent_variable = dependent_variable,
    continuous_variables = continuous_variables,
    categorical_variables = categorical_variables,
    reference_period = reference_period,
    periods_in_year = periods_in_year,
    production_since = production_since,
    number_preliminary_periods = number_preliminary_periods,
    number_of_observations = number_of_observations,
    resting_points = resting_points
  )
  
  if (save_refs) {
    dir.create(dirname(ref_file), showWarnings = FALSE, recursive = TRUE)
    saveRDS(tbl_output, ref_file)
    succeed("Reference output saved.")
  } else {
    ref_tbl <- readRDS(ref_file)
    expect_equal(tbl_output, ref_tbl, tolerance = 1e-8)
  }
})

test_that("Test calculate_hedonic_imputationmatrix", {
  save_refs <- FALSE  # Set to TRUE to save the reference output
  ref_file <- test_path("test_data", "hedonic_imputation_matrix_output.rds")
  
  # Parameters used by the function
  period_variable <- "period"
  dependent_variable <- "price"
  continuous_variables <- c("floor_area")
  categorical_variables <- c("neighbourhood_code")
  periods_in_year <- 4
  number_of_observations <- TRUE
  production_since <- NULL
  number_preliminary_periods <- 2
  
  # Prepare dataset as expected
  dataset <- data_constraxion |>
    dplyr::rename(period = dplyr::all_of(period_variable)) |>
    dplyr::mutate(
      period = as.character(period),
      dplyr::across(dplyr::all_of(categorical_variables), as.factor)
    )
  
  # Run the function
  matrix_output <- calculate_hedonic_imputationmatrix(
    dataset = dataset,
    period_variable = "period",
    dependent_variable = dependent_variable,
    continuous_variables = continuous_variables,
    categorical_variables = categorical_variables,
    periods_in_year = periods_in_year,
    number_of_observations = number_of_observations,
    production_since = production_since,
    number_preliminary_periods = number_preliminary_periods
  )
  
  if (save_refs) {
    dir.create(dirname(ref_file), showWarnings = FALSE, recursive = TRUE)
    saveRDS(matrix_output, ref_file)
    succeed("Reference output saved.")
  } else {
    ref_tbl <- readRDS(ref_file)
  
    
    expect_equal(matrix_output$matrix_hmts_index, ref_tbl$matrix_hmts_index, tolerance = 1e-3)
  }
})