From 52699f130393f75aa251001d3076552b689a5408 Mon Sep 17 00:00:00 2001 From: Michael Friendly Date: Thu, 17 Oct 2024 18:42:40 -0400 Subject: [PATCH] test dev/vectors3d --- .gitignore | 1 + R/vectors3d.R | 20 ++++++-- dev/test-vectors3d.R | 32 +++++++++++++ dev/vectors3d.R | 88 +++++++++++++++++++++++++++++++++++ vignettes/latex-equations.Rmd | 6 +-- 5 files changed, 140 insertions(+), 7 deletions(-) create mode 100644 dev/test-vectors3d.R create mode 100644 dev/vectors3d.R diff --git a/.gitignore b/.gitignore index 7244f398..5ba6b802 100644 --- a/.gitignore +++ b/.gitignore @@ -6,5 +6,6 @@ inst/doc vignettes/*.R vignettes/*.html vignettes/*.png +vignettes/*.log .Rproj.user dev/*.pdf diff --git a/R/vectors3d.R b/R/vectors3d.R index 6c5c15bf..b8d48899 100644 --- a/R/vectors3d.R +++ b/R/vectors3d.R @@ -56,8 +56,13 @@ #' rgl.bringtotop() vectors3d <- function(X, origin=c(0,0,0), - headlength=0.035, ref.length=NULL, radius=1/60, - labels=TRUE, cex.lab=1.2, adj.lab=0.5, frac.lab=1.1, draw=TRUE, ...) { + color, + headlength=0.035, ref.length=NULL, radius=1/60, + labels=TRUE, + cex.lab=1.2, adj.lab=0.5, frac.lab=1.1, + draw=TRUE, + col.lab = col, + ...) { if (is.vector(X)) X <- matrix(X, ncol=3) n <- nrow(X) @@ -66,7 +71,10 @@ vectors3d <- function(X, origin=c(0,0,0), scale <- c(1, 1, 1) # radius <- 1/60 - ref.length <- arrows3d(OX, headlength=headlength, scale=scale, radius=radius, + ref.length <- arrows3d(OX, + color = color, + headlength=headlength, + scale=scale, radius=radius, ref.length=ref.length, draw=draw, ...) if (draw){ @@ -80,7 +88,11 @@ vectors3d <- function(X, origin=c(0,0,0), xl = origin[1] + frac.lab * (X[,1]-origin[1]) yl = origin[2] + frac.lab * (X[,2]-origin[2]) zl = origin[3] + frac.lab * (X[,3]-origin[3]) - text3d(xl, yl, zl, labels, cex=cex.lab, adj=adj.lab, ...) + # can't pass color to plotmath3d() + text3d(xl, yl, zl, labels, cex=cex.lab, adj=adj.lab, +# usePlotmath = is.expression(labels), +# color = col.lab, + ...) } } invisible(c(ref.length=ref.length)) diff --git a/dev/test-vectors3d.R b/dev/test-vectors3d.R new file mode 100644 index 00000000..0b2ba855 --- /dev/null +++ b/dev/test-vectors3d.R @@ -0,0 +1,32 @@ +--- + title: "Test plot math in vectors3d" +--- + +library(rgl) +library(matlib) + +# want to use labels that are expressions: +labs <- c(expression(x[1]), "y", expression(x[2])) +is.expression(labs) + +source(here::here("dev", "vectors3d.R")) + +open3d() +E <- diag(3) +rownames(E) <- c(expression(x[1]), "y", expression(x[2])) +vectors3d(E, lwd=2) +vectors3d(c(1, 1, 1), + labels=c("",expression(hat(y))), color="red", + lwd=3) +vectors3d(c(1, 1, 0), + labels=c("", "x+y"), + color="green", lwd=2) +planes3d(0, 0, 1, 0, col="gray", + alpha=0.1) +segments3d(rbind(c(1, 1, 1), + c(1, 1, 0))) +arc(c(1, 1, 1), c(0, 0, 0), + c(1, 1, 0)) +corner(c(0, 0, 0), c(1, 1, 0), c(1, 1, 1)) + + diff --git a/dev/vectors3d.R b/dev/vectors3d.R new file mode 100644 index 00000000..6c5c15bf --- /dev/null +++ b/dev/vectors3d.R @@ -0,0 +1,88 @@ + +#' Draw 3D vectors +#' +#' This function draws vectors in a 3D plot, in a way that facilitates constructing vector diagrams. It allows vectors to be +#' specified as rows of a matrix, and can draw labels on the vectors. +#' +#' @section Bugs: +#' At present, the color (\code{color=}) argument is not handled as expected when more than one vector is to be drawn. +#' +#' @param X a vector or three-column matrix representing a set of geometric vectors; if a matrix, one vector is drawn for each row +#' @param origin the origin from which they are drawn, a vector of length 3. +#' @param headlength the \code{headlength} argument passed to \code{\link{arrows3d}} determining the length of arrow heads +#' @param ref.length vector length to be used in scaling arrow heads so that they are all the same size; if \code{NULL} +#' the longest vector is used to scale the arrow heads +#' @param radius radius of the base of the arrow heads +#' @param labels a logical or a character vector of labels for the vectors. If \code{TRUE} and \code{X} is a matrix, +#' labels are taken from \code{rownames(X)}. If \code{FALSE} or \code{NULL}, no labels are drawn. +#' @param cex.lab character expansion applied to vector labels. May be a number or numeric vector corresponding to the the +#' rows of \code{X}, recycled as necessary. +#' @param adj.lab label position relative to the label point as in \code{\link[rgl]{text3d}}, recycled as necessary. +#' @param frac.lab location of label point, as a fraction of the distance between \code{origin} and \code{X}, recycled as necessary. +#' Values \code{frac.lab > 1} locate the label beyond the end of the vector. +#' @param draw if \code{TRUE} (the default), draw the vector(s). +#' @param ... other arguments passed on to graphics functions. +#' +#' @return invisibly returns the vector \code{ref.length} used to scale arrow heads +#' @export +#' @author Michael Friendly +#' @seealso \code{\link{arrows3d}}, \code{\link[rgl]{texts3d}}, \code{\link[rgl]{rgl.material}} +#' @family vector diagrams +#' @import rgl +#' +#' @examples +#' vec <- rbind(diag(3), c(1,1,1)) +#' rownames(vec) <- c("X", "Y", "Z", "J") +#' library(rgl) +#' open3d() +#' vectors3d(vec, color=c(rep("black",3), "red"), lwd=2) +#' # draw the XZ plane, whose equation is Y=0 +#' planes3d(0, 0, 1, 0, col="gray", alpha=0.2) +#' vectors3d(c(1,1,0), col="green", lwd=2) +#' # show projections of the unit vector J +#' segments3d(rbind(c(1,1,1), c(1, 1, 0))) +#' segments3d(rbind(c(0,0,0), c(1, 1, 0))) +#' segments3d(rbind(c(1,0,0), c(1, 1, 0))) +#' segments3d(rbind(c(0,1,0), c(1, 1, 0))) +#' # show some orthogonal vectors +#' p1 <- c(0,0,0) +#' p2 <- c(1,1,0) +#' p3 <- c(1,1,1) +#' p4 <- c(1,0,0) +#' corner(p1, p2, p3, col="red") +#' corner(p1, p4, p2, col="red") +#' corner(p1, p4, p3, col="blue") +#' +#' rgl.bringtotop() + +vectors3d <- function(X, origin=c(0,0,0), + headlength=0.035, ref.length=NULL, radius=1/60, + labels=TRUE, cex.lab=1.2, adj.lab=0.5, frac.lab=1.1, draw=TRUE, ...) { + + if (is.vector(X)) X <- matrix(X, ncol=3) + n <- nrow(X) + X <- rbind(matrix(origin, n, 3), X) + OX <- X[ as.vector(rbind(1:n, n+1:n)), ] + + scale <- c(1, 1, 1) +# radius <- 1/60 + ref.length <- arrows3d(OX, headlength=headlength, scale=scale, radius=radius, + ref.length=ref.length, draw=draw, ...) + + if (draw){ + if (is.logical(labels)) { + if (labels) labels <- rownames(X) + else labels <- NULL + } + if (!is.null(labels)) { + # DONE: allow for labels to be positioned some fraction of the way from origin to X + # FIXME: it is dangerous to use ... for both arrows3d() and text3d(), e.g., for col= + xl = origin[1] + frac.lab * (X[,1]-origin[1]) + yl = origin[2] + frac.lab * (X[,2]-origin[2]) + zl = origin[3] + frac.lab * (X[,3]-origin[3]) + text3d(xl, yl, zl, labels, cex=cex.lab, adj=adj.lab, ...) + } + } + invisible(c(ref.length=ref.length)) +} + diff --git a/vignettes/latex-equations.Rmd b/vignettes/latex-equations.Rmd index 39996eb0..906a87a6 100644 --- a/vignettes/latex-equations.Rmd +++ b/vignettes/latex-equations.Rmd @@ -3,13 +3,13 @@ title: "LaTeX Equations with latexMatrix, Eqn and matrix2latex" author: Phil Chalmers, John Fox, Michael Friendly date: "`r Sys.Date()`" output: + pdf_document: + toc: true + keep_tex: true bookdown::html_document2: base_format: rmarkdown::html_vignette number_sections: false toc: true - pdf_document: - toc: true - keep_tex: true bibliography: "references.bib" vignette: > %\VignetteIndexEntry{LaTeX Equations with latexMatrix, Eqn and matrix2latex}