1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
|
source("incl/start,load-only.R")
stop_if_not <- future.apply:::stop_if_not
message("*** utils ...")
message("*** hpaste() ...")
# Some vectors
x <- 1:6
y <- 10:1
z <- LETTERS[x]
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# Abbreviation of output vector
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
printf("x = %s.\n", hpaste(x))
## x = 1, 2, 3, ..., 6.
printf("x = %s.\n", hpaste(x, maxHead = 2))
## x = 1, 2, ..., 6.
printf("x = %s.\n", hpaste(x, maxHead = 3)) # Default
## x = 1, 2, 3, ..., 6.
# It will never output 1, 2, 3, 4, ..., 6
printf("x = %s.\n", hpaste(x, maxHead = 4))
## x = 1, 2, 3, 4, 5 and 6.
# Showing the tail
printf("x = %s.\n", hpaste(x, maxHead = 1, maxTail = 2))
## x = 1, ..., 5, 6.
# Turning off abbreviation
printf("y = %s.\n", hpaste(y, maxHead = Inf))
## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
## ...or simply
printf("y = %s.\n", paste(y, collapse = ", "))
## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1
# Change last separator
printf("x = %s.\n", hpaste(x, lastCollapse = " and "))
## x = 1, 2, 3, 4, 5 and 6.
# No collapse
stopifnot(all(hpaste(x, collapse = NULL) == x))
# Empty input
stopifnot(identical(hpaste(character(0)), character(0)))
message("*** hpaste() ...")
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# debug()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
message("*** mdebug() ...")
mdebug("Hello #", 1)
mdebugf("Hello #%d", 1)
options(future.debug = TRUE)
mdebug("Hello #", 2)
mdebugf("Hello #%d", 2)
options(future.debug = FALSE)
mdebug("Hello #", 3)
mdebugf("Hello #%d", 3)
message("*** mdebug() ... DONE")
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
# import_from()
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
message("*** import_from() ...")
obj <- import_from("non-existing-fcn", default = NA, package = "future")
stopifnot(identical(obj, NA))
res <- tryCatch({
obj <- import_from("non-existing-fcn", package = "future")
}, error = identity)
print(res)
stopifnot(inherits(res, "simpleError"))
message("*** import_from() ... DONE")
message("*** stop_if_not() ...")
stop_if_not(TRUE)
stop_if_not(TRUE, TRUE)
res <- tryCatch({
stop_if_not(FALSE)
}, error = identity)
stopifnot(inherits(res, "simpleError"))
res <- tryCatch({
stop_if_not(list(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
}, error = identity)
stopifnot(inherits(res, "simpleError"))
message("*** stop_if_not() ... DONE")
message("*** assert_values2() ...")
assert_values2 <- future.apply:::assert_values2
assert_values2(nX = 2L, values2 = as.list(1:2))
res <- tryCatch({
assert_values2(nX = 1L, values = as.list(1:2), values2 = as.list(1:2), fcn = "tests", debug = TRUE)
}, error = identity)
stopifnot(inherits(res, "FutureError"))
message("*** assert_values2() ... DONE")
message("*** utils ... DONE")
source("incl/end.R")
|
