Nothing
constancy <- function(data, parm.type = c("theta", "phi")) {
parm.type <- match.arg(parm.type)
stopifnot(inherits(data, "asterdata"))
validasterdata(data)
fam.clear()
for (i in seq(along = data$families))
fam.set(data$families[[i]])
result <- .Call(C_aster_constancy,
as.integer(data$repred),
as.integer(data$regroup),
as.integer(data$recode),
as.double(data$redelta),
parm.type == "theta")
fam.clear()
return(sparseMatrix(i = result$i, j = result$j, x = result$x,
dims = c(max(0, result$i), length(data$regroup))))
}
is.same <- function(parm1, parm2, data, parm.type = c("theta", "phi"),
tolerance = sqrt(.Machine$double.eps)) {
parm.type <- match.arg(parm.type)
stopifnot(is.atomic(parm1))
stopifnot(is.numeric(parm1))
stopifnot(all(is.finite(parm1)))
stopifnot(is.atomic(parm2))
stopifnot(is.numeric(parm2))
stopifnot(all(is.finite(parm2)))
stopifnot(inherits(data, "asterdata"))
validasterdata(data)
stopifnot(length(parm1) == length(data$repred))
stopifnot(length(parm2) == length(data$repred))
stopifnot(is.atomic(tolerance))
stopifnot(is.numeric(tolerance))
stopifnot(length(tolerance) == 1)
stopifnot(tolerance > 0)
cmat <- constancy(data, parm.type = parm.type)
foo <- qr(t(cmat))
bar <- qr.resid(foo, parm1 - parm2)
return(all(abs(bar) < tolerance))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.