-
Notifications
You must be signed in to change notification settings - Fork 15
/
printMatEqn.R
94 lines (87 loc) · 3.2 KB
/
printMatEqn.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
#' Print Matrices or Matrix Operations Side by Side
#'
#' This function is designed to print a collection of matrices, vectors, character strings
#' and matrix expressions side by side. A typical use is to illustrate matrix equations in a compact and
#' comprehensible way.
#'
#' @param ... matrices and character operations to be passed and printed to the console. These
#' can include named arguments, character string operation symbols (e.g., \code{"+"})
#' @param space amount of blank spaces to place around operations such as \code{"+"},
#' \code{"-"}, \code{"="}, etc
#' @param tol tolerance for rounding
#' @param fractions logical; if \code{TRUE}, try to express non-integers as rational numbers, using the \code{\link[MASS]{fractions}}
#' function; if you require greater accuracy, you can set the \code{cycles} (default 10)
#' and/or \code{max.denominator} (default 2000) arguments to \code{fractions} as a global option, e.g.,
#' \code{options(fractions=list(cycles=100, max.denominator=10^4))}.
#'
#' @return NULL; A formatted sequence of matrices and matrix operations is printed to the console
#' @author Phil Chalmers
#' @export
#' @seealso \code{\link{showEqn}}
#' @examples
#'
#' A <- matrix(c(2, 1, -1,
#' -3, -1, 2,
#' -2, 1, 2), 3, 3, byrow=TRUE)
#' x <- c(2, 3, -1)
#'
#' # provide implicit or explicit labels
#' printMatEqn(AA = A, "*", xx = x, '=', b = A %*% x)
#' printMatEqn(A, "*", x, '=', b = A %*% x)
#' printMatEqn(A, "*", x, '=', A %*% x)
#'
#' # compare with showEqn
#' b <- c(4, 2, 1)
#' printMatEqn(A, x=paste0("x", 1:3),"=", b)
#' showEqn(A, b)
#'
#' # decimal example
#' A <- matrix(c(0.5, 1, 3, 0.75, 2.8, 4), nrow = 2)
#' x <- c(0.5, 3.7, 2.3)
#' y <- c(0.7, -1.2)
#' b <- A %*% x - y
#'
#' printMatEqn(A, "*", x, "-", y, "=", b)
#' printMatEqn(A, "*", x, "-", y, "=", b, fractions=TRUE)
#'
printMatEqn <- function(..., space = 1, tol=sqrt(.Machine$double.eps),
fractions=FALSE) {
# get arguments
args <- list(...)
chars <- sapply(args, is.character)
charvec <- if(length(names(chars))) names(chars) != ""
else logical(length(chars))
args[chars & !charvec] <- lapply(args[chars & !charvec], function(x)
paste0(rep(' ', space), x, rep(' ', space)))
# vectors to matrix
pick <- sapply(args, function(x) !is.matrix(x))
args[pick] <- lapply(args[pick], as.matrix)
nrows <- sapply(args, nrow)
ncols <- sapply(args, ncol)
mat <- matrix('', max(nrows), sum(ncols))
tmp <- names(args)
Call <- as.character(match.call())[-1L]
if(is.null(tmp)){
tmp <- Call[1L:length(ncols)]
tmp[chars] <- ' '
} else if(length(tmp[tmp != ""]) != sum(!chars)){
tmp2 <- tmp
tmp <- Call[1L:length(ncols)]
tmp[tmp2 != ""] <- tmp2[tmp2 != ""]
tmp[chars & !charvec] <- ' '
}
nms <- rep(' ', sum(ncols))
nms[cumsum(ncols)] <- tmp
for(i in 1L:length(args)){
if(!chars[i])
args[[i]] <- if(!fractions)
format(formatNumbers(args[[i]], tol=tol, fractions=FALSE))
else as.character(formatNumbers(args[[i]], tol=tol, fractions=TRUE))
}
for(i in 1L:max(nrows))
mat[i, ] <- do.call(c, lapply(args, function(x)
if(nrow(x) >= i) x[i, ] else rep('', ncol(x))))
ret <- data.frame(mat, stringsAsFactors = FALSE)
colnames(ret) <- nms
print(ret, row.names=FALSE)
}