Path: blob/master/2021-spring/materials/worksheet_10/tests_worksheet_10.R
2051 views
# +1library(testthat)2library(digest)34int_round <- function(x, digits){5x = x*10^digits6xint = as.integer(x)7xint1 = xint + 1L8if (abs(xint - x) < abs(xint1 - x)){9return(xint)10}11else {12return(xint1)13}14}15# -1617# Round double to precise integer18#19# `int_round` works to create an integer corresponding to a number that is20# tested up to a particular decimal point of precision. This is useful when21# there is a need to compare a numeric value using hashes.22#23# @param x Double vector of length one.24# @param digits Double vector of length one to specify decimal point of precision. Negative numbers can be used to specifying significant digits > 0.1.25#26# @return Integer vector of length one corresponding to a particular decimal point of precision.27#28# @examples29# # to get an integer up to two decimals of precision from 234.5678930# int_round(234.56789, 2)31#32# to get an integer rounded to the hundred digit from 234.5678933# int_round(234.56789, -2)3435test_0.0 <- function(){36test_that('Solution is incorrect', {37expect_equal(digest(answer0.0), '01a75cb73d67b0f895ff0e61449c7bf8')38})39print("Success!")40}41test_0.1 <- function(){42test_that('Solution is incorrect', {43expect_equal(digest(answer0.1), 'd19d62a873f08af0488f0df720cfd293')44})45print("Success!")46}4748test_1.0 <- function(){49test_that('Did not create an object named beer', {50expect_true(exists("beer"))51})52test_that('beer should be a tibble.', {53expect_true('tbl' %in% class(beer))54})55test_that('beer does not contain the correct number of rows and/or columns.', {56expect_equal(dim(beer), c(2410, 8))57})58test_that('The beer tibble is missing columns.', {59expect_true("abv" %in% colnames(beer))60expect_true("ibu" %in% colnames(beer))61expect_true("id" %in% colnames(beer))62expect_true("name" %in% colnames(beer))63expect_true("style" %in% colnames(beer))64expect_true("brewery_id" %in% colnames(beer))65expect_true("ounces" %in% colnames(beer))66})67print("Success!")68}6970test_1.1 <- function(){71properties <- c(beer_eda$layers[[1]]$mapping, beer_eda$mapping)72labels <- beer_eda$labels73test_that('Did not create a plot named beer_eda', {74expect_true(exists("beer_eda"))75})76test_that('ibu should be on the x-axis.', {77expect_true("ibu" == rlang::get_expr(properties$x))78})79test_that('abv should be on the y-axis.', {80expect_true("abv" == rlang::get_expr(properties$y))81})82test_that('beer_eda should be a scatter plot.', {83expect_true("GeomPoint" %in% c(class(beer_eda$layers[[1]]$geom)))84})85test_that('Labels on the axes should be descriptive and human readable.', {86expect_false((labels$y) == 'abv')87expect_false((labels$x) == 'ibu')88})89print("Success!")90}9192test_1.2 <- function(){93test_that('Did not create an object named clean_beer', {94expect_true(exists("clean_beer"))95})96test_that('clean_beer should be a tibble.', {97expect_true('tbl' %in% class(clean_beer))98})99test_that('clean_beer should only contain the columns ibu and abv', {100expect_true("ibu" %in% colnames(clean_beer))101expect_true("abv" %in% colnames(clean_beer))102expect_false("id" %in% colnames(clean_beer))103expect_false("name" %in% colnames(clean_beer))104expect_false("style" %in% colnames(clean_beer))105expect_false("brewery_id" %in% colnames(clean_beer))106expect_false("ounces" %in% colnames(clean_beer))107})108test_that('clean_beer does not contain the correct number of rows and/or columns.', {109expect_equal(dim(clean_beer), c(1405, 2))110})111112print("Success!")113}114115test_1.3.1 <- function(){116test_that('Solution is incorrect', {117expect_equal(digest(answer1.3.1), '75f1160e72554f4270c809f041c7a776')118})119print("Success!")120}121122test_1.3.2 <- function(){123test_that('Did not create an object named scaled_beer', {124expect_true(exists("scaled_beer"))125})126test_that('scaled_beer should be a tibble.', {127expect_true('tbl' %in% class(scaled_beer))128})129test_that('scaled_beer does not contain the correct number of rows and/or columns.', {130expect_equal(dim(scaled_beer), c(1405, 2))131})132test_that('scaled_beer should only contain the columns ibu and abv', {133expect_true("ibu" %in% colnames(clean_beer))134expect_true("abv" %in% colnames(clean_beer))135expect_false("id" %in% colnames(clean_beer))136expect_false("name" %in% colnames(clean_beer))137expect_false("style" %in% colnames(clean_beer))138expect_false("brewery_id" %in% colnames(clean_beer))139expect_false("ounces" %in% colnames(clean_beer))140})141test_that('Columns in scaled_beer are not scaled correctly.', {142expect_true(min(scaled_beer$ibu) < 1)143expect_true(max(scaled_beer$ibu) < 4)144expect_true(min(scaled_beer$abv) < -2)145expect_true(max(scaled_beer$abv) < 5)146})147print("Success!")148}149150test_1.4 <- function(){151test_that('beer_cluster_k2 class should be kmeans', {152expect_equal(class(beer_cluster_k2), 'kmeans')153})154test_that('beer_cluster_k2 should have 2 centers', {155expect_equal(int_round(nrow(beer_cluster_k2$centers), 0), 2)156})157test_that('Solution is incorrect', {158expect_equal(int_round(beer_cluster_k2$tot.withinss, 0), 1110)159})160print("Success!")161}162163test_1.5 <- function(){164test_that('tidy_beer_cluster_k2 should contain the columns: abv, ibu, and .cluster', {165expect_true('abv' %in% colnames(tidy_beer_cluster_k2))166expect_true('ibu' %in% colnames(tidy_beer_cluster_k2))167expect_true('.cluster' %in% colnames(tidy_beer_cluster_k2))168})169test_that('tidy_beer_cluster_k2 contains an incorrect number of rows and/or columns.', {170expect_equal(int_round(nrow(tidy_beer_cluster_k2), 0), 1405)171expect_equal(int_round(ncol(tidy_beer_cluster_k2), 0), 3)172})173print("Success!")174}175176test_1.6 <- function(){177properties <- c(tidy_beer_cluster_k2_plot$layers[[1]]$mapping, tidy_beer_cluster_k2_plot$mapping)178labels <- tidy_beer_cluster_k2_plot$labels179test_that('Did not create a plot named tidy_beer_cluster_k2_plot', {180expect_true(exists("tidy_beer_cluster_k2_plot"))181})182test_that('tidy_beer_cluster_k2_plot should contain information from tidy_beer_cluster_k2', {183expect_equal(tidy_beer_cluster_k2_plot$data, tidy_beer_cluster_k2)184})185test_that('ibu should be on the x-axis.', {186expect_true("ibu" == rlang::get_expr(properties$x))187})188test_that('abv should be on the y-axis.', {189expect_true("abv" == rlang::get_expr(properties$y))190})191test_that('.cluster should be used to colour the points.', {192expect_true(".cluster" == rlang::get_expr(properties$colour))193})194test_that('tidy_beer_cluster_k2_plot should be a scatter plot.', {195expect_true("GeomPoint" %in% c(class(tidy_beer_cluster_k2_plot$layers[[1]]$geom)))196})197test_that('Labels on the axes should be descriptive and human readable.', {198expect_false((labels$y) == 'abv')199expect_false((labels$x) == 'ibu')200expect_false((labels$colour) == '.cluster')201})202print("Success!")203}204205test_1.7.1 <- function(){206test_that('Solution is incorrect', {207expect_equal(digest(answer1.7.1), '475bf9280aab63a82af60791302736f6')208})209print("Success!")210}211212test_1.7.2 <- function(){213test_that('beer_cluster_k2_model_stats should be a tibble.', {214expect_true('tbl' %in% class(beer_cluster_k2_model_stats))215})216test_that('beer_cluster_k2_model_stats should have 1 row of 4 different statistics.', {217expect_equal(dim(beer_cluster_k2_model_stats), c(1, 4))218})219test_that('beer_cluster_k2_model_stats should contain total within sum of squares (tot.withinss).', {220expect_true('tot.withinss' %in% colnames(beer_cluster_k2_model_stats))221})222print("Success!")223}224225test_1.8 <- function(){226test_that('beer_ks should be a tbl.', {227expect_true('tbl' %in% class(beer_ks))228})229test_that('beer_ks should have 1 column containing k values from 1 to 10.', {230expect_equal(int_round(nrow(beer_ks), 0), 10)231expect_equal(int_round(ncol(beer_ks), 0), 1)232expect_equal(colnames(beer_ks), 'k')233})234print("Success!")235}236237test_1.9 <- function(){238test_that('beer_clustering does not contain the correct number of rows and/or columns.', {239expect_equal(dim(beer_clustering), c(10, 2))240})241test_that('beer_clustering should contain the columns k and models', {242expect_true('k' %in% colnames(beer_clustering))243expect_true('models' %in% colnames(beer_clustering))244})245test_that('The models column in beer_clustering should be of class kmeans', {246expect_equal(class(beer_clustering$models[[1]]), 'kmeans')247})248print("Success!")249}250251test_2.0 <- function(){252test_that('beer_model_stats does not contain the correct number of rows and/or columns.', {253expect_equal(dim(beer_model_stats), c(10, 3))254})255test_that('beer_model_stats should contain the columns k, models, and model_statistics', {256expect_true('k' %in% colnames(beer_model_stats))257expect_true('models' %in% colnames(beer_model_stats))258expect_true('model_statistics' %in% colnames(beer_model_stats))259})260test_that('The models column in beer_model_stats should be of class kmeans', {261expect_equal(class(beer_model_stats$models[[1]]), 'kmeans')262})263test_that('The model_statistics column in beer_model_stats should be a tibble.', {264expect_true('tbl' %in% class(beer_model_stats$model_statistics[[1]]))265})266print("Success!")267}268269test_2.1 <- function(){270test_that('Solution is incorrect', {271expect_equal(int_round(nrow(beer_clustering_unnested), 0), 10)272expect_equal(int_round(ncol(beer_clustering_unnested), 0), 6)273expect_true('k' %in% colnames(beer_clustering_unnested))274expect_true('models' %in% colnames(beer_clustering_unnested))275expect_false('model_statistics' %in% colnames(beer_clustering_unnested))276expect_equal(class(beer_clustering_unnested$models[[1]]), 'kmeans')277expect_true('tot.withinss' %in% colnames(beer_clustering_unnested))278})279print("Success!")280}281282283test_2.2 <- function(){284properties <- c(choose_beer_k$layers[[1]]$mapping, choose_beer_k$mapping)285labels <- choose_beer_k$labels286test_that('Did not create a plot named choose_beer_k', {287expect_true(exists("choose_beer_k"))288})289test_that('# clusters should be on the x-axis.', {290expect_true("k" == rlang::get_expr(properties$x))291})292test_that('total within-cluster sum-of-squares should be on the y-axis.', {293expect_true("tot.withinss" == rlang::get_expr(properties$y))294})295test_that('choose_beer_k should be a line and scatter plot.', {296expect_true("GeomLine" %in% c(class(choose_beer_k$layers[[1]]$geom),class(choose_beer_k$layers[[2]]$geom)))297})298test_that('choose_beer_k should be a line and scatter plot.', {299expect_true("GeomPoint" %in% c(class(choose_beer_k$layers[[1]]$geom),class(choose_beer_k$layers[[2]]$geom)))300})301test_that('Labels on the axes should be descriptive and human readable.', {302expect_false((labels$y) == 'tot.withinss')303expect_false((labels$x) == 'k')304})305print("Success!")306}307308test_2.3 <- function(){309test_that('Solution is incorrect', {310expect_true(digest(answer2.3) %in% c('0e4033b8c0b56afbea35dc749ced4e1d', 'd19d62a873f08af0488f0df720cfd293'))311})312print("Success!")313}314315test_2.4 <- function(){316test_that('Solution is incorrect', {317expect_equal(digest(answer2.4), '475bf9280aab63a82af60791302736f6')318})319print("Success!")320}321322test_2.5 <- function(){323test_that('Solution is incorrect', {324expect_equal(digest(answer2.5), '3a5505c06543876fe45598b5e5e5195d')325})326print("Success!")327}328329test_2.6 <- function(){330test_that('Solution is incorrect', {331expect_equal(digest(answer2.6), '05ca18b596514af73f6880309a21b5dd')332})333print("Success!")334}335336