Merge pull request #85 from RSGInc/62-more-unit-testing

62 more unit testing

tests/testthat/test_factorize_column.R

@@ -1,4 +1,4 @@
-context("factorize_column")
+
 library(travelSurveyTools)
 library(data.table)
 

tests/testthat/test_factorize_df.R

@@ -1,4 +1,4 @@
-context("factorize_df")
+
 library(travelSurveyTools)
 library(data.table)
 
@@ -13,15 +13,15 @@ vals_df =   data.table(
   stringsAsFactors = FALSE)
 
 
-#todo: make this quiet - capture.output?
-
 test_that("Returns the same structure as the input",{
-  expect_equal(class(factorize_df(dt, vals_df, add_na = TRUE)), class(dt))
-  expect_equal(ncol(factorize_df(dt, vals_df, add_na = TRUE)), ncol(dt))
-  expect_equal(nrow(factorize_df(dt, vals_df, add_na = TRUE)), nrow(dt))
-})
+
+    suppressMessages(expect_equal(class(factorize_df(dt, vals_df, add_na = TRUE)), class(dt)))
+    suppressMessages(expect_equal(ncol(factorize_df(dt, vals_df, add_na = TRUE)), ncol(dt)))
+    suppressMessages(expect_equal(nrow(factorize_df(dt, vals_df, add_na = TRUE)), nrow(dt)))
+
+  })
 
 test_that("Works when add_na is false",{
-  expect_equal(class(factorize_df(dt, vals_df, add_na = F)),class(dt))
+  suppressMessages(expect_equal(class(factorize_df(dt, vals_df, add_na = F)),class(dt)))
 })
 

tests/testthat/test_get_distance_meters.R

@@ -1,6 +1,5 @@
 
 
-context("get_distance_meters")
 library(travelSurveyTools)
 
 test_that("Returns appropriate distance",{

tests/testthat/test_hts_bin_var.R

@@ -1,29 +1,26 @@
-context("Test suite for hts_bin_var function")
 
+# Load necessary libraries and setup environment
 library(travelSurveyTools)
 library(data.table)
 library(stringr)
 
+# Create a sample data.table for testing
+prepped_dt = test_data$trip
 
 
 test_that("hts_bin_var should bin numeric variables", {
-  # Create a sample data.table for testing
-  prepped_dt = test_data$trip
 
   # Call the function
   result = hts_bin_var(prepped_dt, numvar = "speed_mph", nbins = 5)
 
   # Check if the result is a data.table
-  expect_is(result, "data.table", 
-            info = "hts_bin_var should return a data.table")
+  expect_type(result, "list")
 
   # Check if the binned column is present in the result
   expect_true("speed_mph" %in% names(result), 
               info = "Result should have a column named 'speed_mph'")
 
   # Check if the binned column is a factor
-  expect_is(result$speed_mph, "factor", 
-            info = "Binned column should be of type 'factor'")
+  expect_true(is.factor(result$speed_mph))
 
-  # Add more test cases as needed
 })

tests/testthat/test_hts_cbind_var.R

@@ -1,40 +1,25 @@
-context("Test suite for hts_cbind_var function")
 
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
 
+# Create a sample lhs_table
+lhs_table = test_data$trip
+
 test_that("hts_cbind_var should bind a column to another table", {
-  # Create a sample lhs_table
-  lhs_table = test_data$trip
-
-  # Create a sample rhs_table
-  rhs_table = test_data$person
-
-  # Create a sample variable_list
-  variable_list = variable_list
 
   # Create a sample hts_data
   data("test_data")
 
   # Call the function
   result = hts_cbind_var(lhs_table, rhs_var = 'speed_mph', hts_data = test_data, variable_list = variable_list)
 
-  # Check if the result is a data.table
-  expect_is(result, "data.table", 
-            info = "hts_cbind_var should return a data.table")
+  # Check if the result is a list
+  expect_type(result, "list")
 
   # Check if the column 'speed_mph' is present in the result
   expect_true("speed_mph" %in% names(result), 
               info = "Result should have a column named 'speed_mph'")
 
-  # Check if the column 'speed_mph' is bound correctly
-  # expect_equal(result$speed_mph, c(NA, 30, NA), 
-  #              info = "Bounded column 'speed_mph' should have correct values")
-
-  # Add more test cases as needed
 })
-
-# Clean up environment
-rm(list = c("create_variable_list"))

tests/testthat/test_hts_filter_data.R

@@ -1,27 +1,25 @@
 
-context("Test suite for hts_filter_data function")
-
-
+# Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
+# Create a sample hts_data
+hts_data = test_data
+
+test_that("hts_filter_data should filter data based on id_type", {
 
+  # Call the function to filter based on hh_id
+  result_hh = hts_filter_data(hts_data, hh[num_people > 5, hh_id], id_name = 'hh_id')
+
+  # Check if the result is a list
+  expect_type(result_hh, "list")
+
+  # Check if hh data is filtered correctly
+  expect_true('hh_id' %in% names(result_hh$hh),
+               info = "hh data should be filtered correctly")
+
+  # Check that no hhs with 5 or less people remain
+  expect_true(min(result_hh$hh$num_people) > 5)
 
-  test_that("hts_filter_data should filter data based on id_type", {
-    # Create a sample hts_data
-    hts_data = test_data
-
-    # Call the function to filter based on hh_id
-    result_hh = hts_filter_data(hts_data, hh[num_people > 5, hh_id], id_name = 'hh')
-
-    # Check if the result is a list
-    expect_is(result_hh, "list", 
-              info = "hts_filter_data should return a list")
-
-    # Check if hh data is filtered correctly
-    # expect_equal(result_hh$hh$hh_id, c(1, 2), 
-    #              info = "hh data should be filtered correctly")
-
-    # Add more test cases for other id_type values
-  })
+})
 

tests/testthat/test_hts_find_var.R

@@ -1,19 +1,13 @@
 
-context("Test suite for hts_find_var function")
-
-
+# Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
 
-
 test_that("hts_find_var should find the location of a variable", {
 
-  variable_list = variable_list
-
   result = hts_find_var('gender', variable_list)
 
-  expect_is(result, 'character', info = "hts_find_var should return a character vector")
+  expect_type(result, 'character')
 
-  # expect_equal()
 })

tests/testthat/test_hts_get_ns.R

@@ -1,6 +1,4 @@
 
-context("Test suite for hts_get_ns function")
-
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
@@ -11,11 +9,14 @@ test_that("hts_get_ns should return counts", {
 
   results = hts_get_ns(sample_dt, weighted = FALSE)
 
-  expect_is(results, "list", info = "hts_get_ns should return a list")
+  expect_type(results, "list")
 
-  expect_is(results$unwtd, "list", info = "unwtd should return a list")
+  expect_type(results$unwtd, "list")
 
   expect_null(results$wtd, info = "'wtd' component should be NULL for unweighted counts")
 
-  # expect_equal()
+  expect_type(results$units, "NULL")
+
+  expect_type(results$unwtd$Households, "NULL")
+
 })

tests/testthat/test_hts_melt_vars.R

@@ -1,23 +1,17 @@
 
-context("Test suite for hts_melt_vars function")
-
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
-
-variable_list = variable_list
-
 sample_dt = test_data$person
 
 test_that("hts_melt_vars should melt variables correctly", {
 
   results = hts_melt_vars(shared_name = 'race', wide_dt = sample_dt)
 
-  # Check if the result is a data.table
-  expect_is(results, "data.table", 
-            info = "hts_melt_vars should return a data.table")
+  # Check if the result is a list
+  expect_type(results, "list")
 
+  expect_true('race' %in% names(results))
 
-  # expect_equal(2 * 2, 4)
 })

tests/testthat/test_hts_prep_byvar.R

@@ -1,16 +1,17 @@
 
-context("Test suite for hts_prep_byvar function")
-
+# Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
 
 test_that("hts_prep_byvar should prepare data by variable correctly", {
 
-  results = hts_prep_byvar(summarize_by = "age", variables_dt = variable_list, hts_data = test_data)
+  results = hts_prep_byvar(
+    summarize_by = "age", 
+    variables_dt = variable_list, 
+    hts_data = test_data)
 
-  expect_is(results, "data.table", 
-            info = "hts_prep_byvar should return a data.table")
+  expect_type(results, "list")
 
-   # expect_equal()
+  expect_true('age' %in% names(results))
 })

tests/testthat/test_hts_prep_data.R

@@ -1,6 +1,4 @@
 
-context("Test suite for hts_prep_data function")
-
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
@@ -9,9 +7,19 @@ library(data.table)
 
 test_that("hts_prep_data should return counts and units", {
 
-  results = hts_prep_data(summarize_var = 'age', variables_dt = variable_list, data = test_data)
+  results = hts_prep_data(
+    summarize_var = 'age',
+    summarize_by = 'mode_type',
+    variables_dt = variable_list,
+    data = test_data)
+
+  expect_type(results, "list")
+
+  expect_true('mode_type' %in% names(results$cat))
+
+  expect_true('trip_weight' %in% names(results$cat))
+
+  # FIXME: expect_false('995' %in% results$cat$mode_type)
 
-  expect_is(results, "list", info = "hts_prep_data should return a list")
-
 })
 

tests/testthat/test_hts_prep_triprate.R

@@ -1,15 +1,20 @@
 
-context("Test suite for hts_prep_triprate function")
-
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
 
 test_that("hts_prep_triprate should return counts and units", {
 
-  results = hts_prep_triprate(summarize_by = 'age', variables_dt = variable_list, hts_data = test_data)
+  results = hts_prep_triprate(
+    summarize_by = 'age',
+    variables_dt = variable_list,
+    hts_data = test_data)
+
+  expect_type(results, "list")
+
+  expect_true(results$outliers$threshold == 0.975)
 
-  expect_is(results, "list", info = "hts_prep_triprate should return a list")
+  expect_true('num_trips_wtd' %in% names(results$num))
 
 })

tests/testthat/test_hts_remove_missing_data.R

@@ -1,15 +1,18 @@
 
-context("Test suite for hts_remove_missing_data function")
-
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
 
 test_that("hts_remove_missing_data should return counts and units", {
 
-  results = hts_remove_missing_data(hts_data = test_data, summarize_var = 'speed_mph', variables_dt = variable_list)
+  results = hts_remove_missing_data(
+    hts_data = test_data,
+    summarize_var = 'speed_mph',
+    variables_dt = variable_list)
+
+  expect_type(results, "list")
 
-  expect_is(results, "list", info = "hts_remove_missing_data should return a list")
+  expect_true(!('995' %in% results$trip$speed_mph))
 
 })

tests/testthat/test_hts_remove_outliers.R

@@ -1,6 +1,4 @@
 
-context("Test suite for hts_remove_outliers function")
-
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
@@ -10,6 +8,10 @@ test_that("hts_remove_outliers should return counts and units", {
 
   results = hts_remove_outliers(var_dt = test_data$trip, numvar = 'speed_mph')
 
-  expect_is(results, "list", info = "hts_remove_outliers should return a list")
+  expect_type(results, "list")
+
+  expect_true('speed_mph' %in% names(results$dt))
+
+  expect_true(results$outlier_description$threshold == 0.975)
 
 })

tests/testthat/test_hts_summary.R

@@ -1,17 +1,11 @@
 
-context("Test suite for hts_summary function")
-
 # Load necessary libraries and setup environment
 library(testthat)
 library(data.table)
 
 DT = hts_prep_data(summarize_var = 'age',
                    variables_dt = variable_list,
-                   data = list('hh' = hh,
-                               'person' = person,
-                               'day' = day,
-                               'trip' = trip,
-                               'vehicle' = vehicle))$cat
+                   data = test_data)$cat
 
 
 test_that("hts_summary should return counts and units", {
@@ -22,6 +16,9 @@ test_that("hts_summary should return counts and units", {
     summarize_vartype = 'categorical',
     wtname = 'person_weight')
 
-  expect_is(results, "list", info = "hts_summary should return a list")
+  expect_type(results, "list")
+
+  expect_true(results$summary$weight_name == 'person_weight')
 
+  expect_true(sum(results$summary$wtd$est) == sum(results$n_ls$wtd))
 })