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