├── .Rbuildignore ├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ ├── pkgdown.yml │ └── test-coverage.yaml ├── .gitignore ├── DESCRIPTION ├── LICENSE ├── LICENSE.md ├── NAMESPACE ├── NEWS.md ├── R ├── any.R ├── character.R ├── constant.R ├── data-table.R ├── data_frame.R ├── date.R ├── double.R ├── factor.R ├── for_all.R ├── hms.R ├── integer.R ├── list.R ├── logical.R ├── modifiers.R ├── numeric.R ├── one_of.R ├── other.R ├── posixct.R ├── repeat_test.R ├── testthat-suites.R ├── tibble.R ├── utils-pipe.R └── utils.R ├── README.Rmd ├── README.md ├── _pkgdown.yml ├── codecov.yml ├── cran-comments.md ├── man-roxygen ├── any_empty.R ├── any_inf.R ├── any_na.R ├── any_nan.R ├── big_dbl.R ├── big_int.R ├── big_num.R ├── cols.R ├── generator.R ├── left.R ├── len.R ├── param_generator.R ├── right.R └── rows.R ├── man ├── any_atomic.Rd ├── any_data.table.Rd ├── any_data_frame.Rd ├── any_flat_homogeneous_list.Rd ├── any_flat_list.Rd ├── any_list.Rd ├── any_tibble.Rd ├── any_undefined.Rd ├── any_vector.Rd ├── anything.Rd ├── as_hedgehog.Rd ├── character_.Rd ├── constant.Rd ├── data.table_.Rd ├── data.table_of.Rd ├── data_frame_.Rd ├── data_frame_of.Rd ├── date_.Rd ├── double_.Rd ├── equal_length.Rd ├── factor_.Rd ├── figures │ └── hex.png ├── flat_list_of.Rd ├── for_all.Rd ├── from_hedgehog.Rd ├── hms_.Rd ├── integer_.Rd ├── list_.Rd ├── list_of.Rd ├── logical_.Rd ├── numeric_.Rd ├── one_of.Rd ├── pipe.Rd ├── posixct_.Rd ├── repeat_test.Rd ├── show_example.Rd ├── tibble_.Rd └── tibble_of.Rd ├── pkgdown ├── extra.css └── favicon │ ├── apple-touch-icon-120x120.png │ ├── apple-touch-icon-152x152.png │ ├── apple-touch-icon-180x180.png │ ├── apple-touch-icon-60x60.png │ ├── apple-touch-icon-76x76.png │ ├── apple-touch-icon.png │ ├── favicon-16x16.png │ ├── favicon-32x32.png │ └── favicon.ico ├── quickcheck.Rproj └── tests ├── testthat.R └── testthat ├── setup.R ├── test-any_atomic.R ├── test-any_data-table.R ├── test-any_data_frame.R ├── test-any_flat_homogeneous_list.R ├── test-any_flat_list.R ├── test-any_list.R ├── test-any_tibble.R ├── test-any_undefined.R ├── test-any_vector.R ├── test-anything.R ├── test-as_hedgehog.R ├── test-character.R ├── test-constant.R ├── test-data-table.R ├── test-data-table_of.R ├── test-data_frame.R ├── test-data_frame_of.R ├── test-date.R ├── test-double.R ├── test-equal_length.R ├── test-factor.R ├── test-flat_list_of.R ├── test-for_all.R ├── test-from_hedgehog.R ├── test-hms.R ├── test-integer.R ├── test-list.R ├── test-list_of.R ├── test-logical.R ├── test-numeric.R ├── test-one_of.R ├── test-posixct.R ├── test-printing.R ├── test-repeat_test.R ├── test-show_example.R ├── test-tibble.R ├── test-tibble_of.R └── test-utils.R /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^LICENSE\.md$ 4 | ^codecov\.yml$ 5 | ^README\.Rmd$ 6 | ^README-.*\.png$ 7 | ^_pkgdown\.yml$ 8 | ^pkgdown$ 9 | ^docs$ 10 | ^\.github$ 11 | ^man-roxygen$ 12 | ^cran-comments.md$ 13 | ^CRAN-RELEASE$ 14 | -------------------------------------------------------------------------------- /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | R_KEEP_PKG_SOURCE: yes 17 | steps: 18 | - uses: actions/checkout@v2 19 | 20 | - uses: r-lib/actions/setup-r@v1 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v1 25 | with: 26 | extra-packages: rcmdcheck 27 | 28 | - uses: r-lib/actions/check-r-package@v1 29 | 30 | - name: Show testthat output 31 | if: always() 32 | run: find check -name 'testthat.Rout*' -exec cat '{}' \; || true 33 | shell: bash 34 | 35 | - name: Upload check results 36 | if: failure() 37 | uses: actions/upload-artifact@main 38 | with: 39 | name: ${{ runner.os }}-r${{ matrix.config.r }}-results 40 | path: check 41 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | env: 18 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 19 | steps: 20 | - uses: actions/checkout@v2 21 | 22 | - uses: r-lib/actions/setup-pandoc@v2 23 | 24 | - uses: r-lib/actions/setup-r@v2 25 | with: 26 | use-public-rspm: true 27 | 28 | - uses: r-lib/actions/setup-r-dependencies@v2 29 | with: 30 | extra-packages: any::pkgdown, local::. 31 | needs: website 32 | 33 | - name: Deploy package 34 | if: github.event_name != 'pull_request' 35 | run: | 36 | git config --local user.name "$GITHUB_ACTOR" 37 | git config --local user.email "$GITHUB_ACTOR@users.noreply.github.com" 38 | Rscript -e 'pkgdown::deploy_to_branch(new_process = FALSE)' 39 | - name: Build site without deploying 40 | if: github.event_name == 'pull_request' 41 | run: | 42 | Rscript -e 'pkgdown::build_site(preview = FALSE, install = FALSE)' 43 | -------------------------------------------------------------------------------- /.github/workflows/test-coverage.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: test-coverage 10 | 11 | jobs: 12 | test-coverage: 13 | runs-on: ubuntu-latest 14 | env: 15 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 16 | 17 | steps: 18 | - uses: actions/checkout@v2 19 | 20 | - uses: r-lib/actions/setup-r@v1 21 | with: 22 | use-public-rspm: true 23 | 24 | - uses: r-lib/actions/setup-r-dependencies@v1 25 | with: 26 | extra-packages: covr 27 | 28 | - name: Test coverage 29 | run: covr::codecov() 30 | shell: Rscript {0} 31 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user 2 | .Rhistory 3 | .RData 4 | .Ruserdata 5 | .DS_Store 6 | docs 7 | inst/doc 8 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Package: quickcheck 2 | Title: Property Based Testing 3 | Version: 0.1.3 4 | Authors@R: 5 | person(given = "Andrew", 6 | family = "McNeil", 7 | role = c("aut", "cre"), 8 | email = "andrew.richard.mcneil@gmail.com") 9 | Description: Property based testing, inspired by 10 | the original 'QuickCheck'. This package builds on 11 | the property based testing framework provided by 12 | 'hedgehog' and is designed to seamlessly integrate with 13 | 'testthat'. 14 | License: MIT + file LICENSE 15 | URL: https://github.com/armcn/quickcheck, https://armcn.github.io/quickcheck/ 16 | BugReports: https://github.com/armcn/quickcheck/issues 17 | Encoding: UTF-8 18 | LazyData: true 19 | Roxygen: list(markdown = TRUE) 20 | RoxygenNote: 7.2.2 21 | Imports: 22 | testthat (>= 3.0.0), 23 | hedgehog, 24 | purrr, 25 | tibble, 26 | data.table, 27 | hms, 28 | stats, 29 | magrittr 30 | Suggests: 31 | knitr, 32 | rmarkdown, 33 | covr, 34 | dplyr 35 | Config/testthat/edition: 3 36 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2021 2 | COPYRIGHT HOLDER: quickcheck authors 3 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2021 quickcheck authors 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | S3method(print,quickcheck_generator) 4 | export("%>%") 5 | export(any_atomic) 6 | export(any_data.table) 7 | export(any_data_frame) 8 | export(any_flat_homogeneous_list) 9 | export(any_flat_list) 10 | export(any_list) 11 | export(any_tibble) 12 | export(any_undefined) 13 | export(any_vector) 14 | export(anything) 15 | export(as_hedgehog) 16 | export(character_) 17 | export(character_alphanumeric) 18 | export(character_letters) 19 | export(character_numbers) 20 | export(constant) 21 | export(data.table_) 22 | export(data.table_of) 23 | export(data_frame_) 24 | export(data_frame_of) 25 | export(date_) 26 | export(date_bounded) 27 | export(date_left_bounded) 28 | export(date_right_bounded) 29 | export(double_) 30 | export(double_bounded) 31 | export(double_fractional) 32 | export(double_left_bounded) 33 | export(double_negative) 34 | export(double_positive) 35 | export(double_right_bounded) 36 | export(double_whole) 37 | export(equal_length) 38 | export(factor_) 39 | export(flat_list_of) 40 | export(for_all) 41 | export(from_hedgehog) 42 | export(hms_) 43 | export(hms_bounded) 44 | export(hms_left_bounded) 45 | export(hms_right_bounded) 46 | export(integer_) 47 | export(integer_bounded) 48 | export(integer_left_bounded) 49 | export(integer_negative) 50 | export(integer_positive) 51 | export(integer_right_bounded) 52 | export(list_) 53 | export(list_of) 54 | export(logical_) 55 | export(numeric_) 56 | export(numeric_bounded) 57 | export(numeric_left_bounded) 58 | export(numeric_negative) 59 | export(numeric_positive) 60 | export(numeric_right_bounded) 61 | export(one_of) 62 | export(posixct_) 63 | export(posixct_bounded) 64 | export(posixct_left_bounded) 65 | export(posixct_right_bounded) 66 | export(repeat_test) 67 | export(show_example) 68 | export(tibble_) 69 | export(tibble_of) 70 | importFrom(magrittr,"%>%") 71 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # quickcheck 0.1.3 2 | 3 | ## Internal changes 4 | 5 | - Prevented future failing test with R 4.4.0 because of `is.atomic` change. 6 | 7 | # quickcheck 0.1.2 8 | 9 | ## Bug fixes 10 | 11 | - Fixed bug with date generator when any_na = TRUE 12 | 13 | # quickcheck 0.1.1 14 | 15 | ## Internal changes 16 | 17 | - Now doesn't require R >= 4.1 18 | 19 | # quickcheck 0.1.0 20 | 21 | ## Major breaking changes 22 | 23 | - The default length for vector generators has been changed from 1 to a range 24 | between 1 and 10. 25 | - All parameters of the form `frac_` have been replaced with `any_`, which take 26 | a logical value instead of a double value. 27 | 28 | ## Features 29 | 30 | - New `character_letters` generates character vectors with only letters. 31 | - New `character_numbers` generates character vectors with only numbers. 32 | - New `character_alphanumeric` generates character vectors with letters and numbers. 33 | - New `flat_list_of` generates lists of atomic scalars. 34 | - New `data_frame_` generate data.frames. 35 | - New `data_frame_of` generate data.frames. 36 | - New `data.table_` generate data.tables. 37 | - New `data.table_of` generate data.tables. 38 | - New `anything` generates any R object. 39 | - New `any_flat_homogeneous_list` generates flat lists with homogeneous elements. 40 | - New `any_data_frame` generates any data.frames. 41 | - New `any_data.table` generates any data.tables. 42 | - New `any_undefined` generates undefined values. 43 | - New `equal_length` generates equal length vectors. 44 | - New `from_hedgehog` converts a hedgehog to a quickcheck generator. 45 | - New `as_hedgehog` converts a quickcheck to a hedgehog generator. 46 | - New `repeat_test` tests a property repeatedly. 47 | 48 | # quickcheck 0.0.1 49 | 50 | Initial version 51 | -------------------------------------------------------------------------------- /R/any.R: -------------------------------------------------------------------------------- 1 | #' Any R object generator 2 | #' 3 | #' Generate any R object. This doesn't actually generate any possible object, 4 | #' just the most common ones, namely atomic vectors, lists, data.frames, 5 | #' tibbles, data.tables, and undefined values like `NA`, `NULL`, `Inf`, and 6 | #' `NaN`. 7 | #' 8 | #' @param any_empty Whether empty vectors or data frames should be allowed. 9 | #' @param any_undefined Whether undefined values should be allowed. 10 | #' 11 | #' @examples 12 | #' anything() %>% show_example() 13 | #' @template generator 14 | #' @export 15 | anything <- function(any_empty = TRUE, any_undefined = TRUE) { 16 | size <- 17 | if (any_empty) 18 | c(0L, 10L) 19 | 20 | else 21 | c(1L, 10L) 22 | 23 | vector_generator <- 24 | any_vector( 25 | len = size, 26 | any_na = any_undefined 27 | ) 28 | 29 | tibble_generator <- 30 | any_tibble( 31 | rows = size, 32 | cols = size, 33 | any_na = any_undefined 34 | ) 35 | 36 | data_frame_generator <- 37 | any_data_frame( 38 | rows = size, 39 | cols = size, 40 | any_na = any_undefined 41 | ) 42 | 43 | data.table_generator <- 44 | any_data.table( 45 | rows = size, 46 | cols = size, 47 | any_na = any_undefined 48 | ) 49 | 50 | undefined_generator <- 51 | if (any_undefined) 52 | any_undefined() 53 | 54 | else 55 | NULL 56 | 57 | undefined_prob <- 58 | if (any_undefined) 59 | 0.1 60 | 61 | else 62 | NULL 63 | 64 | generator_list <- 65 | purrr::compact( 66 | list( 67 | vector_generator, 68 | tibble_generator, 69 | data_frame_generator, 70 | data.table_generator, 71 | undefined_generator, 72 | prob = c( 73 | 0.6, 74 | 0.1, 75 | 0.1, 76 | 0.1, 77 | undefined_prob 78 | ) 79 | ) 80 | ) 81 | 82 | do.call(one_of, generator_list) 83 | } 84 | 85 | #' Any atomic vector generator 86 | #' 87 | #' Generate vectors of integer, double, character, logical, date, POSIXct, hms, 88 | #' or factors. 89 | #' 90 | #' @template len 91 | #' @template any_na 92 | #' 93 | #' @examples 94 | #' any_atomic() %>% show_example() 95 | #' any_atomic(len = 10L, any_na = TRUE) %>% show_example() 96 | #' @template generator 97 | #' @export 98 | any_atomic <- function(len = c(1L, 10L), any_na = FALSE) { 99 | qc_gen(function(len2 = len) 100 | one_of( 101 | integer_(len2, any_na), 102 | double_(len2, any_na), 103 | character_(len2, any_na), 104 | logical_(len2, any_na), 105 | date_(len2, any_na), 106 | posixct_(len2, any_na), 107 | hms_(len2, any_na), 108 | factor_(len2, any_na) 109 | )() 110 | ) 111 | } 112 | 113 | #' Any flat list generator 114 | #' 115 | #' Generate lists in which each element is an atomic scalar. 116 | #' 117 | #' @template len 118 | #' @template any_na 119 | #' 120 | #' @examples 121 | #' any_flat_list() %>% show_example() 122 | #' any_flat_list(len = 10L, any_na = TRUE) %>% show_example() 123 | #' @template generator 124 | #' @export 125 | any_flat_list <- function(len = c(1L, 10L), any_na = FALSE) { 126 | flat_list_of(any_atomic(any_na = any_na), len) 127 | } 128 | 129 | #' Any flat homogeneous list generator 130 | #' 131 | #' Generate lists in which each element is an atomic scalar of the same class. 132 | #' 133 | #' @template len 134 | #' @template any_na 135 | #' 136 | #' @examples 137 | #' any_flat_homogeneous_list() %>% show_example() 138 | #' any_flat_homogeneous_list(len = 10L, any_na = TRUE) %>% show_example() 139 | #' @template generator 140 | #' @export 141 | any_flat_homogeneous_list <- function(len = c(1L, 10L), any_na = FALSE) { 142 | qc_gen(function(len2 = len) 143 | one_of( 144 | flat_list_of(integer_(any_na = any_na), len2), 145 | flat_list_of(double_(any_na = any_na), len2), 146 | flat_list_of(character_(any_na = any_na), len2), 147 | flat_list_of(logical_(any_na = any_na), len2), 148 | flat_list_of(date_(any_na = any_na), len2), 149 | flat_list_of(posixct_(any_na = any_na), len2), 150 | flat_list_of(hms_(any_na = any_na), len2), 151 | flat_list_of(factor_(any_na = any_na), len2) 152 | )() 153 | ) 154 | } 155 | 156 | #' Any list generator 157 | #' 158 | #' Generate lists containing lists or atomic vectors. 159 | #' 160 | #' @template len 161 | #' @template any_na 162 | #' 163 | #' @examples 164 | #' any_list() %>% show_example() 165 | #' any_list(len = 10L, any_na = TRUE) %>% show_example() 166 | #' @template generator 167 | #' @export 168 | any_list <- function(len = c(1L, 10L), any_na = FALSE) { 169 | atomic <- 170 | any_atomic(c(1L, 10L), any_na) 171 | 172 | qc_gen(function(len2 = len) 173 | one_of( 174 | any_flat_list(len2, any_na), 175 | any_flat_homogeneous_list(len2, any_na), 176 | list_of(atomic, len2), 177 | list_of(list_(a = atomic, b = atomic), len2) 178 | )() 179 | ) 180 | } 181 | 182 | #' Any vector generator 183 | #' 184 | #' Generate atomic vectors or lists. 185 | #' 186 | #' @template len 187 | #' @template any_na 188 | #' 189 | #' @examples 190 | #' any_vector() %>% show_example() 191 | #' any_vector(len = 10L, any_na = TRUE) %>% show_example() 192 | #' @template generator 193 | #' @export 194 | any_vector <- function(len = c(1L, 10L), any_na = FALSE) { 195 | qc_gen(function(len2 = len) 196 | one_of( 197 | any_atomic(len2, any_na), 198 | any_list(len2, any_na) 199 | )() 200 | ) 201 | } 202 | 203 | #' Any tibble generator 204 | #' 205 | #' Generate tibbles. 206 | #' 207 | #' @template rows 208 | #' @template cols 209 | #' @template any_na 210 | #' 211 | #' @examples 212 | #' any_tibble(rows = 3L, cols = 3L) %>% show_example() 213 | #' @template generator 214 | #' @export 215 | any_tibble <- function(rows = c(1L, 10L), 216 | cols = c(1L, 10L), 217 | any_na = FALSE) { 218 | tibble_of( 219 | any_vector(any_na = any_na), 220 | rows = rows, 221 | cols = cols 222 | ) 223 | } 224 | 225 | #' Any data frame generator 226 | #' 227 | #' Generate data.frames. 228 | #' 229 | #' @template rows 230 | #' @template cols 231 | #' @template any_na 232 | #' 233 | #' @examples 234 | #' any_data_frame(rows = 3L, cols = 3L) %>% show_example() 235 | #' @template generator 236 | #' @export 237 | any_data_frame <- function(rows = c(1L, 10L), 238 | cols = c(1L, 10L), 239 | any_na = FALSE) { 240 | data_frame_of( 241 | any_atomic(any_na = any_na), 242 | rows = rows, 243 | cols = cols 244 | ) 245 | } 246 | 247 | #' Any data.table generator 248 | #' 249 | #' Generate data.tables. 250 | #' 251 | #' @template rows 252 | #' @template cols 253 | #' @template any_na 254 | #' 255 | #' @examples 256 | #' any_data.table(rows = 3L, cols = 3L) %>% show_example() 257 | #' @template generator 258 | #' @export 259 | any_data.table <- function(rows = c(1L, 10L), 260 | cols = c(1L, 10L), 261 | any_na = FALSE) { 262 | data.table_of( 263 | any_vector(any_na = any_na), 264 | rows = rows, 265 | cols = cols 266 | ) 267 | } 268 | 269 | #' Any undefined value generator 270 | #' 271 | #' Generate undefined values. In this case undefined values include `NA`, 272 | #' `NA_integer_`, `NA_real_`, `NA_character_`, `NA_complex_`, `NULL`, `-Inf`, 273 | #' `Inf`, and `NaN`. Values generated are always scalars. 274 | #' 275 | #' @examples 276 | #' any_undefined() %>% show_example() 277 | #' @template generator 278 | #' @export 279 | any_undefined <- function() { 280 | one_of( 281 | constant(NULL), 282 | constant(-Inf), 283 | constant(Inf), 284 | constant(NaN), 285 | constant(NA), 286 | constant(NA_integer_), 287 | constant(NA_real_), 288 | constant(NA_character_), 289 | constant(NA_complex_) 290 | ) 291 | } 292 | -------------------------------------------------------------------------------- /R/character.R: -------------------------------------------------------------------------------- 1 | #' Character generators 2 | #' 3 | #' A set of generators for character vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' @template any_empty 8 | #' 9 | #' @examples 10 | #' character_() %>% show_example() 11 | #' character_(len = 10L, any_na = TRUE) %>% show_example() 12 | #' character_(len = 10L, any_empty = TRUE) %>% show_example() 13 | #' @template generator 14 | #' @export 15 | character_ <- function(len = c(1L, 10L), 16 | any_na = FALSE, 17 | any_empty = FALSE) { 18 | bytes_to_character(32L:126L) %>% 19 | character_string(len, any_na, any_empty) 20 | } 21 | 22 | #' @rdname character_ 23 | #' @export 24 | character_letters <- function(len = c(1L, 10L), 25 | any_na = FALSE, 26 | any_empty = FALSE) { 27 | c(letters, LETTERS) %>% 28 | character_string(len, any_na, any_empty) 29 | } 30 | 31 | #' @rdname character_ 32 | #' @export 33 | character_numbers <- function(len = c(1L, 10L), 34 | any_na = FALSE, 35 | any_empty = FALSE) { 36 | as.character(0:9) %>% 37 | character_string(len, any_na, any_empty) 38 | } 39 | 40 | #' @rdname character_ 41 | #' @export 42 | character_alphanumeric <- function(len = c(1L, 10L), 43 | any_na = FALSE, 44 | any_empty = FALSE) { 45 | c(letters, LETTERS, 0:9) %>% 46 | character_string(len, any_na, any_empty) 47 | } 48 | 49 | character_string <- function(characters, len, any_na, any_empty) { 50 | replicate(1000L, random_string(characters)) %>% 51 | character_generator(len, any_na, any_empty) 52 | } 53 | 54 | character_generator <- function(characters, len, any_na, any_empty) { 55 | qc_gen(function(len2 = len) 56 | hedgehog::gen.element(characters) %>% 57 | replace_some_with("", any_empty) %>% 58 | replace_some_with(NA_character_, any_na) %>% 59 | vectorize(len2) 60 | ) 61 | } 62 | 63 | bytes_to_character <- function(bytes) { 64 | as.raw(bytes) %>% 65 | rawToChar() %>% 66 | strsplit("") %>% 67 | unlist() 68 | } 69 | 70 | random_string <- function(character_set) { 71 | character_set %>% 72 | sample_vec(stats::runif(1L, 1L, 10L)) %>% 73 | paste0(collapse = "") 74 | } 75 | -------------------------------------------------------------------------------- /R/constant.R: -------------------------------------------------------------------------------- 1 | #' Generate the same value every time 2 | #' 3 | #' @param a Any R object 4 | #' 5 | #' @examples 6 | #' constant(NULL) %>% show_example() 7 | #' @template generator 8 | #' @export 9 | constant <- function(a) { 10 | qc_gen(function() hedgehog::gen.choice(a)) 11 | } 12 | -------------------------------------------------------------------------------- /R/data-table.R: -------------------------------------------------------------------------------- 1 | #' data.table generators 2 | #' 3 | #' Construct data.table generators in a similar way to `data.table::data.table`. 4 | #' 5 | #' @param ... A set of name-value pairs with the values being vector generators. 6 | #' @template rows 7 | #' 8 | #' @examples 9 | #' data.table_(a = integer_()) %>% show_example() 10 | #' data.table_(a = integer_(), b = character_(), rows = 5L) %>% show_example() 11 | #' @template generator 12 | #' @export 13 | data.table_ <- function(..., rows = c(1L, 10L)) { 14 | assert_all_modifiable_length(...) 15 | 16 | tibble_(..., rows = rows) %>% 17 | as_hedgehog() %>% 18 | hedgehog::gen.with(data.table::as.data.table) %>% 19 | from_hedgehog() 20 | } 21 | 22 | #' data.table generator with randomized columns 23 | #' 24 | #' @param ... A set of unnamed generators. The generated data.tables will be 25 | #' built with random combinations of these generators. 26 | #' @template rows 27 | #' @template cols 28 | #' 29 | #' @examples 30 | #' data.table_of(logical_(), date_()) %>% show_example() 31 | #' data.table_of(any_atomic(), rows = 10L, cols = 5L) %>% show_example() 32 | #' @template generator 33 | #' @export 34 | data.table_of <- function(..., rows = c(1L, 10L), cols = c(1L, 10L)) { 35 | assert_all_modifiable_length(...) 36 | 37 | tibble_of(..., rows = rows, cols = cols) %>% 38 | as_hedgehog() %>% 39 | hedgehog::gen.with(data.table::as.data.table) %>% 40 | from_hedgehog() 41 | } 42 | -------------------------------------------------------------------------------- /R/data_frame.R: -------------------------------------------------------------------------------- 1 | #' Data frame generators 2 | #' 3 | #' Construct data frame generators in a similar way to `base::data.frame`. 4 | #' 5 | #' @param ... A set of name-value pairs with the values being vector generators. 6 | #' @template rows 7 | #' 8 | #' @examples 9 | #' data_frame_(a = integer_()) %>% show_example() 10 | #' data_frame_(a = integer_(), b = character_(), rows = 5L) %>% show_example() 11 | #' @template generator 12 | #' @export 13 | data_frame_ <- function(..., rows = c(1L, 10L)) { 14 | assert_all_modifiable_length(...) 15 | 16 | tibble_(..., rows = rows) %>% 17 | as_hedgehog() %>% 18 | hedgehog::gen.with(as.data.frame) %>% 19 | from_hedgehog() 20 | } 21 | 22 | #' Data frame generator with randomized columns 23 | #' 24 | #' @param ... A set of unnamed generators. The generated data frames will be 25 | #' built with random combinations of these generators. 26 | #' @template rows 27 | #' @template cols 28 | #' 29 | #' @examples 30 | #' data_frame_of(logical_(), date_()) %>% show_example() 31 | #' data_frame_of(any_atomic(), rows = 10L, cols = 5L) %>% show_example() 32 | #' @template generator 33 | #' @export 34 | data_frame_of <- function(..., rows = c(1L, 10L), cols = c(1L, 10L)) { 35 | assert_all_modifiable_length(...) 36 | 37 | tibble_of(..., rows = rows, cols = cols) %>% 38 | as_hedgehog() %>% 39 | hedgehog::gen.with(as.data.frame) %>% 40 | from_hedgehog() 41 | } 42 | -------------------------------------------------------------------------------- /R/date.R: -------------------------------------------------------------------------------- 1 | #' Date generators 2 | #' 3 | #' A set of generators for date vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' @template left 8 | #' @template right 9 | #' 10 | #' @examples 11 | #' date_() %>% show_example() 12 | #' date_bounded( 13 | #' left = as.Date("2020-01-01"), 14 | #' right = as.Date("2020-01-10") 15 | #' ) %>% show_example() 16 | #' date_(len = 10L, any_na = TRUE) %>% show_example() 17 | #' @template generator 18 | #' @export 19 | date_ <- function(len = c(1L, 10L), any_na = FALSE) { 20 | date_bounded(min_date(), max_date(), len, any_na) 21 | } 22 | 23 | #' @rdname date_ 24 | #' @export 25 | date_bounded <- function(left, right, len = c(1L, 10L), any_na = FALSE) { 26 | as_date <- 27 | purrr::partial(as.Date, origin = "1970-01-01") 28 | 29 | qc_gen(function(len2 = len) 30 | seq(left, right, by = "day") %>% 31 | hedgehog::gen.element() %>% 32 | replace_some_with(NA_real_, any_na) %>% 33 | hedgehog::gen.with(as_date) %>% 34 | vectorize(len2) 35 | ) 36 | } 37 | 38 | #' @rdname date_ 39 | #' @export 40 | date_left_bounded <- function(left, len = c(1L, 10L), any_na = FALSE) { 41 | date_bounded(left, max_date(), len, any_na) 42 | } 43 | 44 | #' @rdname date_ 45 | #' @export 46 | date_right_bounded <- function(right, len = c(1L, 10L), any_na = FALSE) { 47 | date_bounded(min_date(), right, len, any_na) 48 | } 49 | 50 | min_date <- function() { 51 | as.Date("1000-01-01") 52 | } 53 | 54 | max_date <- function() { 55 | as.Date("3000-01-01") 56 | } 57 | -------------------------------------------------------------------------------- /R/double.R: -------------------------------------------------------------------------------- 1 | #' Double generators 2 | #' 3 | #' A set of generators for double vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' @template any_nan 8 | #' @template any_inf 9 | #' @template big_dbl 10 | #' @template left 11 | #' @template right 12 | #' 13 | #' @examples 14 | #' double_() %>% show_example() 15 | #' double_(big_dbl = TRUE) %>% show_example() 16 | #' double_bounded(left = -5, right = 5) %>% show_example() 17 | #' double_(len = 10L, any_na = TRUE) %>% show_example() 18 | #' double_(len = 10L, any_nan = TRUE, any_inf = TRUE) %>% show_example() 19 | #' @template generator 20 | #' @export 21 | double_ <- function(len = c(1L, 10L), 22 | any_na = FALSE, 23 | any_nan = FALSE, 24 | any_inf = FALSE, 25 | big_dbl = FALSE) { 26 | double_bounded( 27 | max_negative_double(big_dbl), 28 | max_positive_double(big_dbl), 29 | len, 30 | any_na, 31 | any_nan, 32 | any_inf 33 | ) 34 | } 35 | 36 | #' @rdname double_ 37 | #' @export 38 | double_bounded <- function(left, 39 | right, 40 | len = c(1L, 10L), 41 | any_na = FALSE, 42 | any_nan = FALSE, 43 | any_inf = FALSE) { 44 | ensure_some_zeros <- 45 | function(a) 46 | if (overlaps_zero(left, right)) 47 | hedgehog::gen.choice(a, 0, prob = c(0.9, 0.1)) 48 | 49 | else 50 | a 51 | 52 | qc_gen(function(len2 = len) 53 | hedgehog::gen.unif(left, right) %>% 54 | ensure_some_zeros() %>% 55 | replace_some_with(NA_real_, any_na) %>% 56 | replace_some_with(NaN, any_nan) %>% 57 | replace_some_with(Inf, any_inf) %>% 58 | replace_some_with(-Inf, any_inf) %>% 59 | vectorize(len2) 60 | ) 61 | } 62 | 63 | #' @rdname double_ 64 | #' @export 65 | double_left_bounded <- function(left, 66 | len = c(1L, 10L), 67 | any_na = FALSE, 68 | any_nan = FALSE, 69 | any_inf = FALSE, 70 | big_dbl = FALSE) { 71 | double_bounded( 72 | left, 73 | max_positive_double(big_dbl), 74 | len, 75 | any_na, 76 | any_nan, 77 | any_inf 78 | ) 79 | } 80 | 81 | #' @rdname double_ 82 | #' @export 83 | double_right_bounded <- function(right, 84 | len = c(1L, 10L), 85 | any_na = FALSE, 86 | any_nan = FALSE, 87 | any_inf = FALSE, 88 | big_dbl = FALSE) { 89 | double_bounded( 90 | max_negative_double(big_dbl), 91 | right, 92 | len, 93 | any_na, 94 | any_nan, 95 | any_inf 96 | ) 97 | } 98 | 99 | #' @rdname double_ 100 | #' @export 101 | double_positive <- function(len = c(1L, 10L), 102 | any_na = FALSE, 103 | any_nan = FALSE, 104 | any_inf = FALSE, 105 | big_dbl = FALSE) { 106 | double_left_bounded( 107 | min_positive_double(), 108 | len, 109 | any_na, 110 | any_nan, 111 | any_inf, 112 | big_dbl 113 | ) 114 | } 115 | 116 | #' @rdname double_ 117 | #' @export 118 | double_negative <- function(len = c(1L, 10L), 119 | any_na = FALSE, 120 | any_nan = FALSE, 121 | any_inf = FALSE, 122 | big_dbl = FALSE) { 123 | double_right_bounded( 124 | min_negative_double(), 125 | len, 126 | any_na, 127 | any_nan, 128 | any_inf, 129 | big_dbl 130 | ) 131 | } 132 | 133 | #' @rdname double_ 134 | #' @export 135 | double_fractional <- function(len = c(1L, 10L), 136 | any_na = FALSE, 137 | any_nan = FALSE, 138 | any_inf = FALSE, 139 | big_dbl = FALSE) { 140 | keep_fractional <- 141 | function(a) a[a %% 1L > 0.0001] 142 | 143 | qc_gen(function(len2 = len) 144 | stats::runif( 145 | 1e6, 146 | max_negative_double(big_dbl), 147 | max_positive_double(big_dbl) 148 | ) %>% 149 | keep_fractional() %>% 150 | hedgehog::gen.element() %>% 151 | replace_some_with(NA_real_, any_na) %>% 152 | replace_some_with(NaN, any_nan) %>% 153 | replace_some_with(Inf, any_inf) %>% 154 | replace_some_with(-Inf, any_inf) %>% 155 | vectorize(len2) 156 | ) 157 | } 158 | 159 | #' @rdname double_ 160 | #' @export 161 | double_whole <- function(len = c(1L, 10L), 162 | any_na = FALSE, 163 | any_nan = FALSE, 164 | any_inf = FALSE, 165 | big_dbl = FALSE) { 166 | qc_gen(function(len2 = len) 167 | double_(len2, any_na, any_nan, any_inf, big_dbl) %>% 168 | as_hedgehog() %>% 169 | hedgehog::gen.with(round) 170 | ) 171 | } 172 | 173 | max_positive_double <- function(big_dbl = FALSE) { 174 | if (big_dbl) 175 | .Machine$double.xmax / 2 176 | 177 | else 178 | 1e9 179 | } 180 | 181 | max_negative_double <- function(big_dbl = FALSE) { 182 | -max_positive_double(big_dbl) 183 | } 184 | 185 | min_positive_double <- function() { 186 | .Machine$double.xmin 187 | } 188 | 189 | min_negative_double <- function() { 190 | -min_positive_double() 191 | } 192 | -------------------------------------------------------------------------------- /R/factor.R: -------------------------------------------------------------------------------- 1 | #' Factor generator 2 | #' 3 | #' A generator for factor vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' 8 | #' @examples 9 | #' factor_() %>% show_example() 10 | #' factor_(len = 10L, any_na = TRUE) %>% show_example() 11 | #' @template generator 12 | #' @export 13 | factor_ <- function(len = c(1L, 10L), any_na = FALSE) { 14 | qc_gen(function(len2 = len) 15 | character_(len = 1L) %>% 16 | as_hedgehog() %>% 17 | hedgehog::gen.with(as.factor) %>% 18 | replace_some_with(NA_integer_, any_na) %>% 19 | vectorize(len2) 20 | ) 21 | } 22 | -------------------------------------------------------------------------------- /R/for_all.R: -------------------------------------------------------------------------------- 1 | #' Test properties of a function 2 | #' 3 | #' @param ... Named generators 4 | #' @param property A function which takes values from from 5 | #' the generator and calls an expectation on it. This function must have 6 | #' parameters matching the generator names. 7 | #' @param tests The number of tests to run. 8 | #' @param shrinks The maximum number of shrinks to run when 9 | #' shrinking a value to find the smallest counterexample. 10 | #' @param discards The maximum number of discards to permit 11 | #' when running the property. 12 | #' 13 | #' @examples 14 | #' for_all( 15 | #' a = numeric_(len = 1L), 16 | #' b = numeric_(len = 1L), 17 | #' property = function(a, b) testthat::expect_equal(a + b, b + a), 18 | #' tests = 10L 19 | #' ) 20 | #' @return A `testthat` expectation object. 21 | #' @export 22 | for_all <- function(..., 23 | property, 24 | tests = getOption("quickcheck.tests", 100L), 25 | shrinks = getOption("quickcheck.shrinks", 100L), 26 | discards = getOption("quickcheck.discards", 100L)) { 27 | hedgehog::forall( 28 | generator = eval_functions(...), 29 | property = property, 30 | tests = tests, 31 | shrink.limit = shrinks, 32 | discard.limit = discards 33 | ) 34 | } 35 | -------------------------------------------------------------------------------- /R/hms.R: -------------------------------------------------------------------------------- 1 | #' hms generators 2 | #' 3 | #' A set of generators for hms vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' @template left 8 | #' @template right 9 | #' 10 | #' @examples 11 | #' hms_() %>% show_example() 12 | #' hms_bounded( 13 | #' left = hms::as_hms("00:00:00"), 14 | #' right = hms::as_hms("12:00:00") 15 | #' ) %>% show_example() 16 | #' hms_(len = 10L, any_na = TRUE) %>% show_example() 17 | #' @template generator 18 | #' @export 19 | hms_ <- function(len = c(1L, 10L), any_na = FALSE) { 20 | hms_bounded(min_hms(), max_hms(), len, any_na) 21 | } 22 | 23 | #' @rdname hms_ 24 | #' @export 25 | hms_bounded <- function(left, right, len = c(1L, 10L), any_na = FALSE) { 26 | qc_gen(function(len2 = len) 27 | hedgehog::gen.unif(as.double(left), as.double(right)) %>% 28 | replace_some_with(NA_real_, any_na) %>% 29 | hedgehog::gen.with(hms::as_hms) %>% 30 | vectorize(len2) 31 | ) 32 | } 33 | 34 | #' @rdname hms_ 35 | #' @export 36 | hms_left_bounded <- function(left, len = c(1L, 10L), any_na = FALSE) { 37 | hms_bounded(left, max_hms(), len, any_na) 38 | } 39 | 40 | #' @rdname hms_ 41 | #' @export 42 | hms_right_bounded <- function(right, len = c(1L, 10L), any_na = FALSE) { 43 | hms_bounded(min_hms(), right, len, any_na) 44 | } 45 | 46 | min_hms <- function() { 47 | hms::as_hms("00:00:00") 48 | } 49 | 50 | max_hms <- function() { 51 | hms::as_hms("23:59:59") 52 | } 53 | -------------------------------------------------------------------------------- /R/integer.R: -------------------------------------------------------------------------------- 1 | #' Integer generators 2 | #' 3 | #' A set of generators for integer vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' @template big_int 8 | #' @template left 9 | #' @template right 10 | #' 11 | #' @examples 12 | #' integer_() %>% show_example() 13 | #' integer_(big_int = TRUE) %>% show_example() 14 | #' integer_bounded(left = -5L, right = 5L) %>% show_example() 15 | #' integer_(len = 10L, any_na = TRUE) %>% show_example() 16 | #' @template generator 17 | #' @export 18 | integer_ <- function(len = c(1L, 10L), 19 | any_na = FALSE, 20 | big_int = FALSE) { 21 | integer_bounded( 22 | max_negative_integer(big_int), 23 | max_positive_integer(big_int), 24 | len, 25 | any_na 26 | ) 27 | } 28 | 29 | #' @rdname integer_ 30 | #' @export 31 | integer_bounded <- function(left, 32 | right, 33 | len = c(1L, 10L), 34 | any_na = FALSE) { 35 | ensure_some_zeros <- 36 | function(a) 37 | if (overlaps_zero(left, right)) 38 | hedgehog::gen.choice(a, 0L, prob = c(0.9, 0.1)) 39 | 40 | else 41 | a 42 | 43 | qc_gen(function(len2 = len) 44 | stats::runif(1e6, left, right) %>% 45 | round() %>% 46 | as.integer() %>% 47 | hedgehog::gen.element() %>% 48 | ensure_some_zeros() %>% 49 | replace_some_with(NA_integer_, any_na) %>% 50 | vectorize(len2) 51 | ) 52 | } 53 | 54 | #' @rdname integer_ 55 | #' @export 56 | integer_left_bounded <- function(left, 57 | len = c(1L, 10L), 58 | any_na = FALSE, 59 | big_int = FALSE) { 60 | integer_bounded( 61 | left, 62 | max_positive_integer(big_int), 63 | len, 64 | any_na 65 | ) 66 | } 67 | 68 | #' @rdname integer_ 69 | #' @export 70 | integer_right_bounded <- function(right, 71 | len = c(1L, 10L), 72 | any_na = FALSE, 73 | big_int = FALSE) { 74 | integer_bounded( 75 | max_negative_integer(big_int), 76 | right, 77 | len, 78 | any_na 79 | ) 80 | } 81 | 82 | #' @rdname integer_ 83 | #' @export 84 | integer_positive <- function(len = c(1L, 10L), 85 | any_na = FALSE, 86 | big_int = FALSE) { 87 | integer_left_bounded(1L, len, any_na) 88 | } 89 | 90 | #' @rdname integer_ 91 | #' @export 92 | integer_negative <- function(len = c(1L, 10L), 93 | any_na = FALSE, 94 | big_int = FALSE) { 95 | integer_right_bounded(-1L, len, any_na) 96 | } 97 | 98 | max_positive_integer <- function(big_int = FALSE) { 99 | if (big_int) 100 | .Machine$integer.max 101 | 102 | else 103 | 10000L 104 | } 105 | 106 | max_negative_integer <- function(big_int = FALSE) { 107 | -max_positive_integer(big_int) 108 | } 109 | -------------------------------------------------------------------------------- /R/list.R: -------------------------------------------------------------------------------- 1 | #' List generator 2 | #' 3 | #' Generate lists with contents corresponding to the values generated by the 4 | #' input generators. 5 | #' 6 | #' @param ... A set of named or unnamed generators. 7 | #' 8 | #' @examples 9 | #' list_(integer_(), logical_()) %>% show_example() 10 | #' list_(a = any_vector(), b = any_vector()) %>% show_example() 11 | #' @template generator 12 | #' @export 13 | list_ <- function(...) { 14 | qc_gen(function() 15 | hedgehog::gen.with( 16 | eval_functions(...), 17 | as.list 18 | ) 19 | ) 20 | } 21 | 22 | #' Variable length list generator 23 | #' 24 | #' Generate lists with all values coming from a single generator. 25 | #' 26 | #' @template param_generator 27 | #' @template len 28 | #' 29 | #' @examples 30 | #' list_of(integer_(), len = 10L) %>% show_example() 31 | #' @template generator 32 | #' @export 33 | list_of <- function(generator, len = c(1L, 10L)) { 34 | qc_gen(function(len2 = len) 35 | vectorize(list(generator()), len2) 36 | ) 37 | } 38 | 39 | #' Variable length flat list generator 40 | #' 41 | #' Generate flat lists with all values coming from a single generator. In a flat 42 | #' list all items will be scalars. 43 | #' 44 | #' @template param_generator 45 | #' @template len 46 | #' 47 | #' @examples 48 | #' flat_list_of(integer_(), len = 10L) %>% show_example() 49 | #' @template generator 50 | #' @export 51 | flat_list_of <- function(generator, len = c(1L, 10L)) { 52 | qc_gen(function(len2 = len) 53 | vectorize(list(generator(len = 1L)), len2) 54 | ) 55 | } 56 | -------------------------------------------------------------------------------- /R/logical.R: -------------------------------------------------------------------------------- 1 | #' Logical generator 2 | #' 3 | #' A generator for logical vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' 8 | #' @examples 9 | #' logical_() %>% show_example() 10 | #' logical_(len = 10L, any_na = TRUE) %>% show_example() 11 | #' @template generator 12 | #' @export 13 | logical_ <- function(len = c(1L, 10L), any_na = FALSE) { 14 | qc_gen(function(len2 = len) 15 | hedgehog::gen.element(c(TRUE, FALSE)) %>% 16 | replace_some_with(NA, any_na) %>% 17 | vectorize(len2) 18 | ) 19 | } 20 | -------------------------------------------------------------------------------- /R/modifiers.R: -------------------------------------------------------------------------------- 1 | #' Equal length vector generator 2 | #' 3 | #' Generates equal length vectors contained in a list. 4 | #' 5 | #' @param ... A set of named or unnamed vector generators. 6 | #' @template len 7 | #' 8 | #' @examples 9 | #' equal_length(integer_(), double_()) %>% show_example() 10 | #' equal_length(a = logical_(), b = character_(), len = 5L) %>% show_example() 11 | #' @template generator 12 | #' @export 13 | equal_length <- function(..., len = c(1L, 10L)) { 14 | assert_all_modifiable_length(...) 15 | 16 | len_generator <- 17 | as_length_generator(len) 18 | 19 | generate_list <- 20 | function(a) purrr::map(list(...), function(f) f(len2 = a)) 21 | 22 | qc_gen(function() 23 | hedgehog::gen.and_then( 24 | len_generator(), 25 | generate_list 26 | ) 27 | ) 28 | } 29 | 30 | vectorize <- function(generator, len = 1L) { 31 | if (is_zero(len)) 32 | empty_vectors(generator) 33 | 34 | else if (length(len) == 1L) 35 | fixed_length_vectors(generator, len) 36 | 37 | else if (len[1L] == 0L) 38 | empty_or_variable_length_vectors(generator, len) 39 | 40 | else 41 | variable_length_vectors(generator, len) 42 | } 43 | 44 | empty_vectors <- function(generator) { 45 | hedgehog::gen.with(generator, function(a) a[0L]) 46 | } 47 | 48 | fixed_length_vectors <- function(generator, len) { 49 | hedgehog::gen.c(generator, of = len) 50 | } 51 | 52 | variable_length_vectors <- function(generator, len) { 53 | hedgehog::gen.c(generator, len[1L], len[2L]) 54 | } 55 | 56 | empty_or_variable_length_vectors <- function(generator, len) { 57 | hedgehog::gen.c(generator, len[1L] + 1L, len[2L]) %>% 58 | replace_frac_empty(frac = 0.25) 59 | } 60 | 61 | replace_frac_empty <- function(generator, frac) { 62 | replace_frac <- 63 | function(a) 64 | if (stats::runif(1L) <= frac) 65 | a[0L] 66 | 67 | else 68 | a 69 | 70 | hedgehog::gen.with(generator, replace_frac) 71 | } 72 | 73 | replace_frac_with <- function(generator, replacement, frac) { 74 | replace_frac <- 75 | function(a) 76 | if (stats::runif(1L) <= frac) 77 | replacement 78 | 79 | else 80 | a 81 | 82 | hedgehog::gen.with(generator, replace_frac) 83 | } 84 | 85 | replace_some_with <- function(generator, replacement, replace) { 86 | if (replace) 87 | replace_frac_with(generator, replacement, frac = 0.25) 88 | 89 | else 90 | generator 91 | } 92 | -------------------------------------------------------------------------------- /R/numeric.R: -------------------------------------------------------------------------------- 1 | #' Numeric generators 2 | #' 3 | #' A set of generators for numeric vectors. Numeric vectors can be either 4 | #' integer or double vectors. 5 | #' 6 | #' @template len 7 | #' @template any_na 8 | #' @template big_num 9 | #' @template left 10 | #' @template right 11 | #' 12 | #' @examples 13 | #' numeric_() %>% show_example() 14 | #' numeric_(big_num = TRUE) %>% show_example() 15 | #' numeric_bounded(left = -5L, right = 5L) %>% show_example() 16 | #' numeric_(len = 10L, any_na = TRUE) %>% show_example() 17 | #' @template generator 18 | #' @export 19 | numeric_ <- function(len = c(1L, 10L), 20 | any_na = FALSE, 21 | big_num = FALSE) { 22 | qc_gen(function(len2 = len) 23 | one_of( 24 | integer_(len2, any_na, big_int = big_num), 25 | double_(len2, any_na, big_dbl = big_num) 26 | )() 27 | ) 28 | } 29 | 30 | #' @rdname numeric_ 31 | #' @export 32 | numeric_bounded <- function(left, 33 | right, 34 | len = c(1L, 10L), 35 | any_na = FALSE) { 36 | qc_gen(function(len2 = len) 37 | one_of( 38 | integer_bounded(left, right, len2, any_na), 39 | double_bounded(left, right, len2, any_na) 40 | )() 41 | ) 42 | } 43 | 44 | #' @rdname numeric_ 45 | #' @export 46 | numeric_left_bounded <- function(left, 47 | len = c(1L, 10L), 48 | any_na = FALSE, 49 | big_num = FALSE) { 50 | qc_gen(function(len2 = len) 51 | one_of( 52 | integer_left_bounded( 53 | left, 54 | len2, 55 | any_na, 56 | big_int = big_num 57 | ), 58 | double_left_bounded( 59 | left, 60 | len2, 61 | any_na, 62 | big_dbl = big_num 63 | ) 64 | )() 65 | ) 66 | } 67 | 68 | #' @rdname numeric_ 69 | #' @export 70 | numeric_right_bounded <- function(right, 71 | len = c(1L, 10L), 72 | any_na = FALSE, 73 | big_num = FALSE) { 74 | qc_gen(function(len2 = len) 75 | one_of( 76 | integer_right_bounded( 77 | right, 78 | len2, 79 | any_na, 80 | big_int = big_num 81 | ), 82 | double_right_bounded( 83 | right, 84 | len2, 85 | any_na, 86 | big_dbl = big_num 87 | ) 88 | )() 89 | ) 90 | } 91 | 92 | #' @rdname numeric_ 93 | #' @export 94 | numeric_positive <- function(len = c(1L, 10L), 95 | any_na = FALSE, 96 | big_num = FALSE) { 97 | qc_gen(function(len2 = len) 98 | one_of( 99 | integer_positive(len2, any_na, big_int = big_num), 100 | double_positive(len2, any_na, big_dbl = big_num) 101 | )() 102 | ) 103 | } 104 | 105 | #' @rdname numeric_ 106 | #' @export 107 | numeric_negative <- function(len = c(1L, 10L), 108 | any_na = FALSE, 109 | big_num = FALSE) { 110 | qc_gen(function(len2 = len) 111 | one_of( 112 | integer_negative(len2, any_na, big_int = big_num), 113 | double_negative(len2, any_na, big_dbl = big_num) 114 | )() 115 | ) 116 | } 117 | -------------------------------------------------------------------------------- /R/one_of.R: -------------------------------------------------------------------------------- 1 | #' Randomly choose between generators 2 | #' 3 | #' @param ... A set of unnamed generators. 4 | #' @param prob A vector of probability weights for obtaining the elements of the 5 | #' vector being sampled. 6 | #' 7 | #' @examples 8 | #' one_of(integer_(), character_()) %>% show_example() 9 | #' one_of(constant(NULL), logical_(), prob = c(0.1, 0.9)) %>% show_example() 10 | #' @template generator 11 | #' @export 12 | one_of <- function(..., prob = NULL) { 13 | qc_gen(function() 14 | do.call( 15 | purrr::partial(hedgehog::gen.choice, prob = prob), 16 | eval_functions(...) 17 | ) 18 | ) 19 | } 20 | -------------------------------------------------------------------------------- /R/other.R: -------------------------------------------------------------------------------- 1 | #' Convert a hedgehog generator to a quickcheck generator 2 | #' 3 | #' @param generator A `hedgehog.internal.gen` object. 4 | #' 5 | #' @examples 6 | #' is_even <- 7 | #' function(a) a %% 2L == 0L 8 | #' 9 | #' gen_powers_of_two <- 10 | #' hedgehog::gen.element(1:10) %>% hedgehog::gen.with(function(a) 2 ^ a) 11 | #' 12 | #' for_all( 13 | #' a = from_hedgehog(gen_powers_of_two), 14 | #' property = function(a) is_even(a) %>% testthat::expect_true() 15 | #' ) 16 | #' @template generator 17 | #' @export 18 | from_hedgehog <- function(generator) { 19 | qc_gen(function() generator) 20 | } 21 | 22 | #' Convert a quickcheck generator to a hedgehog generator 23 | #' 24 | #' @template param_generator 25 | #' 26 | #' @examples 27 | #' is_even <- 28 | #' function(a) a %% 2L == 0L 29 | 30 | #' gen_powers_of_two <- 31 | #' integer_bounded(1L, 10L, len = 1L) %>% 32 | #' as_hedgehog() %>% 33 | #' hedgehog::gen.with(function(a) 2 ^ a) 34 | 35 | #' for_all( 36 | #' a = from_hedgehog(gen_powers_of_two), 37 | #' property = function(a) is_even(a) %>% testthat::expect_true() 38 | #' ) 39 | #' @template generator 40 | #' @export 41 | as_hedgehog <- function(generator) { 42 | generator() 43 | } 44 | 45 | #' Show an example output of a generator 46 | #' 47 | #' @template param_generator 48 | #' 49 | #' @examples 50 | #' logical_() %>% show_example() 51 | #' @return An example output produced by the generator. 52 | #' @export 53 | show_example <- function(generator) { 54 | hedgehog::gen.example(generator())$root 55 | } 56 | 57 | #' @export 58 | print.quickcheck_generator <- function (x, ...) { 59 | example <- 60 | hedgehog::gen.example(x()) 61 | 62 | cat("Quickcheck generator:\n") 63 | cat("Example:\n") 64 | print(example$root) 65 | cat("Initial shrinks:\n") 66 | purrr::walk(example$children(), function(a) print(a$root)) 67 | } 68 | 69 | -------------------------------------------------------------------------------- /R/posixct.R: -------------------------------------------------------------------------------- 1 | #' POSIXct generators 2 | #' 3 | #' A set of generators for POSIXct vectors. 4 | #' 5 | #' @template len 6 | #' @template any_na 7 | #' @template left 8 | #' @template right 9 | #' 10 | #' @examples 11 | #' posixct_() %>% show_example() 12 | #' posixct_bounded( 13 | #' left = as.POSIXct("2020-01-01 00:00:00"), 14 | #' right = as.POSIXct("2021-01-01 00:00:00") 15 | #' ) %>% show_example() 16 | #' posixct_(len = 10L, any_na = TRUE) %>% show_example() 17 | #' @template generator 18 | #' @export 19 | posixct_ <- function(len = c(1L, 10L), any_na = FALSE) { 20 | posixct_bounded(min_posixct(), max_posixct(), len, any_na) 21 | } 22 | 23 | #' @rdname posixct_ 24 | #' @export 25 | posixct_bounded <- function(left, right, len = c(1L, 10L), any_na = FALSE) { 26 | as_posixct <- 27 | purrr::partial(as.POSIXct, origin = "1970-01-01") 28 | 29 | qc_gen(function(len2 = len) 30 | hedgehog::gen.unif(as.double(left), as.double(right)) %>% 31 | replace_some_with(NA_real_, any_na) %>% 32 | hedgehog::gen.with(as_posixct) %>% 33 | vectorize(len2) 34 | ) 35 | } 36 | 37 | #' @rdname posixct_ 38 | #' @export 39 | posixct_left_bounded <- function(left, len = c(1L, 10L), any_na = FALSE) { 40 | posixct_bounded(left, max_posixct(), len, any_na) 41 | } 42 | 43 | #' @rdname posixct_ 44 | #' @export 45 | posixct_right_bounded <- function(right, len = c(1L, 10L), any_na = FALSE) { 46 | posixct_bounded(min_posixct(), right, len, any_na) 47 | } 48 | 49 | min_posixct <- function() { 50 | as.POSIXct("0000-01-01 00:00:00") 51 | } 52 | 53 | max_posixct <- function() { 54 | as.POSIXct("3000-01-01 00:00:00") 55 | } 56 | -------------------------------------------------------------------------------- /R/repeat_test.R: -------------------------------------------------------------------------------- 1 | #' Repeatedly test properties of a function 2 | #' 3 | #' @param property A function with no parameters which includes an expectation. 4 | #' @param tests The number of tests to run. 5 | #' 6 | #' @examples 7 | #' repeat_test( 8 | #' property = function() { 9 | #' num <- stats::runif(1, min = 0, max = 10) 10 | #' testthat::expect_true(num >= 0 && num <= 10) 11 | #' } 12 | #' ) 13 | #' @return A `testthat` expectation object. 14 | #' @export 15 | repeat_test <- function(property, 16 | tests = getOption("quickcheck.tests", 100L)) { 17 | for_all( 18 | a = constant(NULL), 19 | property = function(a) property(), 20 | tests = tests 21 | ) 22 | } 23 | -------------------------------------------------------------------------------- /R/testthat-suites.R: -------------------------------------------------------------------------------- 1 | test_suite_vector_generator <- function(generator, .p) { 2 | test_generator_predicate(generator, .p) 3 | test_generator_default_not_any_na(generator) 4 | test_generator_empty_vectors(generator, .p) 5 | test_generator_default_vector_length(generator) 6 | test_generator_vector_length(generator) 7 | test_generator_vector_length_range(generator) 8 | test_generator_with_na(generator, .p) 9 | } 10 | 11 | test_suite_list_of_generator <- function(generator, .p) { 12 | list_of_anything <- 13 | purrr::partial(generator, generator = anything()) 14 | 15 | test_generator_predicate(list_of_anything, .p) 16 | test_generator_empty_vectors(list_of_anything, .p) 17 | test_generator_default_vector_length(list_of_anything) 18 | test_generator_vector_length(list_of_anything) 19 | test_generator_vector_length_range(list_of_anything) 20 | } 21 | 22 | test_suite_flat_list_of_generator <- function(generator, .p) { 23 | list_of_any_atomic <- 24 | purrr::partial(generator, generator = any_atomic()) 25 | 26 | test_generator_predicate(list_of_any_atomic, .p) 27 | test_generator_empty_vectors(list_of_any_atomic, .p) 28 | test_generator_default_vector_length(list_of_any_atomic) 29 | test_generator_vector_length(list_of_any_atomic) 30 | test_generator_vector_length_range(list_of_any_atomic) 31 | } 32 | 33 | test_suite_data_frame_generator <- function(generator, .p) { 34 | single_col_generator <- 35 | purrr::partial(generator, col_a = any_vector()) 36 | 37 | test_generator_data_frame_wraps_vector(generator, .p) 38 | test_generator_empty_data_frame(single_col_generator, .p) 39 | test_generator_default_rows(single_col_generator, .p) 40 | test_generator_specific_rows(single_col_generator, .p) 41 | test_generator_range_rows(single_col_generator, .p) 42 | test_generator_non_modifiable_length(generator) 43 | } 44 | 45 | test_suite_data_frame_of_generator <- function(generator, .p) { 46 | single_col_generator <- 47 | purrr::partial( 48 | generator, 49 | any_vector(), 50 | cols = 1L 51 | ) 52 | 53 | test_generator_data_frame_of_wraps_vector(single_col_generator, .p) 54 | test_generator_default_rows(single_col_generator, .p) 55 | test_generator_specific_rows(single_col_generator, .p) 56 | test_generator_range_rows(single_col_generator, .p) 57 | test_generator_non_modifiable_length(generator) 58 | } 59 | 60 | test_suite_any_data_frame_generator <- function(generator, .p) { 61 | test_generator_empty_data_frame(generator, .p) 62 | test_generator_default_rows(generator, .p) 63 | test_generator_specific_rows(generator, .p) 64 | test_generator_range_rows(generator, .p) 65 | } 66 | 67 | test_generator_predicate <- function(generator, .p) { 68 | testthat::test_that( 69 | paste0( 70 | deparse(substitute(generator)), 71 | " generates correct values" 72 | ), 73 | { 74 | for_all( 75 | a = generator(), 76 | property = function(a) .p(a) %>% testthat::expect_true() 77 | ) 78 | } 79 | ) 80 | } 81 | 82 | test_generator_default_not_any_na <- function(generator) { 83 | testthat::test_that( 84 | paste0( 85 | deparse(substitute(generator)), 86 | " doesn't generate NAs by default" 87 | ), 88 | { 89 | for_all( 90 | a = generator(), 91 | property = function(a) { 92 | unlist(a) %>% is.na() %>% any() %>% testthat::expect_false() 93 | } 94 | ) 95 | } 96 | ) 97 | } 98 | 99 | test_generator_empty_vectors <- function(generator, .p) { 100 | testthat::test_that( 101 | paste0( 102 | deparse(substitute(generator)), 103 | " can generate empty vectors" 104 | ), 105 | { 106 | for_all( 107 | a = generator(len = 0L), 108 | property = function(a) .p(a) %>% testthat::expect_true() 109 | ) 110 | 111 | for_all( 112 | a = generator(len = 0L), 113 | property = function(a) length(a) %>% testthat::expect_equal(0L) 114 | ) 115 | } 116 | ) 117 | } 118 | 119 | test_generator_default_vector_length <- function(generator) { 120 | testthat::test_that( 121 | paste0( 122 | deparse(substitute(generator)), 123 | " generates vectors with lengths between 1 and 10 inclusive" 124 | ), 125 | { 126 | for_all( 127 | a = generator(), 128 | property = function(a) { 129 | testthat::expect_true(length(a) >= 1L && length(a) <= 10L) 130 | } 131 | ) 132 | } 133 | ) 134 | } 135 | 136 | test_generator_vector_length <- function(generator) { 137 | testthat::test_that( 138 | paste0( 139 | deparse(substitute(generator)), 140 | " generates vectors of a specific length" 141 | ), 142 | { 143 | for_all( 144 | len = integer_bounded(0L, 10L, len = 1L), 145 | property = function(len) { 146 | for_all( 147 | a = generator(len = len), 148 | property = function(a) length(a) %>% testthat::expect_equal(len), 149 | tests = nested_tests() 150 | ) 151 | }, 152 | tests = nested_tests() 153 | ) 154 | } 155 | ) 156 | } 157 | 158 | test_generator_vector_length_range <- function(generator) { 159 | testthat::test_that( 160 | paste0( 161 | deparse(substitute(generator)), 162 | " generates vectors within a range of lengths" 163 | ), 164 | { 165 | for_all( 166 | min = integer_bounded(0L, 5L, len = 1L), 167 | max = integer_bounded(5L, 10L, len = 1L), 168 | property = function(min, max) { 169 | for_all( 170 | a = generator(len = c(min, max)), 171 | property = function(a) { 172 | testthat::expect_true(length(a) >= min && length(a) <= max) 173 | }, 174 | tests = nested_tests() 175 | ) 176 | }, 177 | tests = nested_tests() 178 | ) 179 | } 180 | ) 181 | } 182 | 183 | test_generator_with_na <- function(generator, .p) { 184 | testthat::test_that( 185 | paste0( 186 | deparse(substitute(generator)), 187 | " can generate vectors with NAs" 188 | ), 189 | { 190 | for_all( 191 | a = generator(len = 100L, any_na = TRUE), 192 | property = function(a) { 193 | unlist(a) %>% is.na() %>% any() %>% testthat::expect_true() 194 | }, 195 | tests = 10L 196 | ) 197 | } 198 | ) 199 | } 200 | 201 | test_generator_data_frame_wraps_vector <- function(generator, .p) { 202 | testthat::test_that( 203 | paste0( 204 | deparse(substitute(generator)), 205 | " wraps a vector in a data frame subclass" 206 | ), 207 | { 208 | for_all( 209 | a = generator( 210 | col_a = any_vector(len = c(0L, 10L), any_na = TRUE) 211 | ), 212 | property = function(a) 213 | (is_vector(a$col_a) && .p(a)) %>% testthat::expect_true() 214 | ) 215 | } 216 | ) 217 | } 218 | 219 | test_generator_data_frame_of_wraps_vector <- function(generator, .p) { 220 | testthat::test_that( 221 | paste0( 222 | deparse(substitute(generator)), 223 | " wraps a vector in a data frame subclass" 224 | ), 225 | { 226 | for_all( 227 | a = generator(), 228 | property = function(a) 229 | (is_vector(a[[1L]]) && .p(a)) %>% testthat::expect_true() 230 | ) 231 | } 232 | ) 233 | } 234 | 235 | test_generator_empty_data_frame <- function(generator, .p) { 236 | testthat::test_that( 237 | paste0( 238 | deparse(substitute(generator)), 239 | " can generate empty data frames" 240 | ), 241 | { 242 | for_all( 243 | a = generator(rows = 0L), 244 | property = function(a) 245 | (nrow(a) == 0L && .p(a)) %>% testthat::expect_true() 246 | ) 247 | } 248 | ) 249 | } 250 | 251 | test_generator_default_rows <- function(generator, .p) { 252 | testthat::test_that( 253 | paste0( 254 | deparse(substitute(generator)), 255 | " generates data frame subclasses with rows from 1 to 10 by default" 256 | ), 257 | { 258 | for_all( 259 | a = generator(), 260 | property = function(a) 261 | (nrow(a) >= 1L && nrow(a) <= 10L) %>% testthat::expect_true() 262 | ) 263 | } 264 | ) 265 | } 266 | 267 | test_generator_specific_rows <- function(generator, .p) { 268 | testthat::test_that( 269 | paste0( 270 | deparse(substitute(generator)), 271 | " generates data frame subclasses with a specific number of rows" 272 | ), 273 | { 274 | for_all( 275 | rows = integer_bounded(left = 0L, right = 5L, len = 1L), 276 | property = function(rows) 277 | for_all( 278 | a = generator(rows = rows), 279 | property = function(a) nrow(a) %>% testthat::expect_identical(rows), 280 | tests = nested_tests() 281 | ), 282 | tests = nested_tests() 283 | ) 284 | } 285 | ) 286 | } 287 | 288 | test_generator_range_rows <- function(generator, .p) { 289 | testthat::test_that( 290 | paste0( 291 | deparse(substitute(generator)), 292 | " generates data frame subclasses with a range of rows" 293 | ), 294 | { 295 | for_all( 296 | min = integer_bounded(left = 0L, right = 5L, len = 1L), 297 | max = integer_bounded(left = 5L, right = 10L, len = 1L), 298 | property = function(min, max) 299 | for_all( 300 | a = generator(rows = c(min, max)), 301 | property = function(a) 302 | (nrow(a) >= min && nrow(a) <= max) %>% testthat::expect_true(), 303 | tests = nested_tests() 304 | ), 305 | tests = nested_tests() 306 | ) 307 | } 308 | ) 309 | } 310 | 311 | test_generator_non_modifiable_length <- function(generator) { 312 | testthat::test_that( 313 | paste0( 314 | deparse(substitute(generator)), 315 | " fails if generator arguments don't have modifiable lengths" 316 | ), 317 | { 318 | non_modifiable_length <- 319 | any_vector() %>% as_hedgehog() %>% from_hedgehog() 320 | 321 | repeat_test( 322 | property = function() { 323 | generator(col_a = non_modifiable_length) %>% testthat::expect_error() 324 | } 325 | ) 326 | } 327 | ) 328 | } 329 | -------------------------------------------------------------------------------- /R/tibble.R: -------------------------------------------------------------------------------- 1 | #' Tibble generators 2 | #' 3 | #' Construct tibble generators in a similar way to `tibble::tibble`. 4 | #' 5 | #' @param ... A set of name-value pairs with the values being vector generators. 6 | #' @template rows 7 | #' 8 | #' @examples 9 | #' tibble_(a = integer_()) %>% show_example() 10 | #' tibble_(a = integer_(), b = character_(), rows = 5L) %>% show_example() 11 | #' @template generator 12 | #' @export 13 | tibble_ <- function(..., rows = c(1L, 10L)) { 14 | assert_all_modifiable_length(...) 15 | 16 | qc_gen(function() 17 | equal_length(..., len = rows)() %>% 18 | hedgehog::gen.with(tibble::as_tibble) 19 | ) 20 | } 21 | 22 | #' Random tibble generator 23 | #' 24 | #' @param ... A set of unnamed generators. The generated tibbles will be built 25 | #' with random combinations of these generators. 26 | #' @template rows 27 | #' @template cols 28 | #' 29 | #' @examples 30 | #' tibble_of(logical_(), date_()) %>% show_example() 31 | #' tibble_of(any_atomic(), rows = 10L, cols = 5L) %>% show_example() 32 | #' @template generator 33 | #' @export 34 | tibble_of <- function(..., rows = c(1L, 10L), cols = c(1L, 10L)) { 35 | assert_all_modifiable_length(...) 36 | 37 | as_tibble <- 38 | function(a) 39 | suppressMessages( 40 | tibble::as_tibble(a, .name_repair = "unique") 41 | ) 42 | 43 | expand_rows_and_cols <- 44 | function(dims) 45 | list(...) %>% 46 | expand_rows(dims$rows) %>% 47 | expand_cols(dims$cols) 48 | 49 | generate_tibble <- 50 | function(dims) 51 | expand_rows_and_cols(dims) %>% 52 | hedgehog::gen.with(as_tibble) 53 | 54 | row_generator <- 55 | as_length_generator(rows) 56 | 57 | col_generator <- 58 | as_length_generator(cols) 59 | 60 | qc_gen(function() 61 | list_(rows = row_generator, cols = col_generator)() %>% 62 | hedgehog::gen.and_then(generate_tibble) 63 | ) 64 | } 65 | 66 | expand_cols <- function(generators, cols) { 67 | repeats <- 68 | if (length(cols) == 1L) 69 | cols 70 | 71 | else 72 | seq(cols[1L], cols[2L]) %>% sample_vec() 73 | 74 | sample_cols <- 75 | function(a) generators[sample(1:length(generators), a, TRUE)] 76 | 77 | sample_cols(repeats) 78 | } 79 | 80 | expand_rows <- function(generators, rows) { 81 | repeats <- 82 | if (length(rows) == 1L) 83 | rows 84 | 85 | else 86 | seq(rows[1L], rows[2L]) %>% sample_vec() 87 | 88 | expand_vectors <- 89 | function(a) purrr::map(generators, function(f) f(len2 = a)) 90 | 91 | expand_vectors(repeats) 92 | } 93 | -------------------------------------------------------------------------------- /R/utils-pipe.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' See \code{magrittr::\link[magrittr:pipe]{\%>\%}} for details. 4 | #' 5 | #' @name %>% 6 | #' @rdname pipe 7 | #' @keywords internal 8 | #' @export 9 | #' @importFrom magrittr %>% 10 | #' @usage lhs \%>\% rhs 11 | #' @param lhs A value or the magrittr placeholder. 12 | #' @param rhs A function call using the magrittr semantics. 13 | #' @return The result of calling `rhs(lhs)`. 14 | NULL 15 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | qc_gen <- function(a) { 2 | structure(a, class = "quickcheck_generator") 3 | } 4 | 5 | sample_vec <- function(a, n = 1L) { 6 | if (n_distinct(a) == 1L) 7 | a[[1L]] 8 | 9 | else 10 | sample(a, size = n, replace = TRUE) 11 | } 12 | 13 | as_length_generator <- function(a) { 14 | if (length(a) == 1L) 15 | constant(a) 16 | 17 | else 18 | integer_bounded(a[1], a[2], len = 1L) 19 | } 20 | 21 | eval_functions <- function(...) { 22 | purrr::map(list(...), function(f) f()) 23 | } 24 | 25 | equals <- function(a, b) { 26 | a == b 27 | } 28 | 29 | overlaps_zero <- function(left, right) { 30 | isTRUE(left <= 0L && right >= 0L) 31 | } 32 | 33 | is_posixct <- function(a) { 34 | inherits(a, "POSIXct") 35 | } 36 | 37 | is_date <- function(a) { 38 | inherits(a, "Date") 39 | } 40 | 41 | is_data_frame <- function(a) { 42 | identical(class(a), "data.frame") 43 | } 44 | 45 | is_zero <- function(a) { 46 | identical(a, 0) || identical(a, 0L) 47 | } 48 | 49 | is_infinite <- function(a) { 50 | is.atomic(a) && isTRUE(is.infinite(a)) 51 | } 52 | 53 | is_nan <- function(a) { 54 | is.atomic(a) && isTRUE(is.nan(a)) 55 | } 56 | 57 | is_na <- function(a) { 58 | isTRUE(is.na(a)) 59 | } 60 | 61 | is_undefined <- function(a) { 62 | is.null(a) || is_infinite(a) || is_nan(a) || is_na(a) 63 | } 64 | 65 | is_vector <- function(a) { 66 | Negate(is.null)(a) && (is.atomic(a) || is.list(a)) 67 | } 68 | 69 | is_empty_character <- function(a) { 70 | a == "" 71 | } 72 | 73 | is_flat_list <- function(a) { 74 | if (is_empty_list(a)) 75 | TRUE 76 | 77 | else { 78 | flattened <- 79 | unlist(a, recursive = FALSE) 80 | 81 | lengths_equal <- 82 | length(a) == length(flattened) 83 | 84 | lengths_equal && is.atomic(flattened) 85 | } 86 | } 87 | 88 | is_homogeneous_list <- function(a) { 89 | if (is_empty_list(a)) 90 | TRUE 91 | 92 | else { 93 | is_homogeneous <- 94 | purrr::map(a, class) %>% 95 | n_distinct() %>% 96 | equals(1) 97 | 98 | is.list(a) && is_homogeneous 99 | } 100 | } 101 | 102 | is_flat_homogeneous_list <- function(a) { 103 | is_flat_list(a) && is_homogeneous_list(a) 104 | } 105 | 106 | is_empty_data_frame <- function(a) { 107 | if (is.data.frame(a)) 108 | isTRUE(nrow(a) == 0L) 109 | 110 | else 111 | FALSE 112 | } 113 | 114 | is_empty_vector <- function(a) { 115 | isTRUE(!is.null(a) && length(a) == 0L) 116 | } 117 | 118 | is_empty_list <- function(a) { 119 | is_empty_vector(a) && is.list(a) 120 | } 121 | 122 | is_dev_version <- function() { 123 | version_length <- 124 | utils::packageDescription("quickcheck") %>% 125 | purrr::pluck("Version") %>% 126 | strsplit("\\.") %>% 127 | purrr::pluck(1L) %>% 128 | length() 129 | 130 | version_length > 3L 131 | } 132 | 133 | tests <- function() { 134 | getOption("quickcheck.tests", 100L) 135 | } 136 | 137 | nested_tests <- function() { 138 | tests() %>% sqrt() %>% round() 139 | } 140 | 141 | assert_modifiable_length <- function(generator) { 142 | has_modifiable_length <- 143 | formals(generator) %>% 144 | names() %>% 145 | purrr::has_element("len2") 146 | 147 | if (has_modifiable_length) 148 | TRUE 149 | 150 | else 151 | stop( 152 | "Generator arguments must be quickcheck vector generators.", 153 | call. = FALSE 154 | ) 155 | } 156 | 157 | assert_all_modifiable_length <- function(...) { 158 | list(...) %>% purrr::map(assert_modifiable_length) 159 | } 160 | 161 | or <- function(...) { 162 | funs <- 163 | list(...) 164 | 165 | function(a) { 166 | for (i in seq_along(funs)) 167 | if (isTRUE(funs[[i]](a))) 168 | return(TRUE) 169 | 170 | FALSE 171 | } 172 | } 173 | 174 | n_distinct <- function(a) { 175 | purrr::compose(length, unique)(a) 176 | } 177 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | 7 | ```{r, include = FALSE} 8 | knitr::opts_chunk$set( 9 | collapse = TRUE, 10 | comment = "#>", 11 | fig.path = "man/figures/README-", 12 | out.width = "100%" 13 | ) 14 | ``` 15 | 16 | # quickcheck 17 | 18 | 19 | [![CRAN status](https://www.r-pkg.org/badges/version/quickcheck)](https://CRAN.R-project.org/package=quickcheck) 20 | [![R-CMD-check](https://github.com/armcn/quickcheck/workflows/R-CMD-check/badge.svg)](https://github.com/armcn/quickcheck/actions) 21 | [![Codecov test coverage](https://codecov.io/gh/armcn/quickcheck/branch/main/graph/badge.svg)](https://app.codecov.io/gh/armcn/quickcheck?branch=main) 22 | [![metacran downloads](https://cranlogs.r-pkg.org/badges/quickcheck)](https://cran.r-project.org/package=quickcheck) 23 | 24 | 25 | # Overview 26 | 27 | Property based testing in R, inspired by [QuickCheck](https://en.wikipedia.org/wiki/QuickCheck). This package builds on the property based testing framework provided by [`hedgehog`](https://github.com/hedgehogqa/r-hedgehog) and is designed to seamlessly integrate with [`testthat`](https://testthat.r-lib.org). 28 | 29 | ## Installation 30 | 31 | You can install the released version of `quickcheck` from [CRAN](https://CRAN.R-project.org) with: 32 | 33 | ```{r, eval=FALSE} 34 | install.packages("quickcheck") 35 | ``` 36 | 37 | And the development version from [GitHub](https://github.com/) with: 38 | 39 | ```{r, eval=FALSE} 40 | # install.packages("remotes") 41 | remotes::install_github("armcn/quickcheck") 42 | ``` 43 | 44 | # Usage 45 | 46 | The following example uses `quickcheck` to test the properties of the base R `+` function. [Here](https://fsharpforfunandprofit.com/posts/property-based-testing/) is an introduction to the concept of property based testing, and an explanation of the mathematical properties of addition can be found [here](https://www.khanacademy.org/math/cc-sixth-grade-math/cc-6th-factors-and-multiples/properties-of-numbers/a/properties-of-addition). 47 | 48 | ```{r} 49 | library(testthat) 50 | library(quickcheck) 51 | 52 | test_that("0 is the additive identity of +", { 53 | for_all( 54 | a = numeric_(len = 1), 55 | property = function(a) expect_equal(a, a + 0) 56 | ) 57 | }) 58 | 59 | test_that("+ is commutative", { 60 | for_all( 61 | a = numeric_(len = 1), 62 | b = numeric_(len = 1), 63 | property = function(a, b) expect_equal(a + b, b + a) 64 | ) 65 | }) 66 | 67 | test_that("+ is associative", { 68 | for_all( 69 | a = numeric_(len = 1), 70 | b = numeric_(len = 1), 71 | c = numeric_(len = 1), 72 | property = function(a, b, c) expect_equal(a + (b + c), (a + b) + c) 73 | ) 74 | }) 75 | ``` 76 | 77 | Here we test the properties of the [`distinct`](https://dplyr.tidyverse.org/reference/distinct.html) 78 | function from the [`dplyr`](https://dplyr.tidyverse.org/index.html) package. 79 | 80 | ```{r} 81 | library(dplyr, warn.conflicts = FALSE) 82 | 83 | test_that("distinct does nothing with a single row", { 84 | for_all( 85 | a = any_tibble(rows = 1L), 86 | property = function(a) { 87 | distinct(a) %>% expect_equal(a) 88 | } 89 | ) 90 | }) 91 | 92 | test_that("distinct returns single row if rows are repeated", { 93 | for_all( 94 | a = any_tibble(rows = 1L), 95 | property = function(a) { 96 | bind_rows(a, a) %>% 97 | distinct() %>% 98 | expect_equal(a) 99 | } 100 | ) 101 | }) 102 | 103 | test_that("distinct does nothing if rows are unique", { 104 | for_all( 105 | a = tibble_of(integer_positive(), rows = 1L, cols = 1L), 106 | b = tibble_of(integer_negative(), rows = 1L, cols = 1L), 107 | property = function(a, b) { 108 | unique_rows <- bind_rows(a, b) 109 | distinct(unique_rows) %>% expect_equal(unique_rows) 110 | } 111 | ) 112 | }) 113 | ``` 114 | 115 | ## Quickcheck generators 116 | 117 | Many generators are provided with `quickcheck`. Here are a few examples. 118 | 119 | ### Atomic vectors 120 | 121 | ```{r} 122 | integer_(len = 10) %>% show_example() 123 | character_alphanumeric(len = 10) %>% show_example() 124 | posixct_(len = 10, any_na = TRUE) %>% show_example() 125 | ``` 126 | 127 | ### Lists 128 | 129 | ```{r} 130 | list_(a = constant(NULL), b = any_undefined()) %>% show_example() 131 | flat_list_of(logical_(), len = 3) %>% show_example() 132 | ``` 133 | 134 | ### Tibbles 135 | 136 | ```{r} 137 | tibble_(a = date_(), b = hms_(), rows = 5) %>% show_example() 138 | tibble_of(double_bounded(-10, 10), rows = 3, cols = 3) %>% show_example() 139 | any_tibble(rows = 3, cols = 3) %>% show_example() 140 | ``` 141 | 142 | ## Hedgehog generators 143 | 144 | `quickcheck` is meant to work with `hedgehog`, not replace it. `hedgehog` generators 145 | can be used by wrapping them in `from_hedgehog`. 146 | 147 | ```{r} 148 | library(hedgehog) 149 | 150 | is_even <- 151 | function(a) a %% 2 == 0 152 | 153 | gen_powers_of_two <- 154 | gen.element(1:10) %>% gen.with(function(a) 2^a) 155 | 156 | test_that("is_even returns TRUE for powers of two", { 157 | for_all( 158 | a = from_hedgehog(gen_powers_of_two), 159 | property = function(a) is_even(a) %>% expect_true() 160 | ) 161 | }) 162 | ``` 163 | 164 | Any `hedgehog` generator can be used with `quickcheck` but they can't be composed 165 | together to build another generator. For example this will work: 166 | 167 | ```{r} 168 | test_that("powers of two and integers are both numeric values", { 169 | for_all( 170 | a = from_hedgehog(gen_powers_of_two), 171 | b = integer_(), 172 | property = function(a, b) { 173 | c(a, b) %>% 174 | is.numeric() %>% 175 | expect_true() 176 | } 177 | ) 178 | }) 179 | ``` 180 | 181 | But this will cause an error: 182 | 183 | ```{r} 184 | test_that("composing hedgehog with quickcheck generators fails", { 185 | tibble_of(from_hedgehog(gen_powers_of_two)) %>% expect_error() 186 | }) 187 | ``` 188 | 189 | A `quickcheck` generator can also be converted to a `hedgehog` generator which can 190 | then be used with other `hedgehog` functions. 191 | 192 | ```{r} 193 | gen_powers_of_two <- 194 | integer_bounded(1L, 10L, len = 1L) %>% 195 | as_hedgehog() %>% 196 | gen.with(function(a) 2^a) 197 | 198 | 199 | test_that("is_even returns TRUE for powers of two", { 200 | for_all( 201 | a = from_hedgehog(gen_powers_of_two), 202 | property = function(a) is_even(a) %>% expect_true() 203 | ) 204 | }) 205 | ``` 206 | 207 | ## Fuzz tests 208 | 209 | Fuzz testing is a special case of property based testing in which the only 210 | property being tested is that the code doesn't fail with a range of inputs. 211 | Here is an example of how to do fuzz testing with `quickcheck`. Let's say we want 212 | to test that the `purrr::map` function won't fail with any vector as input. 213 | 214 | ```{r} 215 | test_that("map won't fail with any vector as input", { 216 | for_all( 217 | a = any_vector(), 218 | property = function(a) purrr::map(a, identity) %>% expect_silent() 219 | ) 220 | }) 221 | ``` 222 | 223 | ## Repeat tests 224 | 225 | Repeat tests can be used to repeatedly test that a property holds true for many 226 | calls of a function. These are different from regular property based tests 227 | because they don't require generators. The function `repeat_test` will call 228 | a function many times to ensure the expectation passes in all cases. This kind 229 | of test can be useful for testing functions with randomness. 230 | 231 | ```{r} 232 | test_that("runif generates random numbers between a min and max value", { 233 | repeat_test( 234 | property = function() { 235 | random_number <- runif(1, min = 0, max = 10) 236 | expect_true(random_number >= 0 && random_number <= 10) 237 | } 238 | ) 239 | }) 240 | ``` 241 | 242 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # quickcheck 5 | 6 | 7 | 8 | [![CRAN 9 | status](https://www.r-pkg.org/badges/version/quickcheck)](https://CRAN.R-project.org/package=quickcheck) 10 | [![R-CMD-check](https://github.com/armcn/quickcheck/workflows/R-CMD-check/badge.svg)](https://github.com/armcn/quickcheck/actions) 11 | [![Codecov test 12 | coverage](https://codecov.io/gh/armcn/quickcheck/branch/main/graph/badge.svg)](https://app.codecov.io/gh/armcn/quickcheck?branch=main) 13 | [![metacran 14 | downloads](https://cranlogs.r-pkg.org/badges/quickcheck)](https://cran.r-project.org/package=quickcheck) 15 | 16 | 17 | # Overview 18 | 19 | Property based testing in R, inspired by 20 | [QuickCheck](https://en.wikipedia.org/wiki/QuickCheck). This package 21 | builds on the property based testing framework provided by 22 | [`hedgehog`](https://github.com/hedgehogqa/r-hedgehog) and is designed 23 | to seamlessly integrate with [`testthat`](https://testthat.r-lib.org). 24 | 25 | ## Installation 26 | 27 | You can install the released version of `quickcheck` from 28 | [CRAN](https://CRAN.R-project.org) with: 29 | 30 | ``` r 31 | install.packages("quickcheck") 32 | ``` 33 | 34 | And the development version from [GitHub](https://github.com/) with: 35 | 36 | ``` r 37 | # install.packages("remotes") 38 | remotes::install_github("armcn/quickcheck") 39 | ``` 40 | 41 | # Usage 42 | 43 | The following example uses `quickcheck` to test the properties of the 44 | base R `+` function. 45 | [Here](https://fsharpforfunandprofit.com/posts/property-based-testing/) 46 | is an introduction to the concept of property based testing, and an 47 | explanation of the mathematical properties of addition can be found 48 | [here](https://www.khanacademy.org/math/cc-sixth-grade-math/cc-6th-factors-and-multiples/properties-of-numbers/a/properties-of-addition). 49 | 50 | ``` r 51 | library(testthat) 52 | library(quickcheck) 53 | 54 | test_that("0 is the additive identity of +", { 55 | for_all( 56 | a = numeric_(len = 1), 57 | property = function(a) expect_equal(a, a + 0) 58 | ) 59 | }) 60 | #> Test passed 🎉 61 | 62 | test_that("+ is commutative", { 63 | for_all( 64 | a = numeric_(len = 1), 65 | b = numeric_(len = 1), 66 | property = function(a, b) expect_equal(a + b, b + a) 67 | ) 68 | }) 69 | #> Test passed 😸 70 | 71 | test_that("+ is associative", { 72 | for_all( 73 | a = numeric_(len = 1), 74 | b = numeric_(len = 1), 75 | c = numeric_(len = 1), 76 | property = function(a, b, c) expect_equal(a + (b + c), (a + b) + c) 77 | ) 78 | }) 79 | #> Test passed 😀 80 | ``` 81 | 82 | Here we test the properties of the 83 | [`distinct`](https://dplyr.tidyverse.org/reference/distinct.html) 84 | function from the [`dplyr`](https://dplyr.tidyverse.org/index.html) 85 | package. 86 | 87 | ``` r 88 | library(dplyr, warn.conflicts = FALSE) 89 | 90 | test_that("distinct does nothing with a single row", { 91 | for_all( 92 | a = any_tibble(rows = 1L), 93 | property = function(a) { 94 | distinct(a) %>% expect_equal(a) 95 | } 96 | ) 97 | }) 98 | #> Test passed 🎊 99 | 100 | test_that("distinct returns single row if rows are repeated", { 101 | for_all( 102 | a = any_tibble(rows = 1L), 103 | property = function(a) { 104 | bind_rows(a, a) %>% 105 | distinct() %>% 106 | expect_equal(a) 107 | } 108 | ) 109 | }) 110 | #> Test passed 🎊 111 | 112 | test_that("distinct does nothing if rows are unique", { 113 | for_all( 114 | a = tibble_of(integer_positive(), rows = 1L, cols = 1L), 115 | b = tibble_of(integer_negative(), rows = 1L, cols = 1L), 116 | property = function(a, b) { 117 | unique_rows <- bind_rows(a, b) 118 | distinct(unique_rows) %>% expect_equal(unique_rows) 119 | } 120 | ) 121 | }) 122 | #> Test passed 😀 123 | ``` 124 | 125 | ## Quickcheck generators 126 | 127 | Many generators are provided with `quickcheck`. Here are a few examples. 128 | 129 | ### Atomic vectors 130 | 131 | ``` r 132 | integer_(len = 10) %>% show_example() 133 | #> [1] -833 5111 -8831 -3495 -1899 1051 9964 2473 9557 -2465 134 | character_alphanumeric(len = 10) %>% show_example() 135 | #> [1] "y5Ph" "8" "B8" "3vOcYf" "qr" "o" 136 | #> [7] "5rW2nHdrA" "88" "umU" "vJpqr" 137 | posixct_(len = 10, any_na = TRUE) %>% show_example() 138 | #> [1] "1652-02-25 11:34:40 LMT" "1683-08-15 05:26:47 LMT" 139 | #> [3] "2339-08-19 19:19:07 PDT" "0244-05-09 12:26:30 LMT" 140 | #> [5] "0756-11-24 03:23:10 LMT" "0660-04-16 21:21:08 LMT" 141 | #> [7] "2993-05-14 04:45:47 PDT" NA 142 | #> [9] "1301-04-09 00:40:00 LMT" NA 143 | ``` 144 | 145 | ### Lists 146 | 147 | ``` r 148 | list_(a = constant(NULL), b = any_undefined()) %>% show_example() 149 | #> $a 150 | #> NULL 151 | #> 152 | #> $b 153 | #> [1] -Inf 154 | flat_list_of(logical_(), len = 3) %>% show_example() 155 | #> [[1]] 156 | #> [1] TRUE 157 | #> 158 | #> [[2]] 159 | #> [1] TRUE 160 | #> 161 | #> [[3]] 162 | #> [1] TRUE 163 | ``` 164 | 165 | ### Tibbles 166 | 167 | ``` r 168 | tibble_(a = date_(), b = hms_(), rows = 5) %>% show_example() 169 | #> # A tibble: 5 x 2 170 | #> a b 171 | #>