1## tests for digest, taken from the examples in the manual page
2
3suppressMessages(library(digest))
4
5
6# zap small numbers to zero
7zapsmall <- 1:10
8border <- 2 ^ floor(log2(10 ^ -zapsmall))
9expect_equal(
10    sapply(
11        seq_along(zapsmall),
12        function(i) { digest:::num2hex(border[i] * -1:1, digits = 6, zapsmall = zapsmall[i]) }
13    ),
14    matrix(
15        "0",
16        ncol = length(zapsmall),
17        nrow = 3
18    )
19)
20
21# handle 0 correct
22expect_equal(digest:::num2hex(0), "0")
23
24
25# digits are consistent
26x <- pi
27x.hex <- sapply(1:16, digest:::num2hex, x = x)
28x.hex <- x.hex[c(TRUE, diff(nchar(x.hex)) > 0)]
29exponent <-  unique(gsub("^[0-9a-f]* ", "", x.hex))
30expect_equal(length(exponent), 1L)
31
32mantissa <- gsub(" [0-9]*$", "", x.hex)
33ignore(expect_true)(all(
34    sapply(
35        head(seq_along(mantissa), -1),
36        function(i){
37            all(
38                grepl(
39                    paste0("^", mantissa[i], ".*"),
40                    tail(mantissa, -i)
41                )
42            )
43        }
44    )
45))
46
47#it keeps NA values
48x <- c(pi, NA, 0)
49expect_equal(is.na(digest:::num2hex(x)), is.na(x))
50
51x <- c(pi, NA, pi)
52expect_equal(is.na(digest:::num2hex(x)), is.na(x))
53
54x <- as.numeric(c(NA, NA, NA))
55expect_equal(is.na(digest:::num2hex(x)), is.na(x))
56
57
58# handles empty vectors
59expect_equal(digest:::num2hex(numeric(0)), character(0))
60
61
62# example from FAQ 7.31
63# tests if all trailing zero's are removed
64expect_true(identical(digest:::num2hex(2, digits = 14),
65                    digest:::num2hex(sqrt(2) ^ 2, digits = 14)))
66
67expect_true(!identical(digest:::num2hex(2, digits = 15),
68                     digest:::num2hex(sqrt(2) ^ 2, digits = 15)))
69