1### condiNumber: print matrix' condition number adding columns one by one.
2### In this way user may investigate the which columns cause problems with singularity
3
4condiNumber <- function(x, ...)
5    UseMethod("condiNumber")
6
7condiNumber.default <- function(x, exact=FALSE, norm=FALSE,
8                                printLevel=print.level, print.level=1,
9   digits = getOption( "digits" ), ... ) {
10   ## x:  a matrix, condition number of which are to be printed
11   ## exact: whether the condition number have to be exact or approximated (see 'kappa')
12   ## norm: whether to normalise the matrix' columns.
13   ## printLevel: whether to print the condition numbers while calculating.  Useful for interactive testing.
14   savedDigits <- getOption("digits")
15   options( digits = digits )
16   if(dim(x)[2] > dim(x)[1]) {
17      warning(paste(dim(x)[1], "rows and", dim(x)[2], "columns, use transposed matrix"))
18      x <- t(x)
19   }
20   cn <- numeric(ncol(x))
21    if(norm) {
22                                        # Now normalise column vectors
23       x <- apply(x, 2, FUN=function(v) v/sqrt(sum(v*v)))
24    }
25    for(i in seq(length=ncol(x))) {
26        m <- x[,1:i]
27        cn[i] <- kappa(m, exact=exact)
28        if(printLevel > 0)
29            cat(colnames(x)[i], "\t", cn[i], "\n")
30    }
31   names(cn) <- colnames(x)
32   options( digits = savedDigits )
33   invisible(cn)
34}
35
36condiNumber.maxLik <- function(x, ...)
37    condiNumber.default( x = hessian(x)[activePar(x), activePar(x),drop=FALSE],
38       ... )
39