Path: blob/master/2021-summer/materials/worksheet_06/tests_worksheet_06.R
2051 views
# # +1library(testthat)2library(digest)3library(rlang)45#' Round double to precise integer6#'7#' `int_round` works to create an integer corresponding to a number that is8#' tested up to a particular decimal point of precision. This is useful when9#' there is a need to compare a numeric value using hashes.10#'11#' @param x Double vector of length one.12#' @param digits Double vector of length one to specify decimal point of precision. Negative numbers can be used to specifying significant digits > 0.1.13#'14#' @return Integer vector of length one corresponding to a particular decimal point of precision.15#'16#' @examples17#' # to get an integer up to two decimals of precision from 234.5678918#' int_round(234.56789, 2)19#'20#' to get an integer rounded to the hundred digit from 234.5678921#' int_round(234.56789, -2)2223int_round <- function(x, digits){24x = x*10^digits25xint = as.integer(x)26xint1 = xint + 1L27if (abs(xint - x) < abs(xint1 - x)){28return(xint)29}30else {31return(xint1)32}33}34# -3536test_0.1 <- function(){37test_that('Solution is incorrect', {38expect_equal(digest(answer0.1), '475bf9280aab63a82af60791302736f6') # we hid the answer to the test here so you can't see it, but we can still run the test39})40print("Success!")41}4243test_0.2 <- function(){44test_that('Solution is incorrect', {45expect_equal(digest(answer0.2), '3a5505c06543876fe45598b5e5e5195d') # we hid the answer to the test here so you can't see it, but we can still run the test46})47print("Success!")48}4950test_1.0 <- function(){51test_that('Did not create an object named cancer', {52expect_true(exists("cancer"))53})54test_that('cancer should be a data frame.', {55expect_true('data.frame' %in% class(cancer))56})57test_that('cancer does not contain the correct number of rows and/or columns.', {58expect_equal(dim(cancer), c(569, 12))59})60test_that('cancer does not contain the correct data.', {61expect_equal(digest(int_round(sum(cancer$Area), 2)), '1473d70e5646a26de3c52aa1abd85b1f')62expect_equal(colnames(cancer), c("ID", "Class", "Radius", "Texture", "Perimeter", "Area", "Smoothness", "Compactness", "Concavity", "Concave_points", "Symmetry", "Fractal_dimension"))63})64test_that('read.csv() instead of read_csv() function is used.', {65expect_true(class(cancer$Class) == 'character')66})67print("Success!")68}6970test_1.1 <- function(){71if (digest(answer1.1) == '05ca18b596514af73f6880309a21b5dd'){72print("Look at the values in the Area column - are they categorical? Remember, classification problems involve predicting class labels for categorical data.")73}74test_that('Solution is incorrect', {75expect_equal(digest(answer1.1), 'd2a90307aac5ae8d0ef58e2fe730d38b') # we hid the answer to the test here so you can't see it, but we can still run the test76})77print("Success!")78}7980test_1.2 <- function(){81properties <- c(cancer_plot$layers[[1]]$mapping, cancer_plot$mapping)82labels <- cancer_plot$labels83test_that('Did not create a plot named cancer_plot', {84expect_true(exists("cancer_plot"))85})86test_that('Symmetry should be on the x-axis.', {87expect_true("Symmetry" == rlang::get_expr(properties$x))88})89test_that('Radius should be on the y-axis.', {90expect_true("Radius" == rlang::get_expr(properties$y))91})92test_that('Points should be coloured by Class.', {93expect_true("Class" == rlang::get_expr(properties$colour))94})95test_that('cancer_plot should be a scatter plot.', {96expect_true("GeomPoint" %in% class(cancer_plot$layers[[1]]$geom))97})98test_that('cancer_plot should map Class to colour.', {99expect_true(digest(rlang::get_expr(properties$colour)) %in% c('a4abb3d43fde633563dd1f5c3ea31f31', 'f9e884084b84794d762a535f3facec85'))100})101test_that('axis labels do not state that the data is standardized (which it is!)', {102expect_true(labels$x != "Symmetry")103expect_true(labels$y != "Radius")104})105print("Success!")106}107108test_1.3 <- function(){109test_that('Solution is incorrect', {110expect_equal(digest(answer1.3), '891e8a631267b478c03e25594808709d') # we hid the answer to the test here so you can't see it, but we can still run the test111})112print("Success!")113}114115test_1.4 <- function(){116test_that('xa is incorrect.', {117expect_equal(digest(int_round(xa, 2)), 'c0048c4f8677b795155d8aa41e26a54d')118})119test_that('ya is incorrect.', {120expect_equal(digest(int_round(ya, 2)), 'a6e8462a7cace5673e544d1e8d238b52')121})122test_that('xb is incorrect.', {123expect_equal(digest(int_round(xb, 2)), '10aeddd8594c6ce210c731b8b94af435')124})125test_that('yb is incorrect.', {126expect_equal(digest(int_round(yb, 2)), '48139aad2994737e7e801156a24281ed')127})128print("Success!")129}130131test_1.5 <- function(){132test_that('answer1.5 is incorrect', {133expect_equal(digest(int_round(answer1.5, 2)), 'a95ceee8390cb47bb05410a8d23c76cf') # we hid the answer to the test here so you can't see it, but we can still run the test134})135print("Success!")136}137138test_1.6 <- function(){139test_that('Did not create an object named zb', {140expect_true(exists('zb'))141})142test_that('zb is incorrect.', {143expect_equal(digest(int_round(zb,2)), 'b78a46ebc0bb9a4cc7f4f4b962f0b2ef')144})145test_that('Did not create an object named za', {146expect_true(exists('za'))147})148test_that('za is incorrect.', {149expect_equal(digest(int_round(za,2)), 'b35d8adab2b7c839e5a8e2861080b03e')150})151print("Success!")152}153154test_1.7 <- function(){155test_that('answer1.7 is incorrect', {156expect_equal(digest(int_round(answer1.7, 2)), 'c7fd80062a02f15d212704a20fae75fb') # we hid the answer to the test here so you can't see it, but we can still run the test157})158print("Success!")159}160161test_1.8 <- function(){162test_that('point_a is incorrect.', {163expect_equal(digest(int_round(sum((point_a)),2)), '44014eaa19f1aef8e92b1020c47d662b')164})165test_that('point_b is incorrect.', {166expect_equal(digest(int_round(sum((point_b)),2)), 'e064b40c9ca28b04b874bcd8bdefa41e')167})168print("Success!")169}170171test_1.09 <- function(){172test_that('dif_square is incorrect', {173expect_equal(digest(int_round(sum(dif_square),2)), 'e276884e43714ac361db1a1998bb6bc9') # we hid the answer to the test here so you can't see it, but we can still run the test174})175print("Success!")176}177178179test_1.09.1 <- function(){180test_that('dif_sum is incorrect', {181expect_equal(digest(int_round(dif_sum,2)), 'e276884e43714ac361db1a1998bb6bc9') # we hid the answer to the test here so you can't see it, but we can still run the test182})183print("Success!")184}185186test_1.09.2 <- function(){187test_that('root_dif_sum is incorrect', {188expect_equal(digest(int_round(root_dif_sum,2)), 'c7fd80062a02f15d212704a20fae75fb') # we hid the answer to the test here so you can't see it, but we can still run the test189})190print("Success!")191}192193test_1.09.3 <- function(){194test_that('dist_cancer_two_rows is incorrect', {195expect_equal(digest(int_round(dist_cancer_two_rows,2)), 'c7fd80062a02f15d212704a20fae75fb') # we hid the answer to the test here so you can't see it, but we can still run the test196197})198print("Success!")199}200201202test_1.09.4 <- function(){203test_that('Solution is incorrect', {204expect_equal(digest(answer1.09.4), '05ca18b596514af73f6880309a21b5dd') # we hid the answer to the test here so you can't see it, but we can still run the test205206})207print("Success!")208}209210test_2.0.0 <- function(){211test_that('Did not create an object named small_sample', {212expect_true(exists("small_sample"))213})214test_that('small_sample should be a data frame.', {215expect_true('data.frame' %in% class(small_sample))216})217test_that('small_sample does not contain the correct number of rows and/or columns.', {218expect_equal(dim(small_sample), c(5, 3))219})220test_that('small_sample does not contain the correct columns.', {221expect_true('Symmetry' %in% colnames(small_sample))222expect_true('Radius' %in% colnames(small_sample))223expect_true('Class' %in% colnames(small_sample))224})225print("Success!")226}227228229test_2.0.1 <- function(){230properties <- c(small_sample_plot$layers[[1]]$mapping, small_sample_plot$mapping)231labels <- small_sample_plot$labels232test_that('Did not create a plot named small_sample_plot', {233expect_true(exists("small_sample_plot"))234})235test_that('Did not use small_sample data to create small_sample_plot', {236expect_equal(digest(int_round(sum(small_sample_plot$data$Symmetry),2)), '727b6cd45f0340de38d1cfe8403adb3e')237})238test_that('Symmetry should be on the x-axis.', {239expect_true("Symmetry" == rlang::get_expr(properties$x))240})241test_that('Radius should be on the y-axis.', {242expect_true("Radius" == rlang::get_expr(properties$y))243})244test_that('small_sample_plot should be a scatter plot.', {245expect_true("GeomPoint" %in% c(class(small_sample_plot$layers[[1]]$geom)))246})247test_that('small_sample_plot should map Benign / Malignant to colour.', {248expect_true("Class" == rlang::get_expr(properties$colour))249})250test_that('axis labels do not state that the data is standardized (which it is!)', {251expect_true(labels$x != "Symmetry")252expect_true(labels$y != "Radius")253})254print("Success!")255}256257test_2.1 <- function(){258test_that('Did not create an object named newData', {259expect_true(exists("newData"))260})261test_that('newData should be a data frame.', {262expect_true('data.frame' %in% class(newData))263})264test_that('The last row of the Class column should be "unknown".', {265expect_equal((newData$Class[6]), 'unknown')266})267test_that('newData does not contain the correct number of rows and/or columns.', {268expect_equal(dim(newData), c(6, 3))269})270test_that('small_sample does not contain the correct data.', {271expect_equal(digest(int_round(sum(newData$Radius),2)), '740dbeffda6d0ffb1b86f797df4c2a25')272expect_equal(digest(int_round(sum(newData$Symmetry),2)), 'a14e0862232f39bc203a2c5021371b54')273})274print("Success!")275}276277test_2.2 <- function(){278test_that('Did not create an object named dist_matrix', {279expect_true(exists("dist_matrix"))280})281test_that('dist_matrix should be a matrix.', {282expect_true('matrix' %in% class(dist_matrix))283})284test_that('dist_matrix does not contain the correct number of rows and/or columns.', {285expect_equal(dim(dist_matrix), c(6, 6))286})287test_that('dist_matrix does not contain the correct data.', {288expect_equal(digest(int_round(sum(dist_matrix[1, ]),2)), '8435efbd9cf83356ac4a26c6889c8fa5')289expect_equal(digest(int_round(sum(dist_matrix[2, ]),2)), 'abc3f5458b96456d63865f0922593548')290expect_equal(digest(int_round(sum(dist_matrix[5, ]),2)), 'c3ad708acb2b90a9e40e48f729083e69')291expect_equal(digest(int_round(sum(dist_matrix[6, ]),2)), 'f0f12367a5beee1f65d2633294474dc9')292})293print("Success!")294}295296test_2.3 <- function(){297if (typeof(answer2.3) == 'double') {298print("Remember to surround your answer with quotes!")299}300test_that('Solution is incorrect', {301expect_equal(digest(answer2.3), 'ee340e888492be0703f2bcc9abfb390c') # we hid the answer to the test here so you can't see it, but we can still run the test302})303print("Success!")304}305306test_2.4 <- function(){307test_that('Solution is incorrect', {308expect_equal(digest(answer2.4), '891e8a631267b478c03e25594808709d') # we hid the answer to the test here so you can't see it, but we can still run the test309})310print("Success!")311}312313test_2.5 <- function(){314test_that('Solution is incorrect', {315expect_equal(digest(answer2.5), '3a5505c06543876fe45598b5e5e5195d') # we hid the answer to the test here so you can't see it, but we can still run the test316})317print("Success!")318}319320test_2.6 <- function(){321test_that('Solution is incorrect', {322expect_equal(digest(answer2.6), '9c8cb5538e7778bf0b1bd53e45fb78c9') # we hid the answer to the test here so you can't see it, but we can still run the test323324})325print("Success!")326}327328test_2.7 <- function(){329test_that('Solution is incorrect', {330expect_equal(digest(answer2.7), '863dfc36ab2bfe97404cc8fc074a5241') # we hid the answer to the test here so you can't see it, but we can still run the test331332})333print("Success!")334}335336test_3.1 <- function(){337test_that('Did not create an object named knn_spec', {338expect_true(exists("knn_spec"))339})340test_that('k should be 7', {341expect_equal(as.numeric(get_expr(knn_spec$args$neighbors)), 7)342})343test_that('weight_func is incorrect', {344expect_equal(digest(as.character(get_expr(knn_spec$args$weight_func))), '989de78e881829b4499af3610dfe54fd')345})346test_that('set_engine is incorrect', {347expect_equal(digest(as.character(knn_spec$engine)), '93fe1d3f0a1fa2e625af1e1eb51a5c33')348})349test_that('mode is incorrect', {350expect_equal(digest(as.character(knn_spec$mode)), 'f361ba6f6b32d068e56f61f53d35e26a')351})352print("Success!")353}354355test_3.2 <- function(){356test_that('Did not create an object named knn_fit', {357expect_true(exists("knn_fit"))358})359test_that('knn_fit should be a fit model.', {360expect_true('model_fit' %in% class(knn_fit))361})362test_that('knn_fit does not include cancer_train dataset', {363expect_equal(digest(as.character(knn_fit$fit$data$Class)), '93ecaae439b9f4e8e4297d3a851929f9')364expect_equal(digest(int_round(sum(knn_fit$fit$data$Symmetry),2)), '1473d70e5646a26de3c52aa1abd85b1f')365expect_equal(digest(int_round(sum(knn_fit$fit$data$Radius),2)), '1473d70e5646a26de3c52aa1abd85b1f')366})367test_that('knn_fit does not contain knn_spec', {368expect_equal(digest(int_round(get_expr(knn_fit$spec$args$neighbors),2)), '51465273097370367115dfe0228831f3')369expect_equal(digest(as.character(get_expr(knn_fit$spec$args$weight_func))), '989de78e881829b4499af3610dfe54fd')370expect_equal(digest(knn_fit$spec$mode), 'f361ba6f6b32d068e56f61f53d35e26a')371})372test_that('knn_fit does not use the correct columns and/or the correct model formula', {373expect_setequal(c('Class', 'Radius', 'Symmetry'), row.names(attributes(knn_fit$fit$terms)$factors))374})375print("Success!")376}377378test_3.3 <- function(){379test_that('Did not create an object named new_obs',{380expect_true(exists("new_obs"))381})382test_that('new_obs is not a tibble', {383expect_true('data.frame' %in% class(new_obs))384})385test_that('Wrong values for Symmetry and Radius', {386expect_equal(as.numeric(new_obs$Symmetry), 1)387expect_equal(as.numeric(new_obs$Radius), 0)388})389test_that('Did not create an object named class_prediction',{390expect_true(exists("class_prediction"))391})392test_that('Wrong class prediction', {393expect_equal(digest(as.character(class_prediction$.pred_class)), '5f0922939c45ef1054f852e83f91c660')394})395print("Success!")396}397398test_3.4 <- function(){399test_that('k should be 7', {400expect_equal(int_round(get_expr(knn_spec$args$neighbors),0), 7)401})402test_that('weight_func is incorrect', {403expect_equal(digest(as.character(get_expr(knn_spec$args$weight_func))), '989de78e881829b4499af3610dfe54fd')404})405test_that('set_engine is incorrect', {406expect_equal(digest(as.character(knn_spec$engine)), '93fe1d3f0a1fa2e625af1e1eb51a5c33')407})408test_that('mode is incorrect', {409expect_equal(digest(as.character(knn_spec$mode)), 'f361ba6f6b32d068e56f61f53d35e26a')410})411test_that('Did not create an object named knn_fit_2', {412expect_true(exists("knn_fit_2"))413})414test_that('knn_fit_2 should be a fit model.', {415expect_true('model_fit' %in% class(knn_fit_2))416})417test_that('knn_fit_2 does not use the correct columns and/or the correct model formula', {418expect_setequal(c('Class', 'Radius', 'Symmetry', 'Concavity'), row.names(attributes(knn_fit_2$fit$terms)$factors))419})420test_that('knn_fit_2 does not include knn_train_2 dataset', {421expect_equal(digest(as.character(knn_fit_2$fit$data$Class)), '93ecaae439b9f4e8e4297d3a851929f9')422expect_equal(digest(int_round(sum(knn_fit_2$fit$data$Symmetry),2)), '1473d70e5646a26de3c52aa1abd85b1f')423expect_equal(digest(int_round(sum(knn_fit_2$fit$data$Radius),2)), '1473d70e5646a26de3c52aa1abd85b1f')424expect_equal(digest(int_round(sum(knn_fit_2$fit$data$Concavity),2)), '1473d70e5646a26de3c52aa1abd85b1f')425})426test_that('knn_fit_2 does not contain knn_spec_2', {427expect_equal(digest(as.numeric(get_expr(knn_fit_2$spec$args$neighbors))), '90a7653d717dc1553ee564aa27b749b9')428expect_equal(digest(as.character(get_expr(knn_fit_2$spec$args$weight_func))), '989de78e881829b4499af3610dfe54fd')429expect_equal(digest(knn_fit_2$spec$mode), 'f361ba6f6b32d068e56f61f53d35e26a')430})431test_that('Did not create an object named new_obs_2',{432expect_true(exists("new_obs_2"))433})434test_that('new_obs_2 is not a tibble', {435expect_true('data.frame' %in% class(new_obs_2))436})437test_that('Wrong values for Symmetry, Radius, and Concavity', {438expect_equal(int_round(new_obs_2$Symmetry, 0), 1)439expect_equal(int_round(new_obs_2$Radius, 0), 0)440expect_equal(int_round(new_obs_2$Concavity, 0), 1)441})442test_that('Did not create an object named class_prediction_2',{443expect_true(exists("class_prediction_2"))444})445test_that('Wrong class prediction', {446expect_equal(digest(as.character(class_prediction_2$.pred_class)), '5f0922939c45ef1054f852e83f91c660')447})448print("Success!")449}450451test_3.5 <- function(){452test_that('Did not create a object named knn_recipe', {453expect_true(exists("knn_recipe"))454})455test_that('knn_recipe is not a recipe object', {456expect_equal(digest(class(knn_recipe)), '4b3ed1334bff94d43e32a36a1f16a2f2')457})458test_that('knn_recipe does not remove ID', {459expect_false("ID" %in% (knn_recipe %>% prep() %>% bake(cancer) %>% colnames()))460})461test_that('cancer does not contain the correct data.', {462expect_equal(dim(bake(prep(knn_recipe), cancer)), c(569,11))463})464print("Success!")465}466467test_3.6 <- function(){468test_that('Did not create an object named knn_workflow', {469expect_true(exists("knn_workflow"))470})471test_that('knn_workflow is not a workflow', {472expect_true('workflow' %in% class(knn_workflow))473})474test_that('knn_workflow does not contain the right model specification', {475expect_equal(int_round(get_expr(knn_workflow$fit$actions$model$spec$args$neighbors),0), 7)476})477test_that('Did not add knn_recipe', {478expect_true('recipe' %in% class(knn_workflow$pre$actions$recipe$recipe))479})480test_that('knn_recipe does not contain the cancer dataset', {481expect_equal(digest(int_round(sum(knn_workflow$pre$actions$recipe$recipe$template$Radius),2)), '1473d70e5646a26de3c52aa1abd85b1f')482expect_equal(digest(int_round(sum(knn_workflow$pre$actions$recipe$recipe$template$Area),2)), '1473d70e5646a26de3c52aa1abd85b1f')483})484print("Success!")485}486487test_3.7 <- function(){488test_that('Did not create an object named class_prediction_all',{489expect_true(exists("class_prediction_all"))490})491test_that('Wrong class prediction', {492expect_equal(digest(as.character(class_prediction_all$.pred_class)), '3a5505c06543876fe45598b5e5e5195d')493})494print("Success!")495}496497test_4.0 <- function(){498test_that('Solution is incorrect', {499expect_equal(digest(as.character(answer4.0)), '75f1160e72554f4270c809f041c7a776')500})501print("Success!")502}503504test_4.1 <- function(){505test_that('Solution is incorrect', {506expect_equal(digest(as.character(answer4.1)), '475bf9280aab63a82af60791302736f6')507})508print("Success!")509}510511512