dot-D-utils | R Documentation |
Utility functions for "dpq"-computations, parelling those in R's own C source ‘<Rsource>/src/nmath/dpq.h’, (“dpq” := density–probability–quantile).
.D_0(log.p) # prob/density == 0 (for log.p=FALSE)
.D_1(log.p) # prob == 1 " "
.DT_0(lower.tail, log.p) # == 0 when (lower.tail=TRUE, log.p=FALSE)
.DT_1(lower.tail, log.p) # == 1 when " "
.D_Lval(p, lower.tail) # p {L}ower
.D_Cval(p, lower.tail) # 1-p {C}omplementary
.D_val (x, log.p) # x in pF(x,..)
.D_qIv (p, log.p) # p in qF(p,..)
.D_exp (x, log.p) # exp(x) unless log.p where it's x
.D_log (p, log.p) # p " " " " log(p)
.D_Clog(p, log.p) # 1-p " " " " log(1-p) == log1p(-)
.D_LExp(x, log.p) ## [log](1 - exp(-x)) == log1p(- .D_qIv(x))) even more stable
.DT_val (x, lower.tail, log.p) # := .D_val(.D_Lval(x, lower.tail), log.p) == x in pF
.DT_Cval(x, lower.tail, log.p) # := .D_val(.D_Cval(x, lower.tail), log.p) == 1-x in pF
.DT_qIv (p, lower.tail, log.p) # := .D_Lval(.D_qIv(p)) == p in qF
.DT_CIv (p, lower.tail, log.p) # := .D_Cval(.D_qIv(p)) == 1-p in qF
.DT_exp (x, lower.tail, log.p) # exp( x )
.DT_Cexp(x, lower.tail, log.p) # exp(1-x)
.DT_log (p, lower.tail, log.p) # log ( p ) in qF
.DT_Clog(p, lower.tail, log.p) # log (1-p) in qF
.DT_Log (p, lower.tail) # log ( p ) in qF(p,..,log.p=TRUE)
x |
numeric vector. |
p |
(log) probability–like numeric vector. |
lower.tail |
logical; if true, probabilities are |
log.p |
logical; if true, probabilities |
Typically a numeric vector “as” x
or p
, respectively.
Martin Maechler
log1mexp()
which is called from .D_LExp()
and .DT_Log()
.
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 = {
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.