Skip to content

Instantly share code, notes, and snippets.

@alekrutkowski
Last active September 1, 2016 10:36
Show Gist options
  • Save alekrutkowski/27701692c8351d160b4a6a1accf70804 to your computer and use it in GitHub Desktop.
Save alekrutkowski/27701692c8351d160b4a6a1accf70804 to your computer and use it in GitHub Desktop.
Boilerplate for generative property testing in R

Function for generative property testing in R

library(magrittr)
if (!('memoise' %in% installed.packages()[,"Package"]))
    stop('Package "memoise" is needed.')

gentest <- function(f, ...) {
    ## f = function
    ## ... = args to function f
    ## returns: a data.frame for all the combinations of arguments, including
    ## return values, and possibly warnings and errors
    .memf <- NULL
    mlapplyCbind(function(...)
        tryCatch({
            .memf <<- memoise::memoise(f) # to avoid re-eval below in case of warning
            df(v = .memf(...))
        },
        warning = function(w)
            df(v = .memf(...),
               w = w %>% toText),
        error = function(e)
            df(e = geterrmessage() %>% toText),
        finally = .memf <<- NULL), # to avoid cluttering memory
        ...)
}

Helpers

df <- function(v=NA,w=NA,e=NA)
    data.frame(..value=v,
               ..warning=w,
               ..error=e)
toText <- function(x)
    x %>%
    as.character %>%
    paste(collapse=' ') %>%
    # to save space in the diplayed output below:
    sub('^simpleWarning.*\\(.*\\): ',"",.) %>%
    gsub('\n',"",.) %>%
    # capitalize first letter for readability:
    gsub("(^[[:alpha:]])", "\\U\\1", ., perl=TRUE)
mlapplyCbind <- function(FUN, ...) {
    df <- list(...) %>%
        expand.grid(stringsAsFactors=FALSE,
                    KEEP.OUT.ATTRS=FALSE)
    df %>%
        split(nrow(.) %>% seq_len) %>%
        lapply(function(x)
            x %>%
                lapply(function(x)
                    if (x %>% is.list) x[[1]] else x) %>%
                do.call(FUN, .)) %>%
        do.call(rbind, .) %>%
        cbind(df, .)
}

Usage examples

gentest(mean,
        x=list(1:4,
               c(100:102,NA),
               letters[1:3]),
        na.rm=c(T,F))
##                   x na.rm ..value                                        ..warning ..error
## 1        1, 2, 3, 4  TRUE     2.5                                             <NA>      NA
## 2 100, 101, 102, NA  TRUE   101.0                                             <NA>      NA
## 3           a, b, c  TRUE      NA Argument is not numeric or logical: returning NA      NA
## 4        1, 2, 3, 4 FALSE     2.5                                             <NA>      NA
## 5 100, 101, 102, NA FALSE      NA                                             <NA>      NA
## 6           a, b, c FALSE      NA Argument is not numeric or logical: returning NA      NA
gentest(sum,
        x=list(1:4,
               c(NA,201:203),
               c('x','y','z')),
        na.rm=c(T,F))
##                   x na.rm ..value ..warning                                ..error
## 1        1, 2, 3, 4  TRUE      10        NA                                   <NA>
## 2 NA, 201, 202, 203  TRUE     606        NA                                   <NA>
## 3           x, y, z  TRUE      NA        NA Invalid 'type' (character) of argument
## 4        1, 2, 3, 4 FALSE      10        NA                                   <NA>
## 5 NA, 201, 202, 203 FALSE      NA        NA                                   <NA>
## 6           x, y, z FALSE      NA        NA Invalid 'type' (character) of argument
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment