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
|
## Just a small subset of those from 'Matrix' i.e,
## system.file("test-tools-1.R", package = "Matrix")
identical3 <- function(x,y,z) identical(x,y) && identical (y,z)
identical4 <- function(a,b,c,d) identical(a,b) && identical3(b,c,d)
identical5 <- function(a,b,c,d,e) identical(a,b) && identical4(b,c,d,e)
assert.EQ <- function(target, current, tol = if(showOnly) 0 else 1e-15,
giveRE = FALSE, showOnly = FALSE, ...) {
## Purpose: check equality *and* show non-equality
## ----------------------------------------------------------------------
## showOnly: if TRUE, return (and hence typically print) all.equal(...)
T <- isTRUE(ae <- all.equal(target, current, tolerance = tol, ...))
if(showOnly) return(ae) else if(giveRE && T) { ## don't show if stop() later:
ae0 <- if(tol == 0) ae else all.equal(target, current, tolerance = 0, ...)
if(!isTRUE(ae0)) writeLines(ae0)
}
if(!T) stop("all.equal() |-> ", paste(ae, collapse=sprintf("%-19s","\n")))
else if(giveRE) invisible(ae0)
}
pkgRversion <- function(pkgname)
sub("^R ([0-9.]+).*", "\\1", packageDescription(pkgname)[["Built"]])
showSys.time <- function(expr, ...) {
## prepend 'Time' for R CMD Rdiff
st <- system.time(expr, ...)
writeLines(paste("Time", capture.output(print(st))))
invisible(st)
}
showProc.time <- local({ ## function + 'pct' variable
pct <- summary(proc.time())# length 3, shorter names
function(final="\n", ind=TRUE) { ## CPU elapsed __since last called__
ot <- pct ; pct <<- summary(proc.time())
delta <- (pct - ot)[ind]
## 'Time' *not* to be translated: tools::Rdiff() skips its lines!
cat('Time', paste0("(",paste(names(delta),collapse=" "),"):"), delta, final)
}
})
## == sfsmisc::relErr :
relErr <- function(target, current) { ## make this work for 'Matrix' ==> no mean() ..
n <- length(current)
if(length(target) < n)
target <- rep(target, length.out = n)
sum(abs(target - current)) / sum(abs(target))
}
|
