Below is a third cut at all.equal and the generic function test.equal which
is intended to return a T/F value. There was a suggestion that
"is.equal" rather
than "test.equal" might be considered as a name. I have mixed feelings
about
this. I associate the "is" functions with inheritance rather than
comparisons,
but the "equal" part of the name makes it clear. How do others feel
about this?
The default method for all.equal now tries to recursively extract all numeric
elements and compare using tolerance. It also tries to do a relative comparison
rather than an absolute comparison, except for very small numbers. I hope
someone with more experience than I have will examine this part carefully!
Paul Gilbert
_______
test.equal <-function (obj1, obj2, ...) UseMethod("test.equal")
test.equal.default <-function (obj1, obj2, ...)
{ if (is.array(obj1)) test.equal.array(obj1, obj2, ...)
else is.logical(all.equal(obj1, obj2, ...))
}
all.equal <- function(obj1, obj2,...) {UseMethod("all.equal")}
all.equal.default <- function(obj1, obj2, tolerance=.Machine$double.eps)
{if(mode(obj1) != mode(obj2) ) return("modes
differ.")
if (length(obj1) != length(obj2) ) return("lengths
differ")
if(is.null(class(obj1)) != is.null(class(obj2))) return("classes
differ.")
else if(!is.null(class(obj1))
&& any(class(obj1) != class(obj2)) ) return("classes
differ.")
if(is.null(attributes(obj1)) != is.null(attributes(obj2)))
return("attributes
differ.")
else if(!is.null(attributes(obj1))
&& any(unlist(attributes(obj1)) != unlist(attributes(obj2))))
return("attributes
differ.")
cull.numeric <- function(obj, r=NULL) {
if (is.null(obj) | (length(obj) == 0)) return(r)
else if (is.numeric(obj)) return(c(r,obj))
else if (is.list(obj))
return( c(cull.numeric(obj[[1]], r), cull.numeric(obj[-1])) )
else return(r)
}
z1 <- cull.numeric(obj1)
if(! is.null(z1))
{z2 <- cull.numeric(obj2)
if (length(z1) != length(z2) ) return("length of numeric parts
differ")
M <- pmax(abs(z1), abs(z2))
# next line results in absolute rather than relative comparison for
# very small numbers.
M[ M < 100 *tolerance] <- 1
if (any(abs(z1 -z2) > tolerance * M))
return("numeric value differences exceed
tolerance.")
}
# next comparison is really for non-numeric values but also compares
# numeric values to the tolerance of the character representation in unlist.
if (! all(unlist(obj1) == unlist(obj2))) return("values
differ.")
T
}
-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-.-
r-devel mailing list -- Read http://www.ci.tuwien.ac.at/~hornik/R/R-FAQ.html
Send "info", "help", or "[un]subscribe"
(in the "body", not the subject !) To:
r-devel-request@stat.math.ethz.ch
_._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._._