FT <- c(FALSE, TRUE)
stopifnot(exprs = {
.D_0(log.p = FALSE) == (0)
.D_0(log.p = TRUE ) == log(0)
identical(c(1,0), vapply(FT, .D_1, double(1)))
})
## all such functions in package DPQ:
eDPQ <- as.environment("package:DPQ")
ls.str(envir=eDPQ, pattern = "^[.]D", all.names=TRUE)
(nD <- local({ n <- names(eDPQ); n[startsWith(n, ".D")] }))
trimW <- function(ch) sub(" +$","", sub("^ +","", ch))
writeLines(vapply(sort(nD), function(nm) {
B <- deparse(eDPQ[[nm]])
sprintf("%31s := %s", trimW(sub("function ", nm, B[[1]])),
paste(trimW(B[-1]), collapse=" "))
}, ""))
do.lowlog <- function(Fn, ...) {
stopifnot(is.function(Fn),
all(c("lower.tail", "log.p") %in% names(formals(Fn))))
FT <- c(FALSE, TRUE) ; cFT <- c("F", "T")
L <- lapply(FT, function(lo) sapply(FT, function(lg) Fn(..., lower.tail=lo, log.p=lg)))
r <- simplify2array(L)
`dimnames<-`(r, c(rep(list(NULL), length(dim(r)) - 2L),
list(log.p = cFT, lower.tail = cFT)))
}
do.lowlog(.DT_0)
do.lowlog(.DT_1)
do.lowlog(.DT_exp, x = 1/4) ; do.lowlog(.DT_exp, x = 3/4)
do.lowlog(.DT_val, x = 1/4) ; do.lowlog(.DT_val, x = 3/4)
do.lowlog(.DT_Cexp, x = 1/4) ; do.lowlog(.DT_Cexp, x = 3/4)
do.lowlog(.DT_Cval, x = 1/4) ; do.lowlog(.DT_Cval, x = 3/4)
do.lowlog(.DT_Clog, p = (1:3)/4) # w/ warn
do.lowlog(.DT_log, p = (1:3)/4) # w/ warn
do.lowlog(.DT_qIv, p = (1:3)/4)
## unfinished: FIXME, the above is *not* really checking
stopifnot(exprs = {
})
Run the code above in your browser using DataLab