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