-
Notifications
You must be signed in to change notification settings - Fork 0
/
modifiers.R
91 lines (72 loc) · 1.97 KB
/
modifiers.R
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
#' Equal length vector generator
#'
#' Generates equal length vectors contained in a list.
#'
#' @param ... A set of named or unnamed vector generators.
#' @template len
#'
#' @examples
#' equal_length(integer_(), double_()) %>% show_example()
#' equal_length(a = logical_(), b = character_(), len = 5L) %>% show_example()
#' @template generator
#' @export
equal_length <- function(..., len = c(1L, 10L)) {
assert_all_modifiable_length(...)
len_generator <-
as_length_generator(len)
generate_list <-
function(a) purrr::map(list(...), function(f) f(len2 = a))
qc_gen(function()
hedgehog::gen.and_then(
len_generator(),
generate_list
)
)
}
vectorize <- function(generator, len = 1L) {
if (is_zero(len))
empty_vectors(generator)
else if (length(len) == 1L)
fixed_length_vectors(generator, len)
else if (len[1L] == 0L)
empty_or_variable_length_vectors(generator, len)
else
variable_length_vectors(generator, len)
}
empty_vectors <- function(generator) {
hedgehog::gen.with(generator, function(a) a[0L])
}
fixed_length_vectors <- function(generator, len) {
hedgehog::gen.c(generator, of = len)
}
variable_length_vectors <- function(generator, len) {
hedgehog::gen.c(generator, len[1L], len[2L])
}
empty_or_variable_length_vectors <- function(generator, len) {
hedgehog::gen.c(generator, len[1L] + 1L, len[2L]) %>%
replace_frac_empty(frac = 0.25)
}
replace_frac_empty <- function(generator, frac) {
replace_frac <-
function(a)
if (stats::runif(1L) <= frac)
a[0L]
else
a
hedgehog::gen.with(generator, replace_frac)
}
replace_frac_with <- function(generator, replacement, frac) {
replace_frac <-
function(a)
if (stats::runif(1L) <= frac)
replacement
else
a
hedgehog::gen.with(generator, replace_frac)
}
replace_some_with <- function(generator, replacement, replace) {
if (replace)
replace_frac_with(generator, replacement, frac = 0.25)
else
generator
}