mprint <- function (x, d = 2, w = 5, f = "") { print (noquote (formatC ( x, di = d, wi = w, fo = "f", flag = f ))) } torgerson <- function (delta, p = 2) { doubleCenter <- function(x) { n <- dim(x)[1] m <- dim(x)[2] s <- sum(x) / (n * m) xr <- rowSums(x) / m xc <- colSums(x) / n return((x - outer(xr, xc, "+")) + s) } z <- slanczos(-doubleCenter((delta ^ 2) / 2), p) w <- matrix (0, p, p) v <- pmax(z\$values, 0) diag (w) <- sqrt (v) return(z\$vectors %*% w) } direct_sum <- function (x) { n <- length (x) nr <- sapply (x, nrow) nc <- sapply (x, ncol) s <- matrix (0, sum(nr), sum(nc)) k <- 0 l <- 0 for (j in 1:n) { s[k + (1:nr[j]), l + (1:nc[j])] <- x[[j]] k <- k + nr[j] l <- l + nc[j] } return(s) } repMatrix <- function (x, m) { z <- array (0, c(dim (x), m)) for (j in 1:m) z[, , j] <- x return (z) } slideMatrix <- function (x) { n <- nrow (x) unit <- function (i, n) ifelse (i == 1:n, 1, 0) s <- matrix (0, n + 1, n + 1) for (i in 1:n) { for (j in 1:n) { u <- c (unit (i, n) - unit (j, n), 1) s <- s + x[i, j] * outer (u, u) } } return (s) } slideDistance <- function (x, z) { n <- nrow (x) d <- matrix (0, n, n) for (i in 1:n) { for (j in 1:n) { d[i, j] <- sqrt (sum ((x[i, ] - x[j, ] + z) ^ 2)) } } return (d) } unit <- function (i, n) { return (ifelse (i == 1:n, 1, 0)) } amat <- function (i, j, n) { u <- unit (i, n) - unit (j, n) return (outer (u, u)) }