AMR/tests/testthat/test-freq.R

180 lines
7.1 KiB
R
Raw Normal View History

# ==================================================================== #
# TITLE #
# Antimicrobial Resistance (AMR) Analysis #
# #
2019-01-02 23:24:07 +01:00
# SOURCE #
# https://gitlab.com/msberends/AMR #
# #
# LICENCE #
2019-01-02 23:24:07 +01:00
# (c) 2019 Berends MS (m.s.berends@umcg.nl), Luz CF (c.f.luz@umcg.nl) #
# #
2019-01-02 23:24:07 +01:00
# This R package is free software; you can freely use and distribute #
# it for both personal and commercial purposes under the terms of the #
# GNU General Public License version 2.0 (GNU GPL-2), as published by #
# the Free Software Foundation. #
# #
# This R package was created for academic research and was publicly #
# released in the hope that it will be useful, but it comes WITHOUT #
# ANY WARRANTY OR LIABILITY. #
2019-04-05 18:47:39 +02:00
# Visit our website for more info: https://msberends.gitlab.io/AMR. #
# ==================================================================== #
context("freq.R")
test_that("frequency table works", {
library(dplyr)
2018-07-02 09:34:20 +02:00
expect_equal(nrow(freq(c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5))), 5)
expect_equal(nrow(frequency_tbl(c(1, 1, 2, 2, 3, 3, 4, 4, 5, 5))), 5)
2018-09-24 23:33:29 +02:00
# date column of septic_patients should contain 1140 unique dates
expect_equal(nrow(freq(septic_patients$date)), 1140)
2018-07-02 09:34:20 +02:00
expect_equal(nrow(freq(septic_patients$date)),
length(unique(septic_patients$date)))
expect_output(print(septic_patients %>% freq(age)))
expect_output(print(septic_patients %>% freq(age, nmax = 5)))
2018-12-29 22:24:19 +01:00
expect_output(print(septic_patients %>% freq(age, nmax = Inf, markdown = FALSE)))
2018-08-23 21:27:15 +02:00
expect_output(print(freq(septic_patients$age, nmax = Inf)))
expect_output(print(freq(septic_patients$age, nmax = NA)))
expect_output(print(freq(septic_patients$age, nmax = NULL)))
expect_output(print(freq(septic_patients$age, sort.count = FALSE)))
expect_output(print(freq(septic_patients$age, markdown = TRUE)))
expect_output(print(freq(septic_patients$age, markdown = TRUE), markdown = FALSE))
expect_output(print(freq(septic_patients$age, markdown = TRUE), markdown = TRUE))
expect_output(print(freq(septic_patients$age[0])))
expect_output(print(freq(septic_patients$age, quote = TRUE)))
2018-10-31 12:10:49 +01:00
expect_output(print(freq(septic_patients$age, markdown = TRUE, title = "TITLE")))
2018-08-23 21:27:15 +02:00
2018-07-09 14:02:58 +02:00
# character
2018-09-24 23:33:29 +02:00
expect_output(suppressWarnings(print(freq(microorganisms$fullname))))
2018-12-10 10:13:40 +01:00
# mo
expect_output(print(freq(septic_patients$mo)))
2018-12-30 09:31:54 +01:00
# rsi
2019-05-10 16:44:59 +02:00
expect_output(print(freq(septic_patients$AMX)))
2018-07-09 14:02:58 +02:00
# integer
2018-07-01 21:40:37 +02:00
expect_output(print(freq(septic_patients$age)))
2018-06-20 14:47:37 +02:00
# date
2018-07-01 21:40:37 +02:00
expect_output(print(freq(septic_patients$date)))
2018-06-20 14:47:37 +02:00
# factor
2018-07-01 21:40:37 +02:00
expect_output(print(freq(septic_patients$hospital_id)))
2018-07-09 14:02:58 +02:00
# table
2018-09-29 21:54:32 +02:00
expect_output(print(freq(table(septic_patients$gender, septic_patients$age))))
2018-08-01 22:37:28 +02:00
# rsi
2019-05-10 16:44:59 +02:00
expect_output(print(freq(septic_patients$AMC)))
2018-08-23 21:27:15 +02:00
# hms
expect_output(suppressWarnings(print(freq(hms::as.hms(sample(c(0:86399), 50))))))
# matrix
expect_output(print(freq(as.matrix(septic_patients$age))))
2018-09-29 21:54:32 +02:00
expect_output(print(freq(as.matrix(septic_patients[, c("age", "gender")]))))
# list
expect_output(print(freq(list(age = septic_patients$age))))
2018-09-29 21:54:32 +02:00
expect_output(print(freq(list(age = septic_patients$age, gender = septic_patients$gender))))
2018-10-12 16:35:18 +02:00
# difftime
expect_output(suppressWarnings(print(
freq(difftime(Sys.time(),
Sys.time() - runif(5, min = 0, max = 60 * 60 * 24),
units = "hours")))))
library(dplyr)
2018-07-01 21:40:37 +02:00
expect_output(septic_patients %>% select(1:2) %>% freq() %>% print())
expect_output(septic_patients %>% select(1:3) %>% freq() %>% print())
expect_output(septic_patients %>% select(1:4) %>% freq() %>% print())
expect_output(septic_patients %>% select(1:5) %>% freq() %>% print())
expect_output(septic_patients %>% select(1:6) %>% freq() %>% print())
expect_output(septic_patients %>% select(1:7) %>% freq() %>% print())
expect_output(septic_patients %>% select(1:8) %>% freq() %>% print())
expect_output(septic_patients %>% select(1:9) %>% freq() %>% print())
2018-08-24 14:18:38 +02:00
expect_output(print(freq(septic_patients$age), nmax = 20))
2018-06-20 14:47:37 +02:00
2018-11-06 16:41:59 +01:00
# grouping variable
expect_output(print(septic_patients %>% group_by(gender) %>% freq(hospital_id)))
2019-05-10 16:44:59 +02:00
expect_output(print(septic_patients %>% group_by(gender) %>% freq(AMX, quote = TRUE)))
expect_output(print(septic_patients %>% group_by(gender) %>% freq(AMX, markdown = TRUE)))
2018-11-06 16:41:59 +01:00
2019-01-28 11:20:32 +01:00
# quasiquotation
expect_output(print(septic_patients %>% freq(mo_genus(mo))))
expect_output(print(septic_patients %>% freq(mo, mo_genus(mo))))
expect_output(print(septic_patients %>% group_by(gender) %>% freq(mo_genus(mo))))
expect_output(print(septic_patients %>% group_by(gender) %>% freq(mo, mo_genus(mo))))
2018-06-20 14:47:37 +02:00
# top 5
expect_equal(
septic_patients %>%
2018-08-31 13:36:19 +02:00
freq(mo) %>%
2018-06-20 14:47:37 +02:00
top_freq(5) %>%
length(),
5)
# there are more than 5 lowest values
2018-06-20 14:47:37 +02:00
expect_gt(
septic_patients %>%
2018-08-31 13:36:19 +02:00
freq(mo) %>%
2018-06-20 14:47:37 +02:00
top_freq(-5) %>%
length(),
5)
# n has length > 1
expect_error(
septic_patients %>%
2018-08-31 13:36:19 +02:00
freq(mo) %>%
2018-06-20 14:47:37 +02:00
top_freq(n = c(1, 2))
)
# input must be freq tbl
expect_error(septic_patients %>% top_freq(1))
2018-07-08 22:14:55 +02:00
# charts from plot and hist, should not raise errors
plot(freq(septic_patients, age))
hist(freq(septic_patients, age))
2018-07-09 14:02:58 +02:00
# check vector
expect_identical(septic_patients %>%
freq(age) %>%
as.vector() %>%
sort(),
septic_patients %>%
pull(age) %>%
sort())
2018-07-30 00:57:49 +02:00
# check format
expect_identical(septic_patients %>%
freq(age) %>%
format() %>%
apply(2, class) %>%
unname(),
rep("character", 5))
# check tibble
expect_identical(septic_patients %>%
freq(age) %>%
as_tibble() %>%
class() %>%
.[1],
"tbl_df")
expect_error(septic_patients %>% freq(nonexisting))
expect_error(septic_patients %>% select(1:10) %>% freq())
2019-05-10 16:44:59 +02:00
expect_error(septic_patients %>% freq(peni, oxac, clox, AMX, AMC,
ampi, pita, czol, cfep, cfur))
# (un)select columns
expect_equal(septic_patients %>% freq(hospital_id) %>% select(item) %>% ncol(),
1)
expect_equal(septic_patients %>% freq(hospital_id) %>% select(-item) %>% ncol(),
4)
2018-10-01 14:44:40 +02:00
# run diff
expect_output(print(
2019-05-10 16:44:59 +02:00
diff(freq(septic_patients$AMC),
freq(septic_patients$AMX))
2018-10-01 14:44:40 +02:00
))
expect_output(print(
diff(freq(septic_patients$age),
2018-10-12 16:35:18 +02:00
freq(septic_patients$age)) # "No differences found."
2018-10-01 14:44:40 +02:00
))
expect_error(print(
2019-05-10 16:44:59 +02:00
diff(freq(septic_patients$AMX),
2018-10-01 14:44:40 +02:00
"Just a string") # not a freq tbl
))
})