From a9da820b8e3ded757f79a348aceedda5ab3fb57d Mon Sep 17 00:00:00 2001 From: John Fox Date: Tue, 27 Aug 2024 14:01:44 -0400 Subject: [PATCH] divided functions into R\latexMatrix.R and R\latexMatrixOperations; several new functions/operators --- NAMESPACE | 14 +- R/latexMatrix.R | 342 +--------------------- R/latexMatrixOperations.R | 567 ++++++++++++++++++++++++++++++++++++ dev/latexMatrixOperations.R | 563 +++++++++++++++++++++++++++++++++++ man/latexMatrix.Rd | 110 +------ man/matsum.Rd | 192 ++++++++++++ 6 files changed, 1345 insertions(+), 443 deletions(-) create mode 100644 R/latexMatrixOperations.R create mode 100644 dev/latexMatrixOperations.R create mode 100644 man/matsum.Rd diff --git a/NAMESPACE b/NAMESPACE index 2f0fcc03..9cfb1609 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -4,6 +4,7 @@ S3method("%*%",latexMatrix) S3method("*",latexMatrix) S3method("+",latexMatrix) S3method("-",latexMatrix) +S3method("^",latexMatrix) S3method(Dim,latexMatrix) S3method(Ncol,latexMatrix) S3method(Nrow,latexMatrix) @@ -13,6 +14,12 @@ S3method(determinant,latexMatrix) S3method(getBody,latexMatrix) S3method(getLatex,latexMatrix) S3method(getWrapper,latexMatrix) +S3method(inverse,latexMatrix) +S3method(is.numeric,latexMatrix) +S3method(matdiff,latexMatrix) +S3method(matmult,latexMatrix) +S3method(matpower,latexMatrix) +S3method(matsum,latexMatrix) S3method(plot,regvec3d) S3method(print,enhancedMatrix) S3method(print,latexMatrix) @@ -26,6 +33,7 @@ S3method(t,latexMatrix) export("%X%") export(Det) export(Dim) +export(Dot) export(Eigen) export(Eqn) export(Eqn_hspace) @@ -65,12 +73,17 @@ export(getWrapper) export(getYmult) export(gsorth) export(inv) +export(inverse) export(is_orthogonal_matrix) export(is_square_matrix) export(is_symmetric_matrix) export(latexMatrix) export(len) +export(matdiff) +export(matmult) +export(matpower) export(matrix2latex) +export(matsum) export(minor) export(mpower) export(plotEqn) @@ -97,7 +110,6 @@ export(vec) export(vectors) export(vectors3d) export(xprod) -exportMethods(kronecker) import(rgl) import(stats) importFrom(MASS,fractions) diff --git a/R/latexMatrix.R b/R/latexMatrix.R index 8f0e2ec0..7382583d 100644 --- a/R/latexMatrix.R +++ b/R/latexMatrix.R @@ -62,7 +62,7 @@ #' #' You may need to use \code{extra_dependencies: ["amsmath"]} in your YAML header of a \code{Rmd} or \code{qmd} file. #' -#' You can actually supply a numeric matrix as the \code{symbol}, but the result will not be pretty +#' You can supply a numeric matrix as the \code{symbol}, but the result will not be pretty #' unless the elements are integers or are rounded. For a LaTeX representation of general numeric matrices, use #' \code{\link{matrix2latex}}. #' @@ -70,21 +70,8 @@ #' \code{getDim()}, \code{getNrow()}, and \code{getNcol()} may be used to retrieve #' components of the returned object. #' -#' There are \code{"latexMatrix"} methods for several standard R arithmetic -#' operators and functions of matrices, including: -#' \itemize{ -#' \item \code{+} (matrix addition), \code{-} -#' (matrix subtraction), \code{*} (product of a scalar and a matrix), -#' \item \code{\%*\%} (matrix product), -#' \item \code{t()} (transpose), -#' \item \code{determinant()}, -#' \item \code{solve()} (matrix inverse), -#' \item \code{kronecker()} and the operator \code{\%O\%} (the Kronecker product), and -#' \item \code{as.double()} (coercion to numeric, if possible). -#' } -#' -#' These operators and functions only apply to \code{"latexMatrix"} objects -#' of definite (i.e., numeric) dimensions. +#' Various functions and operators for \code{"latexMatrix"} objects are +#' documents separately; see, e.g., \code{\link{matsum}} #' #' @param symbol name for matrix elements, character string. For LaTeX symbols, #' the backslash must be doubled because it is an escape character in R. @@ -147,7 +134,8 @@ #' } #' #' @author John Fox -#' @seealso \code{\link{matrix2latex}}, \code{\link[clipr]{write_clip}} +#' @seealso \code{\link{matsum}}, \code{\link{matrix2latex}}, +#' \code{\link[clipr]{write_clip}} #' @export #' @examples #' latexMatrix() @@ -217,33 +205,6 @@ #' #' # zero-based indexing #' latexMatrix(zero.based=c(TRUE, TRUE)) -#' -#' # arithmetic operators and functions -#' A <- latexMatrix(symbol="a", nrow=2, ncol=2) -#' B <- latexMatrix(symbol="b", nrow=2, ncol=2) -#' A -#' B -#' A + B -#' A - B -#' "a" * A -#' C <- latexMatrix(symbol="c", nrow=2, ncol=3) -#' A %*% C -#' t(C) -#' determinant(A) -#' cat(solve(A, simplify=TRUE)) -#' D <- latexMatrix(matrix(letters[1:4], 2, 2)) -#' D -#' as.numeric(D, locals=list(a=1, b=2, c=3, d=4)) -#' X <- latexMatrix(matrix(c(3, 2, 0, 1, 1, 1, 2,-2, 1), 3, 3)) -#' X -#' as.numeric(X) -#' MASS::fractions(as.numeric(solve(X))) -#' (d <- determinant(X)) -#' eval(parse(text=(gsub("\\\\cdot", "*", d)))) -#' X <- latexMatrix(matrix(1:6, 2, 3), matrix="bmatrix") -#' I3 <- latexMatrix(diag(3)) -#' I3 %X% X -#' kronecker(I3, X, sparse=TRUE) latexMatrix <- function( @@ -632,246 +593,6 @@ print.latexMatrix <- function(x, onConsole=TRUE, ...){ invisible(x) } - -# methods for arithmetic operators and functions: - -#' @param e1 a \code{"latexMatrix"} object (or, for \code{*} a scalar). -#' @param e2 a \code{"latexMatrix"} object (or, for \code{*} a scalar). - -#' @rdname latexMatrix -#' @export -`+.latexMatrix` <- function(e1, e2){ - if (!inherits(e2, "latexMatrix")){ - stop(deparse(substitute(e2)), - " is not of class 'latexMatrix'") - } - numericDimensions(e1) - numericDimensions(e2) - A <- getBody(e1) - B <- getBody(e2) - dimA <- dim(A) - dimB <- dim(B) - if(!all(dim(A) == dim(B))){ - stop('matricies are not conformable for addition') - } - result <- matrix(paste(sapply(A, parenthesize), "+", - sapply(B, parenthesize)), - dimA[1L], dimA[2L]) - result <- latexMatrix(result) - result <- updateWrapper(result, getWrapper(e1)) - result$dim <- Dim(e1) - result -} - -#' @rdname latexMatrix -#' @export -`-.latexMatrix` <- function(e1, e2){ - # unary - - if (missing(e2)){ - numericDimensions(e1) - A <- getBody(e1) - dimA <- Dim(e1) - result <- matrix(paste("-", sapply(A, parenthesize)), dimA[1L], dimA[2L]) - result <- latexMatrix(result) - result <- updateWrapper(result, getWrapper(e1)) - result$dim <- dimA - return(result) - } - if (!inherits(e2, "latexMatrix")){ - stop(deparse(substitute(e2)), - " is not of class 'latexMatrix'") - } - numericDimensions(e1) - numericDimensions(e2) - A <- getBody(e1) - B <- getBody(e2) - dimA <- dim(A) - dimB <- dim(B) - if(!all(dim(A) == dim(B))){ - stop('matricies are not conformable for subtraction') - } - result <- matrix(paste(sapply(A, parenthesize), "-", - sapply(B, parenthesize)), - dimA[1L], dimA[2L]) - result <- latexMatrix(result) - result <- updateWrapper(result, getWrapper(e1)) - result$dim <- Dim(e1) - result -} - -#' @param y a \code{"latexMatrix"} object - -#' @rdname latexMatrix -#' @export -`%*%.latexMatrix` <- function(x, y){ - if (!inherits(y, "latexMatrix")){ - stop(deparse(substitute(y)), - " is not of class 'latexMatrix'") - } - numericDimensions(x) - numericDimensions(y) - X <- getBody(x) - Y <- getBody(y) - dimX <- dim(X) - dimY <- dim(Y) - if (dimX[2] != dimY[1]){ - stop('matricies are not conformable for multiplication') - } - - latexMultSymbol <- getLatexMultSymbol() - - Z <- matrix("", nrow(X), ncol(Y)) - for (i in 1:nrow(X)){ - for (j in 1:ncol(Y)){ - for (k in 1:ncol(X)){ - Z[i, j] <- paste0(Z[i, j], - if (k > 1) " + ", - parenthesize(X[i, k]), - paste0(" ", latexMultSymbol, " "), - parenthesize(Y[k, j])) - } - } - } - result <- latexMatrix(Z) - result <- updateWrapper(result, getWrapper(x)) - result$dim <- dim(Z) - result -} - -#' @rdname latexMatrix -#' @export -`*.latexMatrix` <- function (e1, e2) { - if (inherits(e1, "latexMatrix") && inherits(e2, "latexMatrix")) - stop("both arguments of * cannot be 'latexMatrix' objects") - swapped <- if (inherits(e1, "latexMatrix")) { - swap <- e1 - e1 <- e2 - e2 <- swap - TRUE - } else { - FALSE - } - if (!is.vector(e1) || length(e1) != 1) - stop("one argument to * must be a scalar") - numericDimensions(e2) - - latexMultSymbol <- getLatexMultSymbol() - - A <- getBody(e2) - dimA <- dim(A) - wrapper <- getWrapper(e2) - result <- matrix(if (swapped) { - paste(sapply(A, parenthesize), latexMultSymbol, e1) - } else{ - paste(e1, latexMultSymbol, sapply(A, parenthesize)) - }, - dimA[1L], dimA[2L]) - result <- latexMatrix(result) - result <- updateWrapper(result, getWrapper(e2)) - result$dim <- Dim(e2) - result -} - -#' @rdname latexMatrix -#' @export -t.latexMatrix <- function(x){ - numericDimensions(x) - result <- latexMatrix(t(getBody(x))) - result <- updateWrapper(result, getWrapper(x)) - result$dim <- rev(Dim(x)) - result -} - -#' @param logarithm ignored; to match the \code{\link{determinant}} generic - -#' @rdname latexMatrix -#' @export -determinant.latexMatrix <- function(x, logarithm, ...){ - - # determinant by cofactors - - latexMultSymbol <- getLatexMultSymbol() - - # helper function for recursion: - DET <- function(X){ - if (nrow(X) == 1) { - as.vector(X) - } else if (nrow(X) == 2){ - paste0(parenthesize(X[1, 1]), paste0(" ", latexMultSymbol, " "), parenthesize(X[2, 2]), " - ", - parenthesize(X[1, 2]), paste0(" ", latexMultSymbol, " "), parenthesize(X[2, 1])) - } else { - indices <- 1:ncol(X) - res <- "" - for (j in indices){ - res <- paste0(res, if (isOdd(j)) " + " else " - ", - X[1, j], paste0(" ", latexMultSymbol, " "), - parenthesize(DET(X[-1, indices != j])) - ) - } - res - } - } - - numericDimensions(x) - - sub("^[ +]*", "", DET(getBody(x))) -} - -#' @param a a \code{"latexMatrix"} object representing a square matrix -#' @param b ignored; to match the \code{\link{solve}} generic -#' @param simplify if \code{TRUE} (the default is \code{FALSE}), -#' return a LaTeX expression with the inverse of the determinant in -#' front of the adjoint matrix rather than a \code{"latexMatrix"} object in which each -#' element of the adjoint matrix is divided by the determinant. -#' @param frac LaTeX command to use in forming fractions; the default -#' is \code{"\\dfrac"} - -#' @rdname latexMatrix -#' @export -solve.latexMatrix <- function (a, b, simplify=FALSE, - frac=c("\\dfrac", "\\frac", "\\tfrac", "\\cfrac"), - ...) { - - # symbolic matrix inverse by adjoint matrix and determinant - - frac <- match.arg(frac) - - numericDimensions(a) - if (Nrow(a) != Ncol(a)) stop("matrix 'a' must be square") - if (!missing(b)) warning("'b' argument to solve() ignored") - - det <- determinant(a) - A <- getBody(a) - n <- nrow(A) - indices <- 1:n - A_inv <- matrix("", n, n) - - for (i in 1:n){ - for (j in 1:n){ - A_ij <- latexMatrix(A[indices[-i], indices[-j], drop=FALSE]) - A_inv[i, j] <- if (Nrow(A_ij) == 1) { # cofactors - A[indices[-i], indices[-j]] - } else{ - determinant(A_ij) - } - if (isOdd(i + j)) A_inv[i, j] <- paste0("-", parenthesize(A_inv[i, j])) - if (!simplify) A_inv[i, j] <- paste0(frac, "{", A_inv[i, j], - "}{", det, "}") - } - } - - A_inv <- t(A_inv) # adjoint - result <- latexMatrix(A_inv) - result <- updateWrapper(result, getWrapper(a)) - - if (!simplify) { - return(result) - } else { - return(paste0("\\frac{1}{", det, "} \n", - getLatex(result))) - } -} - #' @param locals an optional list or named numeric vector of variables to be given #' specific numeric values; e.g., #' \code{locals = list(a = 1, b = 5, c = -1, d = 4)} or @@ -903,51 +624,6 @@ as.double.latexMatrix <- function(x, locals=list(), ...){ matrix(X, nrow=nrow) } -setOldClass("latexMatrix") - -#' @rdname latexMatrix -#' @export -#' @param X a \code{"latexMatrix"} object -#' @param Y a \code{"latexMatrix"} object -#' @param FUN to match the \code{\link{kronecker}} generic, ignored -#' @param make.dimnames to match the \code{\link{kronecker}} generic, ignored -setMethod("kronecker", - signature(X = "latexMatrix", - Y = "latexMatrix"), - function(X, Y, FUN, make.dimnames, ...) { - - numericDimensions(X) - numericDimensions(Y) - - latexMultSymbol <- getLatexMultSymbol() - - Xmat <- getBody(X) - Ymat <- getBody(Y) - - Z <- .kronecker(Xmat, Ymat, - function(x, y) { - x <- trimws(x) - y <- trimws(y) - zeros <- as.character(x) == "0" | - as.character(y) == "0" - x <- sapply(x, parenthesize) - y <- sapply(y, parenthesize) - res <- paste0(x, paste0(" ", latexMultSymbol, " "), y) - res[zeros] <- "0" - res - } - ) - - result <- latexMatrix(Z, ...) - result <- updateWrapper(result, getWrapper(X)) - result - } -) - -#' @rdname latexMatrix -#' @export -`%X%` <- function(x, y) methods::kronecker(x, y) - # unexported functions: numericDimensions <- function(x){ @@ -957,14 +633,6 @@ numericDimensions <- function(x){ return(NULL) } -# parenthesize <- function(element){ -# if (grepl("[ +-/^]", element)) { -# paste0("(", element, ")") -# } else { -# element -# } -# } - parenthesize <- function(element){ element <- if (grepl("[ +/^-]", element)) { paste0("(", element, ")") diff --git a/R/latexMatrixOperations.R b/R/latexMatrixOperations.R new file mode 100644 index 00000000..200e1390 --- /dev/null +++ b/R/latexMatrixOperations.R @@ -0,0 +1,567 @@ +#' Various Functions and Operators for latexMatrix Object +#' +#' @description +#' Operators and function provideds: +#' \itemize{ +#' \item \code{matsum()} and \code{+}, matrix addition; +#' \item \code{matdiff()} and \code{-}, matrix subtraction and negation; +#' \item \code{*}, product of a scalar and a matrix); +#' \item \code{Dot()}, inner product of two vectors; +#' \item \code{matprod()} and \code{\%*\%}, matrix product; +#' \item \code{matpower()} and \code{^}, powers (including inverse) of +#' a square matrix; +#' \item \code{solve()} and \code{inverse()}, matrix inverse of a square matrix; +#' \item \code{t()}, transpose; +#' \item \code{determinant()} of a square matrix; +#' \item \code{kronecker()} and \code{\%O\%} (the Kronecker product), and +#' } +#' +#' @details +#' These operators and functions only apply to \code{"latexMatrix"} objects +#' of definite (i.e., numeric) dimensions. When there are both a funcion and an +#' operator (e.g., \code{matmult()} and \code{\%*\%}), the former is more +#' flexible via optional arguments and the latter calls the former with default +#' arguments. +#' +#' The result of matrix multiplication, \eqn{\mathbf{C} = \mathbf{A} \: \mathbf{B}} +#' is composed of the vector inner (dot) products of each \emph{row} of \eqn{\mathbf{A}} with +#' each \emph{column} of \eqn{\mathbf{B}}, +#' \deqn{c_{ij} = \mathbf{a}_i^\top \mathbf{b}_j +#' = \Sigma_k a_{ik} \cdot b_{kj}} +#' +#' The \code{Dot()} function computes the inner product symbolically in LaTeX notation for +#' numeric and character vectors, simplifying the result if \code{simplify = TRUE.} +#' The LaTeX symbol for multiplication (\code{"\\cdot"} by default) +#' can be changed by changing \code{options(latexMultSymbol)}, +#' e.g, \code{options(latexMultSymbol = "\\times")}. +#' + +#' @author John Fox +#' @seealso \code{\link{latexMatrix}} + +# # for debugging: +# numericDimensions <- matlib:::numericDimensions +# parenthesize <- matlib:::parenthesize +# updateWrapper <- matlib:::updateWrapper +# getLatexMultSymbol <- matlib:::getLatexMultSymbol + +#' @param e1 a \code{"latexMatrix"} object; or for \code{*} a scalar; +#' @param e2 a \code{"latexMatrix"} object; or for \code{*} a scalar; +#' for \code{^} an integer power \code{>= -1} to raise a square matrix +#' @param A a \code{"latexMatrix"} object +#' @param B a \code{"latexMatrix"} object +#' @param X a \code{"latexMatrix"} object +#' @param x for \code{Dot} a numeric or character vector; +#' otherwise a \code{"latexMatrix"} object +#' @param y for \code{Dot} a numeric or character vector; +#' otherwise a \code{"latexMatrix"} object +#' @param simplify if \code{TRUE} (the default), an attempt is made +#' to simplify the result slightly; for \code{solve()}, +#' return a LaTeX expression with the inverse of the determinant in +#' front of the adjoint matrix rather than a \code{"latexMatrix"} object in which each +#' element of the adjoint matrix is divided by the determinant +#' @param as.numeric if \code{TRUE} (the default) and the matrices to be multiplied can be +#' coerced to numeric, matrix multiplication is performed numerically; +#' supercedes \code{simplify} +#' @param power to raise a square matrix, an integer \code{>= -1}. +#' @param ... for \code{matmult()} and \code{sum()} zero or more +#' \code{"latexMatrix"} objects; otherwise arguments to be passed down +#' @param a a \code{"latexMatrix"} object representing a square matrix +#' @param b ignored; to match the \code{\link{solve}()} generic +#' @param frac LaTeX command to use in forming fractions; the default +#' is \code{"\\dfrac"} +#' @param logarithm to match the generic \code{\link{determinant}()} function, +#' ignored +#' +#' @examples +#' A <- latexMatrix(symbol="a", nrow=2, ncol=2) +#' B <- latexMatrix(symbol="b", nrow=2, ncol=2) +#' A +#' B +#' A + B +#' A - B +#' "a" * A +#' C <- latexMatrix(symbol="c", nrow=2, ncol=3) +#' A %*% C +#' t(C) +#' determinant(A) +#' cat(solve(A, simplify=TRUE)) +#' D <- latexMatrix(matrix(letters[1:4], 2, 2)) +#' D +#' as.numeric(D, locals=list(a=1, b=2, c=3, d=4)) +#' X <- latexMatrix(matrix(c(3, 2, 0, 1, 1, 1, 2,-2, 1), 3, 3)) +#' X +#' as.numeric(X) +#' \dontrun{ +#' MASS::fractions(as.numeric(inverse(X))) +#' (d <- determinant(X)) +#' eval(parse(text=(gsub("\\\\cdot", "*", d)))) +#' } +#' X <- latexMatrix(matrix(1:6, 2, 3), matrix="bmatrix") +#' I3 <- latexMatrix(diag(3)) +#' I3 %X% X +#' kronecker(I3, X, sparse=TRUE) +#' + +#' @returns All of these functions return \code{"latexMatrix"} objects, +#' except for \code{Dot()}, which returns a LaTeX expression as a character string. + +#' @rdname matsum +#' @export +matsum <- function(A, ...){ + UseMethod("matsum") +} + +#' @rdname matsum +#' @export +matsum.latexMatrix <- function(A, ..., as.numeric=TRUE){ + + matrices <- list(...) + + if (any(sapply(matrices, function(x) !inherits(x, "latexMatrix")))){ + stop("arguments are not all of class 'latexMatrix'") + } + + numericDimensions(A) + for (M in matrices) numericDimensions(M) + + wrapper <- getWrapper(A) + + if (as.numeric && is.numeric(A) && all(sapply(matrices, is.numeric))){ + A <- as.numeric(A) + dimA <- dim(A) + matrices <- lapply(matrices, as.numeric) + for (i in seq_along(matrices)){ + if (!all(dim(matrices[[i]]) == dimA)) + stop ("the matrices are not conformable for addition") + A <- A + matrices[[i]] + } + } else { + A <- getBody(A) + dimA <- dim(A) + for (M in matrices){ + M <- getBody(M) + if(!all(dim(A) == dim(M))) + stop('matricies are not conformable for addition') + A <- matrix(paste(sapply(A, parenthesize), "+", + sapply(M, parenthesize)), + dimA[1L], dimA[2L]) + } + } + A <- latexMatrix(A) + A <- updateWrapper(A, wrapper) + A +} + +#' @rdname matsum +#' @export +`+.latexMatrix` <- function(e1, e2){ + matsum(e1, e2) +} + +#' @rdname matsum +#' @export +matdiff <- function(A, B, ...){ + UseMethod("matdiff") +} + +#' @rdname matsum +#' @export +matdiff.latexMatrix <- function(A, B=NULL, as.numeric=TRUE, ...){ + + wrapper <- getWrapper(A) + + # unary - + if (is.null(B)){ + numericDimensions(A) + if (as.numeric && is.numeric(A)){ + A <- as.numeric(A) + A <- -A + } else { + A <- getBody(A) + dimA <- dim(A) + A <- matrix(paste("-", sapply(A, parenthesize)), dimA[1L], dimA[2L]) + } + A <- latexMatrix(A) + A <- updateWrapper(A, getWrapper(A)) + return(A) + } + if (!inherits(B, "latexMatrix")){ + stop(deparse(substitute(B)), + " is not of class 'latexMatrix'") + } + numericDimensions(A) + numericDimensions(B) + dimA <- Dim(A) + dimB <- Dim(B) + if (!all(dimA == dimB)) + stop('matricies are not conformable for subtraction') + if (as.numeric && is.numeric(A) && is.numeric(B)){ + A <- as.numeric(A) + B <- as.numeric(B) + A <- A - B + } else { + A <- getBody(A) + B <- getBody(B) + A <- matrix(paste(sapply(A, parenthesize), "-", + sapply(B, parenthesize)), + dimA[1L], dimA[2L]) + } + A <- latexMatrix(A) + A <- updateWrapper(A, wrapper) + A +} + +#' @rdname matsum +#' @export +`-.latexMatrix` <- function(e1, e2){ + if (missing(e2)) e2 <- NULL + matdiff(e1, e2) +} + +#' @rdname matsum +#' @export +`*.latexMatrix` <- function (e1, e2) { + if (inherits(e1, "latexMatrix") && inherits(e2, "latexMatrix")) + stop("both arguments of * cannot be 'latexMatrix' objects") + swapped <- if (inherits(e1, "latexMatrix")) { + swap <- e1 + e1 <- e2 + e2 <- swap + TRUE + } else { + FALSE + } + if (!is.vector(e1) || length(e1) != 1) + stop("one argument to * must be a scalar") + numericDimensions(e2) + + latexMultSymbol <- getLatexMultSymbol() + + A <- getBody(e2) + dimA <- dim(A) + wrapper <- getWrapper(e2) + result <- matrix(if (swapped) { + paste(sapply(A, parenthesize), latexMultSymbol, e1) + } else{ + paste(e1, latexMultSymbol, sapply(A, parenthesize)) + }, + dimA[1L], dimA[2L]) + result <- latexMatrix(result) + result <- updateWrapper(result, getWrapper(e2)) + result$dim <- Dim(e2) + result +} + +#' @rdname matsum +#' @export +Dot <- function(x, y, simplify = TRUE) { + if (length(x) != length(y)) stop("Vectors must have the same length") + x <- trimws(x) + y <- trimws(y) + latexMultSymbol <- getLatexMultSymbol() + res <- "" + for (i in 1:length(x)) { + if (!simplify) { + res <- paste0(res, + if (i > 1) " + ", + parenthesize(x[i]), + paste0(" ", latexMultSymbol, " "), + parenthesize(y[i])) + } + else { + # ignore terms multiplied by zero + if (x[i] == "0") next + if (y[i] == "0") next + xi <- if(x[i] == "1") "" else x[i] + yi <- if(y[i] == "1") "" else y[i] + if (x[i] == "1" && y[i] == "1") xi <- "1" + xi <- if (xi == "-1") "-" else xi + if (y[i] == "-1") { + yi <- "" + xi <- if (x[i] == "-1") "1" else paste0("-", parenthesize(xi)) + } + times <- if(xi == "" || xi == "-" || yi == "") "" else paste0(" ", latexMultSymbol, " ") + res <- paste0(res, + if (nchar(res) > 0) " + ", + if (y[i] != "-1" && xi != "-") parenthesize(xi) else xi, + times, + parenthesize(yi)) + } + } + if (res == "") res <- "0" + if (res == "-") res <- "-1" + res <- gsub("\\+ *-", "- ", res) + res +} + +#' @rdname matsum +#' @export +matmult <- function(X, ...){ + UseMethod("matmult") +} + +#' @rdname matsum +#' @export +matmult.latexMatrix <- function(X, ..., simplify=TRUE, + as.numeric=TRUE){ + + matrices <- list(...) + + if (any(sapply(matrices, function(x) !inherits(x, "latexMatrix")))){ + stop("arguments are not all of class 'latexMatrix'") + } + + numericDimensions(X) + for (M in matrices) numericDimensions(M) + + wrapper <- getWrapper(X) + + if (as.numeric && is.numeric(X) && all(sapply(matrices, is.numeric))){ + X <- as.numeric(X) + matrices <- lapply(matrices, as.numeric) + for (i in seq_along(matrices)){ + X <- X %*% matrices[[i]] + } + } else { + + X <- getBody(X) + + for (M in matrices){ + + Y <- getBody(M) + if (ncol(X) != nrow(Y)){ + stop('matricies are not conformable for multiplication') + } + + Z <- matrix("", nrow(X), ncol(Y)) + + for (i in 1:nrow(X)){ + for (j in 1:ncol(Y)){ + for (k in 1:ncol(X)){ + Z[i, j] <- Dot(X[i, ], Y[, j], simplify=simplify) + } + } + } + X <- Z + } + } + X <- latexMatrix(X) + X <- updateWrapper(X, wrapper) + return(X) + +} + +#' @rdname matsum +#' @export +`%*%.latexMatrix` <- function(x, y){ + matmult(x, y) +} + +#' @rdname matsum +#' @export +matpower <- function(X, power, ...){ + UseMethod("matpower") +} + +#' @rdname matsum +#' @export +matpower.latexMatrix <- function(X, power, simplify=TRUE, + as.numeric=TRUE, ...){ + + numericDimensions(X) + dimX <- Dim(X) + if (dimX[1] != dimX[2]) stop ("X is not square") + if (power != round(power) || power < -1) + stop("'power' must be an integer >= -1") + + wrapper <- getWrapper(X) + + if (power == 0){ + result <- latexMatrix(diag(dimX[1])) + result <- updateWrapper(result, wrapper) + return(result) + } + + if (as.numeric && is.numeric(X)){ + X <- as.numeric(X) + Xp <- if (power == -1){ + solve(X) + } else { + result <- diag(dimX[1]) + for (i in 1:power){ + result <- result %*% X + } + result + } + Xp <- latexMatrix(Xp) + } else { + Xp <- if (power == -1) { + solve(X, simplify=simplify) + } else { + result <- latexMatrix(diag(dimX[1])) + for (i in 1:power){ + result <- matmult(result, X, simplify=simplify) + } + result + } + } + Xp <- updateWrapper(Xp, wrapper) + return(Xp) +} + +#' @rdname matsum +#' @export +`^.latexMatrix` <- function(e1, e2){ + matpower(e1, e2) +} + +#' @rdname matsum +#' @export +inverse <- function(X, ...){ + UseMethod("inverse") +} + +#' @rdname matsum +#' @export +inverse.latexMatrix <- function(X, ..., as.numeric=TRUE, + simplify=TRUE){ + matpower(X, -1, as.numeric=as.numeric, simplify=simplify) +} + +#' @rdname matsum +#' @export +t.latexMatrix <- function(x){ + numericDimensions(x) + result <- latexMatrix(t(getBody(x))) + result <- updateWrapper(result, getWrapper(x)) + result$dim <- rev(Dim(x)) + result +} + +#' @rdname matsum +#' @export +determinant.latexMatrix <- function(x, logarithm, ...){ + + # determinant by cofactors + + latexMultSymbol <- getLatexMultSymbol() + + # helper function for recursion: + DET <- function(X){ + if (nrow(X) == 1) { + as.vector(X) + } else if (nrow(X) == 2){ + paste0(parenthesize(X[1, 1]), paste0(" ", latexMultSymbol, " "), parenthesize(X[2, 2]), " - ", + parenthesize(X[1, 2]), paste0(" ", latexMultSymbol, " "), parenthesize(X[2, 1])) + } else { + indices <- 1:ncol(X) + res <- "" + for (j in indices){ + res <- paste0(res, if (isOdd(j)) " + " else " - ", + X[1, j], paste0(" ", latexMultSymbol, " "), + parenthesize(DET(X[-1, indices != j])) + ) + } + res + } + } + + numericDimensions(x) + + sub("^[ +]*", "", DET(getBody(x))) +} + + +#' @rdname matsum +#' @export +solve.latexMatrix <- function (a, b, simplify=FALSE, + frac=c("\\dfrac", "\\frac", "\\tfrac", "\\cfrac"), + ...) { + + # symbolic matrix inverse by adjoint matrix and determinant + + frac <- match.arg(frac) + + numericDimensions(a) + if (Nrow(a) != Ncol(a)) stop("matrix 'a' must be square") + if (!missing(b)) warning("'b' argument to solve() ignored") + + det <- determinant(a) + A <- getBody(a) + n <- nrow(A) + indices <- 1:n + A_inv <- matrix("", n, n) + + for (i in 1:n){ + for (j in 1:n){ + A_ij <- latexMatrix(A[indices[-i], indices[-j], drop=FALSE]) + A_inv[i, j] <- if (Nrow(A_ij) == 1) { # cofactors + A[indices[-i], indices[-j]] + } else{ + determinant(A_ij) + } + if (isOdd(i + j)) A_inv[i, j] <- paste0("-", parenthesize(A_inv[i, j])) + if (!simplify) A_inv[i, j] <- paste0(frac, "{", A_inv[i, j], + "}{", det, "}") + } + } + + A_inv <- t(A_inv) # adjoint + result <- latexMatrix(A_inv) + result <- updateWrapper(result, getWrapper(a)) + + if (!simplify) { + return(result) + } else { + return(paste0("\\frac{1}{", det, "} \n", + getLatex(result))) + } +} + +setOldClass("latexMatrix") + +setMethod("kronecker", + signature(X = "latexMatrix", + Y = "latexMatrix"), + function(X, Y, FUN, make.dimnames, ...) { + + numericDimensions(X) + numericDimensions(Y) + + latexMultSymbol <- getLatexMultSymbol() + + Xmat <- getBody(X) + Ymat <- getBody(Y) + + Z <- .kronecker(Xmat, Ymat, + function(x, y) { + x <- trimws(x) + y <- trimws(y) + zeros <- as.character(x) == "0" | + as.character(y) == "0" + x <- sapply(x, parenthesize) + y <- sapply(y, parenthesize) + res <- paste0(x, paste0(" ", latexMultSymbol, " "), y) + res[zeros] <- "0" + res + } + ) + + result <- latexMatrix(Z, ...) + result <- updateWrapper(result, getWrapper(X)) + result + } +) + +#' @rdname matsum +#' @export +`%X%` <- function(x, y) methods::kronecker(x, y) + +#' @rdname matsum +#' @export +is.numeric.latexMatrix <- function(x){ + x <- getBody(x) + x <- suppressWarnings(as.numeric(x)) + !any(is.na(x)) +} diff --git a/dev/latexMatrixOperations.R b/dev/latexMatrixOperations.R new file mode 100644 index 00000000..38844133 --- /dev/null +++ b/dev/latexMatrixOperations.R @@ -0,0 +1,563 @@ +#' Arithmetic and Other Operations on \code{"latexMatrix"} Objects +#' +#' @description +#' +#' There are \code{"latexMatrix"} methods for several standard R arithmetic +#' operators and functions of matrices, including: +#' \itemize{ +#' \item \code{matsum()} and \code{+}, matrix addition; +#' \item \code{matdiff()} and \code{-}, matrix subtraction and negation; +#' \item \code{*}, product of a scalar and a matrix); +#' \item \code{dot()}, inner product of two vectors; +#' \item \code{matprod()} and \code{\%*\%}, matrix product; +#' \item \code{matpower()} and \code{^}, powers (including inverse) of +#' a square matrix; +#' \item \code{solve()} and \code{inverse()}, matrix inverse of a square matrix; +#' \item \code{t()}, transpose; +#' \item \code{determinant()} of a square matrix; +#' \item \code{kronecker()} and \code{\%O\%} (the Kronecker product), and +#' } +#' +#' These operators and functions only apply to \code{"latexMatrix"} objects +#' of definite (i.e., numeric) dimensions. When there are both a funcion and an +#' operator (e.g., \code{matmult()} and \code{%*%}), the former is more +#' flexible via optional arguments and the latter calls the former with default +#' arguments. +#' +#' The result of matrix multiplication, \eqn{\mathbf{C} = \mathbf{A} \: \mathbf{B}} +#' is composed of the vector inner (dot) products of each \emph{row} of \eqn{\mathbf{A}} with +#' each \emph{column} of \eqn{\mathbf{B}}, +#' \deqn{c_{ij} = \mathbf{a}_i^top \mathbf{b}_j +#' = \Sigma_k a_{ik} \cdot b_{kj}} +#' +#' The \code{dot()} function computes the inner product symbolically in LaTeX notation for +#' numeric and character vectors, simplifying the result if \code{simplify = TRUE.} + +#' The LaTeX symbol for multiplication (\code{"\\cdot"} by default) +#' can be changed by changing \code{options(latexMultSymbol)}, +#' e.g, \code{options(latexMultSymbol = "\\times")}. +#' +#' @author John Fox +#' @seealso \code{\link{latexMatrix}} + +# # for debugging: +# numericDimensions <- matlib:::numericDimensions +# parenthesize <- matlib:::parenthesize +# updateWrapper <- matlib:::updateWrapper +# getLatexMultSymbol <- matlib:::getLatexMultSymbol + +#' @param e1 a \code{"latexMatrix"} object; or for \code{*} a scalar; +#' @param e2 a \code{"latexMatrix"} object; or for \code{*} a scalar; +#' for \code{^} an integer power \code{>= -1} to raise a square matrix +#' @param A a \code{"latexMatrix"} object +#' @param B a \code{"latexMatrix"} object +#' @param X a \code{"latexMatrix"} object +#' @param x for \code{dot} a numeric or character vector; +#' otherwise a \code{"latexMatrix"} object +#' @param y for \code{dot} a numeric or character vector; +#' otherwise a \code{"latexMatrix"} object +#' @param simplify if \code{TRUE} (the default), an attempt is made +#' to simplify the result slightly; for \code{solve()}, +#' return a LaTeX expression with the inverse of the determinant in +#' front of the adjoint matrix rather than a \code{"latexMatrix"} object in which each +#' element of the adjoint matrix is divided by the determinant +#' @param numeric if \code{TRUE} (the default) and the matrices to be multiplied can be +#' coerced to numeric, matrix multiplication is performed numerically; +#' supercedes \code{simplify} +#' @param power to raise a square matrix, an integer \code{>= -1}. +#' @param ... for \code{matmult()} and \code{sum()} zero or more +#' \code{"latexMatrix"} objects; otherwise arguments to be passed down +#' @param a a \code{"latexMatrix"} object representing a square matrix +#' @param b ignored; to match the \code{\link{solve}()} generic +#' @param frac LaTeX command to use in forming fractions; the default +#' is \code{"\\dfrac"} +#' +#' @examples +#' +#' A <- latexMatrix(symbol="a", nrow=2, ncol=2) +#' B <- latexMatrix(symbol="b", nrow=2, ncol=2) +#' A +#' B +#' A + B +#' A - B +#' "a" * A +#' C <- latexMatrix(symbol="c", nrow=2, ncol=3) +#' A %*% C +#' t(C) +#' determinant(A) +#' cat(solve(A, simplify=TRUE)) +#' D <- latexMatrix(matrix(letters[1:4], 2, 2)) +#' D +#' as.numeric(D, locals=list(a=1, b=2, c=3, d=4)) +#' X <- latexMatrix(matrix(c(3, 2, 0, 1, 1, 1, 2,-2, 1), 3, 3)) +#' X +#' as.numeric(X) +#' MASS::fractions(as.numeric(solve(X))) +#' (d <- determinant(X)) +#' eval(parse(text=(gsub("\\\\cdot", "*", d)))) +#' X <- latexMatrix(matrix(1:6, 2, 3), matrix="bmatrix") +#' I3 <- latexMatrix(diag(3)) +#' I3 %X% X +#' kronecker(I3, X, sparse=TRUE) +#' + +#' @returns All of these functions return \code{"latexMatrix"} object, +#' except for \code{dot()}, which returns a LaTeX expression as a character string + +#' @rdname latexMatrixOperations +#' @export +`+.latexMatrix` <- function(e1, e2){ + matsum(e1, e2) +} + +#' @rdname latexMatrixOperations +#' @export +matsum <- function(A, ...){ + UseMethod("matsum") +} + +#' @rdname latexMatrixOperations +#' @export +matsum.latexMatrix <- function(A, ..., as.numeric=TRUE){ + + matrices <- list(...) + + if (any(sapply(matrices, function(x) !inherits(x, "latexMatrix")))){ + stop("arguments are not all of class 'latexMatrix'") + } + + numericDimensions(A) + for (M in matrices) numericDimensions(M) + + wrapper <- getWrapper(A) + + if (as.numeric && is.numeric(A) && all(sapply(matrices, is.numeric))){ + A <- as.numeric(A) + dimA <- dim(A) + matrices <- lapply(matrices, as.numeric) + for (i in seq_along(matrices)){ + if (!all(dim(matrices[[i]]) == dimA)) + stop ("the matrices are not conformable for addition") + A <- A + matrices[[i]] + } + } else { + A <- getBody(A) + dimA <- dim(A) + for (M in matrices){ + M <- getBody(M) + if(!all(dim(A) == dim(M))) + stop('matricies are not conformable for addition') + A <- matrix(paste(sapply(A, parenthesize), "+", + sapply(M, parenthesize)), + dimA[1L], dimA[2L]) + } + } + A <- latexMatrix(A) + A <- updateWrapper(A, wrapper) + A +} + +#' @rdname latexMatrixOperations +#' @export +`-.latexMatrix` <- function(e1, e2){ + if (missing(e2)) e2 <- NULL + matdiff(e1, e2) +} + +#' @rdname latexMatrixOperations +#' @export +matdiff <- function(A, B, ...){ + UseMethod("matdiff") +} + +#' @rdname latexMatrixOperations +#' @export +matdiff.latexMatrix <- function(A, B=NULL, as.numeric=TRUE, ...){ + + wrapper <- getWrapper(A) + + # unary - + if (is.null(B)){ + numericDimensions(A) + if (as.numeric && is.numeric(A)){ + A <- as.numeric(A) + A <- -A + } else { + A <- getBody(A) + dimA <- dim(A) + A <- matrix(paste("-", sapply(A, parenthesize)), dimA[1L], dimA[2L]) + } + A <- latexMatrix(A) + A <- updateWrapper(A, getWrapper(A)) + return(A) + } + if (!inherits(B, "latexMatrix")){ + stop(deparse(substitute(B)), + " is not of class 'latexMatrix'") + } + numericDimensions(A) + numericDimensions(B) + dimA <- Dim(A) + dimB <- Dim(B) + if (!all(dimA == dimB)) + stop('matricies are not conformable for subtraction') + if (as.numeric && is.numeric(A) && is.numeric(B)){ + A <- as.numeric(A) + B <- as.numeric(B) + A <- A - B + } else { + A <- getBody(A) + B <- getBody(B) + A <- matrix(paste(sapply(A, parenthesize), "-", + sapply(B, parenthesize)), + dimA[1L], dimA[2L]) + } + A <- latexMatrix(A) + A <- updateWrapper(A, wrapper) + A +} + +#' @rdname latexMatrixOperations +#' @export +`*.latexMatrix` <- function (e1, e2) { + if (inherits(e1, "latexMatrix") && inherits(e2, "latexMatrix")) + stop("both arguments of * cannot be 'latexMatrix' objects") + swapped <- if (inherits(e1, "latexMatrix")) { + swap <- e1 + e1 <- e2 + e2 <- swap + TRUE + } else { + FALSE + } + if (!is.vector(e1) || length(e1) != 1) + stop("one argument to * must be a scalar") + numericDimensions(e2) + + latexMultSymbol <- getLatexMultSymbol() + + A <- getBody(e2) + dimA <- dim(A) + wrapper <- getWrapper(e2) + result <- matrix(if (swapped) { + paste(sapply(A, parenthesize), latexMultSymbol, e1) + } else{ + paste(e1, latexMultSymbol, sapply(A, parenthesize)) + }, + dimA[1L], dimA[2L]) + result <- latexMatrix(result) + result <- updateWrapper(result, getWrapper(e2)) + result$dim <- Dim(e2) + result +} + +#' @rdname latexMatrixOperations +#' @export +dot <- function(x, y, simplify = TRUE) { + if (length(x) != length(y)) stop("Vectors must have the same length") + x <- trimws(x) + y <- trimws(y) + latexMultSymbol <- getLatexMultSymbol() + res <- "" + for (i in 1:length(x)) { + if (!simplify) { + res <- paste0(res, + if (i > 1) " + ", + parenthesize(x[i]), + paste0(" ", latexMultSymbol, " "), + parenthesize(y[i])) + } + else { + # ignore terms multiplied by zero + if (x[i] == "0") next + if (y[i] == "0") next + xi <- if(x[i] == "1") "" else x[i] + yi <- if(y[i] == "1") "" else y[i] + if (x[i] == "1" && y[i] == "1") xi <- "1" + xi <- if (xi == "-1") "-" else xi + if (y[i] == "-1") { + yi <- "" + xi <- if (x[i] == "-1") "1" else paste0("-", parenthesize(xi)) + } + times <- if(xi == "" || xi == "-" || yi == "") "" else paste0(" ", latexMultSymbol, " ") + res <- paste0(res, + if (nchar(res) > 0) " + ", + if (y[i] != "-1" && xi != "-") parenthesize(xi) else xi, + times, + parenthesize(yi)) + } + } + if (res == "") res <- "0" + if (res == "-") res <- "-1" + res <- gsub("\\+ *-", "- ", res) + res +} + +#' @rdname latexMatrixOperations +#' @export +`%*%.latexMatrix` <- function(x, y){ + matmult(x, y) +} + +#' @rdname latexMatrixOperations +#' @export +matmult <- function(X, ...){ + UseMethod("matmult") +} + +#' @rdname latexMatrixOperations +#' @export +matmult.latexMatrix <- function(X, ..., simplify=TRUE, + as.numeric=TRUE){ + + matrices <- list(...) + + if (any(sapply(matrices, function(x) !inherits(x, "latexMatrix")))){ + stop("arguments are not all of class 'latexMatrix'") + } + + numericDimensions(X) + for (M in matrices) numericDimensions(M) + + wrapper <- getWrapper(X) + + if (as.numeric && is.numeric(X) && all(sapply(matrices, is.numeric))){ + X <- as.numeric(X) + matrices <- lapply(matrices, as.numeric) + for (i in seq_along(matrices)){ + X <- X %*% matrices[[i]] + } + } else { + + X <- getBody(X) + + for (M in matrices){ + + Y <- getBody(M) + if (ncol(X) != nrow(Y)){ + stop('matricies are not conformable for multiplication') + } + + Z <- matrix("", nrow(X), ncol(Y)) + + for (i in 1:nrow(X)){ + for (j in 1:ncol(Y)){ + for (k in 1:ncol(X)){ + Z[i, j] <- dot(X[i, ], Y[, j], simplify=simplify) + } + } + } + X <- Z + } + } + X <- latexMatrix(X) + X <- updateWrapper(X, wrapper) + return(X) + +} + +#' @rdname latexMatrixOperations +#' @export +matpower <- function(X, power, ...){ + UseMethod("matpower") +} + +#' @rdname latexMatrixOperations +#' @export +matpower.latexMatrix <- function(X, power, simplify=TRUE, + as.numeric=TRUE, ...){ + + numericDimensions(X) + dimX <- Dim(X) + if (dimX[1] != dimX[2]) stop ("X is not square") + if (power != round(power) || power < -1) + stop("'power' must be an integer >= -1") + + wrapper <- getWrapper(X) + + if (power == 0){ + result <- latexMatrix(diag(dimX[1])) + result <- updateWrapper(result, wrapper) + return(result) + } + + if (as.numeric && is.numeric(X)){ + X <- as.numeric(X) + Xp <- if (power == -1){ + solve(X) + } else { + result <- diag(dimX[1]) + for (i in 1:power){ + result <- result %*% X + } + result + } + Xp <- latexMatrix(Xp) + } else { + Xp <- if (power == -1) { + solve(X, simplify=simplify) + } else { + result <- latexMatrix(diag(dimX[1])) + for (i in 1:power){ + result <- matmult(result, X, simplify=simplify) + } + result + } + } + Xp <- updateWrapper(Xp, wrapper) + return(Xp) +} + +#' @rdname latexMatrixOperations +#' @export +`^.latexMatrix` <- function(e1, e2){ + matpower(e1, e2) +} + +#' @rdname latexMatrixOperations +#' @export +inverse <- function(X, ...){ + UseMethod("inverse") +} + +#' @rdname latexMatrixOperations +#' @export +inverse.latexMatrix <- function(X, ..., numeric=TRUE, + simplify=TRUE){ + matpower(X, -1, numeric=numeric, simplify=simplify) +} + +#' @rdname latexMatrixOperations +#' @export +t.latexMatrix <- function(x){ + numericDimensions(x) + result <- latexMatrix(t(getBody(x))) + result <- updateWrapper(result, getWrapper(x)) + result$dim <- rev(Dim(x)) + result +} + +#' @rdname latexMatrixOperations +#' @export +determinant.latexMatrix <- function(x, logarithm, ...){ + + # determinant by cofactors + + latexMultSymbol <- getLatexMultSymbol() + + # helper function for recursion: + DET <- function(X){ + if (nrow(X) == 1) { + as.vector(X) + } else if (nrow(X) == 2){ + paste0(parenthesize(X[1, 1]), paste0(" ", latexMultSymbol, " "), parenthesize(X[2, 2]), " - ", + parenthesize(X[1, 2]), paste0(" ", latexMultSymbol, " "), parenthesize(X[2, 1])) + } else { + indices <- 1:ncol(X) + res <- "" + for (j in indices){ + res <- paste0(res, if (isOdd(j)) " + " else " - ", + X[1, j], paste0(" ", latexMultSymbol, " "), + parenthesize(DET(X[-1, indices != j])) + ) + } + res + } + } + + numericDimensions(x) + + sub("^[ +]*", "", DET(getBody(x))) +} + + +#' @rdname latexMatrixOperations +#' @export +solve.latexMatrix <- function (a, b, simplify=FALSE, + frac=c("\\dfrac", "\\frac", "\\tfrac", "\\cfrac"), + ...) { + + # symbolic matrix inverse by adjoint matrix and determinant + + frac <- match.arg(frac) + + numericDimensions(a) + if (Nrow(a) != Ncol(a)) stop("matrix 'a' must be square") + if (!missing(b)) warning("'b' argument to solve() ignored") + + det <- determinant(a) + A <- getBody(a) + n <- nrow(A) + indices <- 1:n + A_inv <- matrix("", n, n) + + for (i in 1:n){ + for (j in 1:n){ + A_ij <- latexMatrix(A[indices[-i], indices[-j], drop=FALSE]) + A_inv[i, j] <- if (Nrow(A_ij) == 1) { # cofactors + A[indices[-i], indices[-j]] + } else{ + determinant(A_ij) + } + if (isOdd(i + j)) A_inv[i, j] <- paste0("-", parenthesize(A_inv[i, j])) + if (!simplify) A_inv[i, j] <- paste0(frac, "{", A_inv[i, j], + "}{", det, "}") + } + } + + A_inv <- t(A_inv) # adjoint + result <- latexMatrix(A_inv) + result <- updateWrapper(result, getWrapper(a)) + + if (!simplify) { + return(result) + } else { + return(paste0("\\frac{1}{", det, "} \n", + getLatex(result))) + } +} + +setOldClass("latexMatrix") + +setMethod("kronecker", + signature(X = "latexMatrix", + Y = "latexMatrix"), + function(X, Y, FUN, make.dimnames, ...) { + + numericDimensions(X) + numericDimensions(Y) + + latexMultSymbol <- getLatexMultSymbol() + + Xmat <- getBody(X) + Ymat <- getBody(Y) + + Z <- .kronecker(Xmat, Ymat, + function(x, y) { + x <- trimws(x) + y <- trimws(y) + zeros <- as.character(x) == "0" | + as.character(y) == "0" + x <- sapply(x, parenthesize) + y <- sapply(y, parenthesize) + res <- paste0(x, paste0(" ", latexMultSymbol, " "), y) + res[zeros] <- "0" + res + } + ) + + result <- latexMatrix(Z, ...) + result <- updateWrapper(result, getWrapper(X)) + result + } +) + +`%X%` <- function(x, y) methods::kronecker(x, y) + +#' @rdname latexMatrixOperations +#' @export +is.numeric.latexMatrix <- function(x){ + x <- getBody(x) + x <- suppressWarnings(as.numeric(x)) + !any(is.na(x)) +} diff --git a/man/latexMatrix.Rd b/man/latexMatrix.Rd index d55888f4..1ffc2836 100644 --- a/man/latexMatrix.Rd +++ b/man/latexMatrix.Rd @@ -15,16 +15,7 @@ \alias{Ncol} \alias{Ncol.latexMatrix} \alias{print.latexMatrix} -\alias{+.latexMatrix} -\alias{-.latexMatrix} -\alias{\%*\%.latexMatrix} -\alias{*.latexMatrix} -\alias{t.latexMatrix} -\alias{determinant.latexMatrix} -\alias{solve.latexMatrix} \alias{as.double.latexMatrix} -\alias{kronecker,latexMatrix,latexMatrix-method} -\alias{\%X\%} \title{Create and Manipulate LaTeX Repesentations of Matrices} \usage{ latexMatrix( @@ -74,31 +65,7 @@ Ncol(x, ...) \method{print}{latexMatrix}(x, onConsole = TRUE, ...) -\method{+}{latexMatrix}(e1, e2) - -\method{-}{latexMatrix}(e1, e2) - -\method{\%*\%}{latexMatrix}(x, y) - -\method{*}{latexMatrix}(e1, e2) - -\method{t}{latexMatrix}(x) - -\method{determinant}{latexMatrix}(x, logarithm, ...) - -\method{solve}{latexMatrix}( - a, - b, - simplify = FALSE, - frac = c("\\\\dfrac", "\\\\frac", "\\\\tfrac", "\\\\cfrac"), - ... -) - \method{as.double}{latexMatrix}(x, locals = list(), ...) - -\S4method{kronecker}{latexMatrix,latexMatrix}(X, Y, FUN = "*", make.dimnames = FALSE, ...) - -x \%X\% y } \arguments{ \item{symbol}{name for matrix elements, character string. For LaTeX symbols, @@ -169,38 +136,10 @@ on each element} \item{onConsole}{if \code{TRUE}, the default, print the LaTeX code for the matrix on the R console.} -\item{e1}{a \code{"latexMatrix"} object (or, for \code{*} a scalar).} - -\item{e2}{a \code{"latexMatrix"} object (or, for \code{*} a scalar).} - -\item{y}{a \code{"latexMatrix"} object} - -\item{logarithm}{ignored; to match the \code{\link{determinant}} generic} - -\item{a}{a \code{"latexMatrix"} object representing a square matrix} - -\item{b}{ignored; to match the \code{\link{solve}} generic} - -\item{simplify}{if \code{TRUE} (the default is \code{FALSE}), -return a LaTeX expression with the inverse of the determinant in -front of the adjoint matrix rather than a \code{"latexMatrix"} object in which each -element of the adjoint matrix is divided by the determinant.} - -\item{frac}{LaTeX command to use in forming fractions; the default -is \code{"\\dfrac"}} - \item{locals}{an optional list or named numeric vector of variables to be given specific numeric values; e.g., \code{locals = list(a = 1, b = 5, c = -1, d = 4)} or \code{locals = c(a = 1, b = 5, c = -1, d = 4)}} - -\item{X}{a \code{"latexMatrix"} object} - -\item{Y}{a \code{"latexMatrix"} object} - -\item{FUN}{to match the \code{\link{kronecker}} generic, ignored} - -\item{make.dimnames}{to match the \code{\link{kronecker}} generic, ignored} } \value{ \code{latexMatrix()} returns an object of class \code{"latexMatrix"} @@ -275,7 +214,7 @@ This implementation assumes that the LaTeX \code{amsmath} package will be availa You may need to use \code{extra_dependencies: ["amsmath"]} in your YAML header of a \code{Rmd} or \code{qmd} file. -You can actually supply a numeric matrix as the \code{symbol}, but the result will not be pretty +You can supply a numeric matrix as the \code{symbol}, but the result will not be pretty unless the elements are integers or are rounded. For a LaTeX representation of general numeric matrices, use \code{\link{matrix2latex}}. @@ -283,21 +222,8 @@ The accessor functions \code{getLatex()}, \code{getBody()}, \code{getWrapper()}, \code{getDim()}, \code{getNrow()}, and \code{getNcol()} may be used to retrieve components of the returned object. -There are \code{"latexMatrix"} methods for several standard R arithmetic -operators and functions of matrices, including: -\itemize{ -\item \code{+} (matrix addition), \code{-} -(matrix subtraction), \code{*} (product of a scalar and a matrix), -\item \code{\%*\%} (matrix product), -\item \code{t()} (transpose), -\item \code{determinant()}, -\item \code{solve()} (matrix inverse), -\item \code{kronecker()} and the operator \code{\%O\%} (the Kronecker product), and -\item \code{as.double()} (coercion to numeric, if possible). -} - -These operators and functions only apply to \code{"latexMatrix"} objects -of definite (i.e., numeric) dimensions. +Various functions and operators for \code{"latexMatrix"} objects are +documents separately; see, e.g., \code{\link{matsum}} } \examples{ latexMatrix() @@ -367,36 +293,10 @@ latexMatrix(m, fractions=TRUE) # zero-based indexing latexMatrix(zero.based=c(TRUE, TRUE)) - -# arithmetic operators and functions -A <- latexMatrix(symbol="a", nrow=2, ncol=2) -B <- latexMatrix(symbol="b", nrow=2, ncol=2) -A -B -A + B -A - B -"a" * A -C <- latexMatrix(symbol="c", nrow=2, ncol=3) -A \%*\% C -t(C) -determinant(A) -cat(solve(A, simplify=TRUE)) -D <- latexMatrix(matrix(letters[1:4], 2, 2)) -D -as.numeric(D, locals=list(a=1, b=2, c=3, d=4)) -X <- latexMatrix(matrix(c(3, 2, 0, 1, 1, 1, 2,-2, 1), 3, 3)) -X -as.numeric(X) -MASS::fractions(as.numeric(solve(X))) -(d <- determinant(X)) -eval(parse(text=(gsub("\\\\\\\\cdot", "*", d)))) -X <- latexMatrix(matrix(1:6, 2, 3), matrix="bmatrix") -I3 <- latexMatrix(diag(3)) -I3 \%X\% X -kronecker(I3, X, sparse=TRUE) } \seealso{ -\code{\link{matrix2latex}}, \code{\link[clipr]{write_clip}} +\code{\link{matsum}}, \code{\link{matrix2latex}}, + \code{\link[clipr]{write_clip}} } \author{ John Fox diff --git a/man/matsum.Rd b/man/matsum.Rd new file mode 100644 index 00000000..47550435 --- /dev/null +++ b/man/matsum.Rd @@ -0,0 +1,192 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/latexMatrixOperations.R +\name{matsum} +\alias{matsum} +\alias{matsum.latexMatrix} +\alias{+.latexMatrix} +\alias{matdiff} +\alias{matdiff.latexMatrix} +\alias{-.latexMatrix} +\alias{*.latexMatrix} +\alias{Dot} +\alias{matmult} +\alias{matmult.latexMatrix} +\alias{\%*\%.latexMatrix} +\alias{matpower} +\alias{matpower.latexMatrix} +\alias{^.latexMatrix} +\alias{inverse} +\alias{inverse.latexMatrix} +\alias{t.latexMatrix} +\alias{determinant.latexMatrix} +\alias{solve.latexMatrix} +\alias{\%X\%} +\alias{is.numeric.latexMatrix} +\title{Various Functions and Operators for latexMatrix Object} +\usage{ +matsum(A, ...) + +\method{matsum}{latexMatrix}(A, ..., as.numeric = TRUE) + +\method{+}{latexMatrix}(e1, e2) + +matdiff(A, B, ...) + +\method{matdiff}{latexMatrix}(A, B = NULL, as.numeric = TRUE, ...) + +\method{-}{latexMatrix}(e1, e2) + +\method{*}{latexMatrix}(e1, e2) + +Dot(x, y, simplify = TRUE) + +matmult(X, ...) + +\method{matmult}{latexMatrix}(X, ..., simplify = TRUE, as.numeric = TRUE) + +\method{\%*\%}{latexMatrix}(x, y) + +matpower(X, power, ...) + +\method{matpower}{latexMatrix}(X, power, simplify = TRUE, as.numeric = TRUE, ...) + +\method{^}{latexMatrix}(e1, e2) + +inverse(X, ...) + +\method{inverse}{latexMatrix}(X, ..., as.numeric = TRUE, simplify = TRUE) + +\method{t}{latexMatrix}(x) + +\method{determinant}{latexMatrix}(x, logarithm, ...) + +\method{solve}{latexMatrix}( + a, + b, + simplify = FALSE, + frac = c("\\\\dfrac", "\\\\frac", "\\\\tfrac", "\\\\cfrac"), + ... +) + +x \%X\% y + +\method{is.numeric}{latexMatrix}(x) +} +\arguments{ +\item{A}{a \code{"latexMatrix"} object} + +\item{...}{for \code{matmult()} and \code{sum()} zero or more +\code{"latexMatrix"} objects; otherwise arguments to be passed down} + +\item{as.numeric}{if \code{TRUE} (the default) and the matrices to be multiplied can be +coerced to numeric, matrix multiplication is performed numerically; +supercedes \code{simplify}} + +\item{e1}{a \code{"latexMatrix"} object; or for \code{*} a scalar;} + +\item{e2}{a \code{"latexMatrix"} object; or for \code{*} a scalar; +for \code{^} an integer power \code{>= -1} to raise a square matrix} + +\item{B}{a \code{"latexMatrix"} object} + +\item{x}{for \code{Dot} a numeric or character vector; +otherwise a \code{"latexMatrix"} object} + +\item{y}{for \code{Dot} a numeric or character vector; +otherwise a \code{"latexMatrix"} object} + +\item{simplify}{if \code{TRUE} (the default), an attempt is made +to simplify the result slightly; for \code{solve()}, +return a LaTeX expression with the inverse of the determinant in +front of the adjoint matrix rather than a \code{"latexMatrix"} object in which each +element of the adjoint matrix is divided by the determinant} + +\item{X}{a \code{"latexMatrix"} object} + +\item{power}{to raise a square matrix, an integer \code{>= -1}.} + +\item{logarithm}{to match the generic \code{\link{determinant}()} function, +ignored} + +\item{a}{a \code{"latexMatrix"} object representing a square matrix} + +\item{b}{ignored; to match the \code{\link{solve}()} generic} + +\item{frac}{LaTeX command to use in forming fractions; the default +is \code{"\\dfrac"}} +} +\value{ +All of these functions return \code{"latexMatrix"} objects, +except for \code{Dot()}, which returns a LaTeX expression as a character string. +} +\description{ +Operators and function provideds: +\itemize{ +\item \code{matsum()} and \code{+}, matrix addition; +\item \code{matdiff()} and \code{-}, matrix subtraction and negation; +\item \code{*}, product of a scalar and a matrix); +\item \code{Dot()}, inner product of two vectors; +\item \code{matprod()} and \code{\%*\%}, matrix product; +\item \code{matpower()} and \code{^}, powers (including inverse) of +a square matrix; +\item \code{solve()} and \code{inverse()}, matrix inverse of a square matrix; +\item \code{t()}, transpose; +\item \code{determinant()} of a square matrix; +\item \code{kronecker()} and \code{\%O\%} (the Kronecker product), and +} +} +\details{ +These operators and functions only apply to \code{"latexMatrix"} objects +of definite (i.e., numeric) dimensions. When there are both a funcion and an +operator (e.g., \code{matmult()} and \code{\%*\%}), the former is more +flexible via optional arguments and the latter calls the former with default +arguments. + +The result of matrix multiplication, \eqn{\mathbf{C} = \mathbf{A} \: \mathbf{B}} +is composed of the vector inner (dot) products of each \emph{row} of \eqn{\mathbf{A}} with +each \emph{column} of \eqn{\mathbf{B}}, +\deqn{c_{ij} = \mathbf{a}_i^\top \mathbf{b}_j + = \Sigma_k a_{ik} \cdot b_{kj}} + +The \code{Dot()} function computes the inner product symbolically in LaTeX notation for +numeric and character vectors, simplifying the result if \code{simplify = TRUE.} +The LaTeX symbol for multiplication (\code{"\\cdot"} by default) +can be changed by changing \code{options(latexMultSymbol)}, +e.g, \code{options(latexMultSymbol = "\\times")}. +} +\examples{ +A <- latexMatrix(symbol="a", nrow=2, ncol=2) +B <- latexMatrix(symbol="b", nrow=2, ncol=2) +A +B +A + B +A - B +"a" * A +C <- latexMatrix(symbol="c", nrow=2, ncol=3) +A \%*\% C +t(C) +determinant(A) +cat(solve(A, simplify=TRUE)) +D <- latexMatrix(matrix(letters[1:4], 2, 2)) +D +as.numeric(D, locals=list(a=1, b=2, c=3, d=4)) +X <- latexMatrix(matrix(c(3, 2, 0, 1, 1, 1, 2,-2, 1), 3, 3)) +X +as.numeric(X) +\dontrun{ +MASS::fractions(as.numeric(inverse(X))) +(d <- determinant(X)) +eval(parse(text=(gsub("\\\\\\\\cdot", "*", d)))) +} +X <- latexMatrix(matrix(1:6, 2, 3), matrix="bmatrix") +I3 <- latexMatrix(diag(3)) +I3 \%X\% X +kronecker(I3, X, sparse=TRUE) + +} +\seealso{ +\code{\link{latexMatrix}} +} +\author{ +John Fox +}