Skip to content

Commit

Permalink
tests for row_sum()
Browse files Browse the repository at this point in the history
ref #126
  • Loading branch information
wibeasley committed Oct 28, 2023
1 parent 60562c8 commit bef38cf
Showing 1 changed file with 150 additions and 0 deletions.
150 changes: 150 additions & 0 deletions tests/testthat/test-row.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,150 @@
library(testthat)

test_that("mtcars -engine_sum", {
expected <- structure(
list(mpg = c(21, 21, 22.8, 21.4, 18.7, 18.1, 14.3,
24.4, 22.8, 19.2, 17.8, 16.4, 17.3, 15.2, 10.4, 10.4, 14.7, 32.4,
30.4, 33.9, 21.5, 15.5, 15.2, 13.3, 19.2, 27.3, 26, 30.4, 15.8,
19.7, 15, 21.4), cyl = c(6, 6, 4, 6, 8, 6, 8, 4, 4, 6, 6, 8,
8, 8, 8, 8, 8, 4, 4, 4, 4, 8, 8, 8, 8, 4, 4, 4, 8, 6, 8, 4),
disp = c(160, 160, 108, 258, 360, 225, 360, 146.7, 140.8,
167.6, 167.6, 275.8, 275.8, 275.8, 472, 460, 440, 78.7, 75.7,
71.1, 120.1, 318, 304, 350, 400, 79, 120.3, 95.1, 351, 145,
301, 121), hp = c(110, 110, 93, 110, 175, 105, 245, 62, 95,
123, 123, 180, 180, 180, 205, 215, 230, 66, 52, 65, 97, 150,
150, 245, 175, 66, 91, 113, 264, 175, 335, 109), drat = c(3.9,
3.9, 3.85, 3.08, 3.15, 2.76, 3.21, 3.69, 3.92, 3.92, 3.92,
3.07, 3.07, 3.07, 2.93, 3, 3.23, 4.08, 4.93, 4.22, 3.7, 2.76,
3.15, 3.73, 3.08, 4.08, 4.43, 3.77, 4.22, 3.62, 3.54, 4.11
), wt = c(2.62, 2.875, 2.32, 3.215, 3.44, 3.46, 3.57, 3.19,
3.15, 3.44, 3.44, 4.07, 3.73, 3.78, 5.25, 5.424, 5.345, 2.2,
1.615, 1.835, 2.465, 3.52, 3.435, 3.84, 3.845, 1.935, 2.14,
1.513, 3.17, 2.77, 3.57, 2.78), qsec = c(16.46, 17.02, 18.61,
19.44, 17.02, 20.22, 15.84, 20, 22.9, 18.3, 18.9, 17.4, 17.6,
18, 17.98, 17.82, 17.42, 19.47, 18.52, 19.9, 20.01, 16.87,
17.3, 15.41, 17.05, 18.9, 16.7, 16.9, 14.5, 15.5, 14.6, 18.6
), vs = c(0, 0, 1, 1, 0, 1, 0, 1, 1, 1, 1, 0, 0, 0, 0, 0,
0, 1, 1, 1, 1, 0, 0, 0, 0, 1, 0, 1, 0, 0, 0, 1), am = c(1,
1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1,
0, 0, 0, 0, 0, 1, 1, 1, 1, 1, 1, 1), gear = c(4, 4, 4, 3,
3, 3, 3, 4, 4, 4, 4, 3, 3, 3, 3, 3, 3, 4, 4, 4, 3, 3, 3,
3, 3, 4, 5, 5, 5, 5, 5, 4), carb = c(4, 4, 1, 1, 2, 1, 4,
2, 2, 4, 4, 3, 3, 3, 4, 4, 4, 1, 2, 1, 1, 2, 2, 4, 2, 1,
2, 2, 4, 6, 8, 2), engine_sum = c(170, 170, 114, 266, 370,
233, 372, 153.7, 147.8, 178.6, 178.6, 286.8, 286.8, 286.8,
484, 472, 452, 84.7, 82.7, 77.1, 126.1, 328, 314, 362, 410,
85, 126.3, 102.1, 363, 157, 317, 128)), row.names = c("Mazda RX4",
"Mazda RX4 Wag", "Datsun 710", "Hornet 4 Drive", "Hornet Sportabout",
"Valiant", "Duster 360", "Merc 240D", "Merc 230", "Merc 280",
"Merc 280C", "Merc 450SE", "Merc 450SL", "Merc 450SLC", "Cadillac Fleetwood",
"Lincoln Continental", "Chrysler Imperial", "Fiat 128", "Honda Civic",
"Toyota Corolla", "Toyota Corona", "Dodge Challenger", "AMC Javelin",
"Camaro Z28", "Pontiac Firebird", "Fiat X1-9", "Porsche 914-2",
"Lotus Europa", "Ford Pantera L", "Ferrari Dino", "Maserati Bora",
"Volvo 142E"), class = "data.frame"
)

actual <-
mtcars |>
row_sum(
columns_to_average = c("cyl", "disp", "vs", "carb"),
new_column_name = "engine_sum"
)

# expected <- dput(actual)
testthat::expect_equal(actual, expected)
})

test_that("mtcars -all_columns", {
expected <-
c(
NA, NA, 1403, 1342, 1012, 753, NA, 1041, 533, 1355, 839, 419,
531, 463, 1025, NA, 2328, NA, 1641, 751, 957, 647, 950, 561,
570, 903, 647, 1250, 713, 1086, 788, NA, 1283, 1070, 1300, 626,
1110, 768, 766, 871, 1032, 777, 1143, NA, NA, 916, 1460, NA,
675, 946, 904, NA, 740, 994, NA, 812, 1189, 1173, 1011, NA, 1249,
946, 2101, 1590, 1153, NA, 806, 877, 1492, 902, 1362, 968, 1371,
NA, 415, 734, 668, 1084, NA, 696, 753, 969, 759, 942, 865, 865,
1162, 753, 996, NA, 614, 301, 1021, 624, 698, NA, NA, 1094, NA,
974, 655, 1067, 1033, 683, 833, NA, NA, NA, 1383, 1226, 1039,
1038, 1000, 585, 1176, 549, NA, 1166, 1426, 1499, 773, 1220,
973, 692, NA, 1025, 1373, 616, 500, 685, 982, 668, 1181, 317,
1039, 1078, 623, 1162, 1149, 951, 698, 753, 466, 555, 626, 734,
1318, 494, 1140, 933, 1322, 1128, 913, 910, NA, 892, 1044, 909,
814, NA, 780, 724, 765, NA, NA, NA, NA, 1315, NA, 683, 915, 950,
780, 771, NA, 753, 949, 1669, 1342, 1470, 1206, 998, 1195, 1179,
NA, 1142, 855, 748, 1434, 1853, 387, 323, NA, 965, 668, 1118,
NA, 1263, 921, 1439, 1121, 994, 884, 910, 704, 882, 864, 1722,
844, NA, 1090, 829, 1476, 552, 1013, 589, 1215, 661, 328, 542,
510, 1172, 1050, 592, 715, NA, 811, 850, 712, NA, 1098, 1305,
NA, 588, 596, 605, NA, 1603, 945, NA, NA, 946, 1180, 1236, 1476,
796, 816, 1659, 890, 1278, 518, 1057, 273, 931, 573, NA, 1261,
614, NA, 1216, 718, NA, 1241, 632, 537, 1652, 748, NA, 1287,
531, 998, 1090, 530, 720, NA, 888, 988, 1128, 1255, 1214, 894,
1169, NA, NA, NA, 958, 569, 1324, 728, 938, 1339, 997, 991, NA,
1052, NA, 1152, NA, 1259, 1143, 879, 777, 643, 617, 992, 1270,
NA, 867, 1433, 1077, 1283, 773, 665, NA, 1244, NA, 727
)

actual <-
tidyr::billboard |>
row_sum(
pattern = "^wk\\d{1,2}$",
new_column_name = "week_sum",
threshold_proportion = .1,
verbose = TRUE
) |>
dplyr::pull(week_sum)

# expected <- dput(actual)
testthat::expect_equal(actual, expected)
})


test_that("mtcars -all_columns", {
expected <-
c(
598, NA, 567, 601, 319, 202, NA, 422, 259, 606, 664, 248, 241,
207, 416, NA, 772, NA, 697, 335, 381, 302, 436, 156, 280, 390,
342, 644, 443, 571, 788, NA, 729, 472, 537, 313, 659, 668, 514,
585, 420, 271, 407, NA, NA, 504, 746, NA, 675, 772, 812, 434,
398, 511, 634, 630, 506, 608, 754, NA, 473, 468, 577, 668, 809,
NA, 331, 470, 720, 708, 583, 438, 745, NA, 274, 478, 325, 616,
NA, 411, 662, 508, 234, 503, 366, 428, 772, 497, 578, NA, 174,
112, 524, 171, 612, NA, NA, 501, NA, 489, 363, 540, 770, 443,
496, NA, 655, NA, 614, 602, 587, 787, 376, 287, 564, 380, 362,
881, 716, 608, 677, 423, 616, 362, NA, 648, 561, 461, 252, 685,
412, 452, 572, 219, 529, 601, 358, 509, 579, 487, 207, 413, 270,
555, 314, 734, 790, 247, 500, 461, 618, 565, 464, 576, NA, 447,
604, 462, 582, NA, 324, 724, 665, NA, NA, NA, NA, 511, NA, 683,
233, 768, 588, 674, 687, 448, 756, 845, 632, 379, 566, 509, 552,
789, 608, 505, 474, 460, 715, 839, 387, 102, NA, 441, 180, 467,
NA, 521, 621, 625, 591, 543, 423, 572, 704, 595, 451, 736, 749,
NA, 465, 829, 406, 374, 537, 360, 554, 404, 131, 318, 170, 588,
541, 371, 403, NA, 440, 850, 712, NA, 437, 602, NA, 331, 114,
605, NA, 749, 215, NA, NA, 594, 607, 636, 693, 478, 431, 749,
556, 510, 206, 424, 44, 358, 243, NA, 534, 614, NA, 699, 299,
NA, 540, 385, 296, 638, 343, NA, 653, 254, 515, 341, 344, 208,
NA, 604, 528, 752, 611, 494, 448, 384, 443, NA, NA, 673, 253,
514, 352, 749, 498, 447, 802, NA, 600, NA, 610, 486, 517, 521,
382, 358, 457, 617, 802, 478, NA, 525, 592, 429, 785, 675, 665,
NA, 764, NA, 240
)

expected_message <- "The following columns will be summed:\n- wk1\n- wk2\n- wk3\n- wk4\n- wk5\n- wk6\n- wk7\n- wk8\n- wk9"

expect_message(
regexp = expected_message,{
actual <-
tidyr::billboard |>
row_sum(
pattern = "^wk\\d$",
new_column_name = "week_sum",
verbose = TRUE
) |>
dplyr::pull(week_sum)
})

# expected <- dput(actual)
testthat::expect_equal(actual, expected)
})

0 comments on commit bef38cf

Please sign in to comment.