mprint <- function (x, d = 6, w = 8, f = "") { print (noquote (formatC ( x, di = d, wi = w, fo = "f", flag = f ))) } directSum <- function (x) { m <- length (x) nr <- sum (sapply (x, nrow)) nc <- sum (sapply (x, ncol)) z <- matrix (0, nr, nc) kr <- 0 kc <- 0 for (i in 1:m) { ir <- nrow (x[[i]]) ic <- ncol (x[[i]]) z[kr + (1:ir), kc + (1:ic)] <- x[[i]] kr <- kr + ir kc <- kc + ic } return (z) } repList <- function(x, n) { z <- list() for (i in 1:n) z <- c(z, list(x)) return(z) } shapeMe <- function (x) { m <- length (x) n <- (1 + sqrt (1 + 8 * m)) / 2 d <- matrix (0, n, n) k <- 1 for (i in 2:n) { for (j in 1:(i - 1)) { d[i, j] <- d[j, i] <- x[k] k <- k + 1 } } return (d) } symmetricFromTriangle <- function (x, lower = TRUE, diagonal = TRUE) { k <- length (x) if (diagonal) n <- (sqrt (1 + 8 * k) - 1) / 2 else n <- (sqrt (1 + 8 * k) + 1) / 2 if (n != as.integer (n)) stop ("input error") nn <- 1:n if (diagonal && lower) m <- outer (nn, nn, ">=") if (diagonal && (!lower)) m <- outer (nn, nn, "<=") if ((!diagonal) && lower) m <- outer (nn, nn, ">") if ((!diagonal) && (!lower)) m <- outer (nn, nn, "<") b <- matrix (0, n, n) b[m] <- x b <- b + t(b) if (diagonal) diag (b) <- diag(b) / 2 return (b) } triangleFromSymmetric <- function (x, lower = TRUE, diagonal = TRUE) { n <- ncol (x) nn <- 1:n if (diagonal && lower) m <- outer (nn, nn, ">=") if (diagonal && (!lower)) m <- outer (nn, nn, "<=") if ((!diagonal) && lower) m <- outer (nn, nn, ">") if ((!diagonal) && (!lower)) m <- outer (nn, nn, "<") return (x[m]) }