trans3d() gets new option continuous allowing to suppress wrap-arou…

…nd singularities

git-svn-id: https://svn.r-project.org/R/trunk@84795 00db46b3-68df-0310-9c12-caf00c1e9a41

doc/NEWS.Rd

@@ -225,6 +225,11 @@
  substitution on platforms which do not support it (notably Alpine
  Linux). This should give a human-readable conversion in ASCII on
  all platforms (rather than \code{NA_character_}).
+
+ \item \code{trans3d()} gains options \code{continuous} and
+ \code{verbose} addressing the problem of possible \dQuote{wrap
+ around} when projecting too long curves, as reported by Achim Zeileis
+ in \PR{18537}.
  }
  }
 

src/library/grDevices/R/utils.R

@@ -1,7 +1,7 @@
 # File src/library/grDevices/R/utils.R
 # Part of the R package, https://www.R-project.org
 #
-# Copyright (C) 1995-2019 The R Core Team
+# Copyright (C) 1995-2023 The R Core Team
 #
 # This program is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
@@ -50,8 +50,17 @@ extendrange <- function(x, r = range(x, na.rm = TRUE), f = 0.05)
  r + f * diff(r)
 }
 
-trans3d <- function(x,y,z, pmat) {
+trans3d <- function(x,y,z, pmat, continuous = FALSE, verbose = TRUE) {
  tr <- cbind(x,y,z,1, deparse.level=0L) %*% pmat
+ if(continuous && (n <- nrow(tr)) >= 2) {
+ st4 <- sign(tr[,4])
+ if((s1 <- st4[1]) != st4[n]) { # have a sign change ==> cut off at sign switch
+ if((last <- (which.min(st4 == s1) - 1L)) >= 1L) { # needed? -- safe programming!
+ if(verbose) message(sprintf("points cut off after point[%d]", last))
+ tr <- tr[seq_len(last), , drop=FALSE]
+ }
+ }
+ }
  list(x = tr[,1]/tr[,4],
  y = tr[,2]/tr[,4])
 }

src/library/grDevices/man/trans3d.Rd

@@ -1,6 +1,6 @@
 % File src/library/grDevices/man/trans3d.Rd
 % Part of the R package, https://www.R-project.org
-% Copyright 1995-2007 R Core Team
+% Copyright 1995-2023 R Core Team
 % Distributed under GPL 2 or later
 
 \name{trans3d}
@@ -12,7 +12,7 @@
  perspective plots such as \code{\link{persp}}.
 }
 \usage{
-trans3d(x, y, z, pmat)
+trans3d(x, y, z, pmat, continuous = FALSE, verbose = TRUE)
 }
 \arguments{
  \item{x, y, z}{numeric vectors of equal length, specifying points in
@@ -21,15 +21,49 @@ trans3d(x, y, z, pmat)
  suitable for projecting the 3D coordinates \eqn{(x,y,z)} into the 2D
  plane using homogeneous 4D coordinates \eqn{(x,y,z,t)};
  such matrices are returned by \code{\link{persp}()}.}
+ \item{continuous}{logical flag specifying if the transformation should
+ check if the transformed points are continuous in the sense that they
+ do not jump over \eqn{a/0} discontinuity. As these assume
+ \code{(x,y,z)} to describe a continuous curve, the default must be
+ false. In case of projecting such a curve however, setting
+ \code{continuous=TRUE} may be advisable.}
+ \item{verbose}{only for \code{continuous=TRUE}, indicates if a warning
+ should be issued when points are cut off.}
 }
 \value{
  a list with two components
  \item{x,y}{the projected 2d coordinates of the 3d input \code{(x,y,z)}.}
 }
 \seealso{ \code{\link{persp}} }
 \examples{
-%% it would be nice to have an independent example
 ## See help(persp) {after attaching the 'graphics' package}
 ## -----------
+
+## Example for 'continuous = TRUE' (vs default):
+require(graphics)
+x <- -10:10/10 # [-1, 1]
+y <- -16:16/16 # [-1, 1] ==> z = fxy := outer(x,y) is also in [-1,1]
+
+p <- persp(x, y, fxy <- outer(x,y), phi = 20, theta = 15, r = 3, ltheta = -75,
+ shade = 0.8, col = "green3", ticktype = "detailed")
+## 5 axis-parallel auxiliary lines in x-y and y-z planes :
+lines(trans3d(-.5 , y=-1:1, z=min(fxy), pmat=p), lty=2)
+lines(trans3d( 0 , y=-1:1, z=min(fxy), pmat=p), lty=2)
+lines(trans3d(-1:1, y= -.7, z=min(fxy), pmat=p), lty=2)
+lines(trans3d( -1, y= -.7, z=c(-1,1) , pmat=p), lty=2)
+lines(trans3d( -1, y=-1:1, z= -.5 , pmat=p), lty=2)
+## 2 pillars to carry the horizontals below:
+lines(trans3d(-.5 , y= -.7, z=c(-1,-.5), pmat=p), lwd=1.5, col="gray10")
+lines(trans3d( 0 , y= -.7, z=c(-1,-.5), pmat=p), lwd=1.5, col="gray10")
+## now some "horizontal rays" (going from center to very left or very right):
+doHor <- function(x1, x2, z, CNT=FALSE, ...)
+ lines(trans3d(x=seq(x1, x2, by=0.5), y= -0.7, z = z, pmat = p, continuous = CNT),
+ lwd = 3, type="b", xpd=NA, ...)
+doHor(-10, 0, z = -0.5, col = 2) # x in [-10, 0] -- to the very left : fine
+doHor(-.5, 2, z = -0.52,col = 4) # x in [-0.5, 2] only {to the right} --> all fine
+## but now, x in [-0.5, 20] -- "too far" ==> "wrap around" problem (without 'continuous=TRUE'):
+doHor(-.5, 20, z = -0.58, col = "steelblue", lty=2)
+## but it is fixed with continuous = CNT = TRUE:
+doHor(-.5, 20, z = -0.55, CNT=TRUE, col = "skyblue")
 }
 \keyword{dplot}

tests/Examples/grDevices-Ex.Rout.save

@@ -1,7 +1,7 @@
 
-R Under development (unstable) (2023-05-04 r84393) -- "Unsuffered Consequences"
+R Under development (unstable) (2023-07-31 r84791) -- "Unsuffered Consequences"
 Copyright (C) 2023 The R Foundation for Statistical Computing
-Platform: aarch64-apple-darwin22.4.0 (64-bit)
+Platform: x86_64-pc-linux-gnu
 
 R is free software and comes with ABSOLUTELY NO WARRANTY.
 You are welcome to redistribute it under certain conditions.
@@ -3584,15 +3584,15 @@ attr(,"class")
 > ## time-dependent ==> ignore diffs:
 > ## IGNORE_RDIFF_BEGIN
 > pretty(Sys.Date())
-[1] "2023-05-02" "2023-05-03" "2023-05-04" "2023-05-05" "2023-05-06"
-[6] "2023-05-07"
+[1] "2023-07-29" "2023-07-30" "2023-07-31" "2023-08-01" "2023-08-02"
+[6] "2023-08-03"
 > pretty(Sys.time(), n = 10)
- [1] "2023-05-04 11:29:57 BST" "2023-05-04 11:29:58 BST"
- [3] "2023-05-04 11:29:59 BST" "2023-05-04 11:30:00 BST"
- [5] "2023-05-04 11:30:01 BST" "2023-05-04 11:30:02 BST"
- [7] "2023-05-04 11:30:03 BST" "2023-05-04 11:30:04 BST"
- [9] "2023-05-04 11:30:05 BST" "2023-05-04 11:30:06 BST"
-[11] "2023-05-04 11:30:07 BST"
+ [1] "2023-07-31 10:42:05 CEST" "2023-07-31 10:42:06 CEST"
+ [3] "2023-07-31 10:42:07 CEST" "2023-07-31 10:42:08 CEST"
+ [5] "2023-07-31 10:42:09 CEST" "2023-07-31 10:42:10 CEST"
+ [7] "2023-07-31 10:42:11 CEST" "2023-07-31 10:42:12 CEST"
+ [9] "2023-07-31 10:42:13 CEST" "2023-07-31 10:42:14 CEST"
+[11] "2023-07-31 10:42:15 CEST"
 > ## IGNORE_RDIFF_END
 > 
 > pretty(as.Date("2000-03-01")) # R 1.0.0 came in a leap year
@@ -3959,6 +3959,34 @@ v 0.98039216 0.7647059 0.4588235 0.8549020 0.9960784
 > ## See help(persp) {after attaching the 'graphics' package}
 > ## -----------
 > 
+> ## Example for 'continuous = TRUE' (vs default):
+> require(graphics)
+> x <- -10:10/10 # [-1, 1]
+> y <- -16:16/16 # [-1, 1] ==> z = fxy := outer(x,y) is also in [-1,1]
+> 
+> p <- persp(x, y, fxy <- outer(x,y), phi = 20, theta = 15, r = 3, ltheta = -75,
++ shade = 0.8, col = "green3", ticktype = "detailed")
+> ## 5 axis-parallel auxiliary lines in x-y and y-z planes :
+> lines(trans3d(-.5 , y=-1:1, z=min(fxy), pmat=p), lty=2)
+> lines(trans3d( 0 , y=-1:1, z=min(fxy), pmat=p), lty=2)
+> lines(trans3d(-1:1, y= -.7, z=min(fxy), pmat=p), lty=2)
+> lines(trans3d( -1, y= -.7, z=c(-1,1) , pmat=p), lty=2)
+> lines(trans3d( -1, y=-1:1, z= -.5 , pmat=p), lty=2)
+> ## 2 pillars to carry the horizontals below:
+> lines(trans3d(-.5 , y= -.7, z=c(-1,-.5), pmat=p), lwd=1.5, col="gray10")
+> lines(trans3d( 0 , y= -.7, z=c(-1,-.5), pmat=p), lwd=1.5, col="gray10")
+> ## now some "horizontal rays" (going from center to very left or very right):
+> doHor <- function(x1, x2, z, CNT=FALSE, ...)
++ lines(trans3d(x=seq(x1, x2, by=0.5), y= -0.7, z = z, pmat = p, continuous = CNT),
++ lwd = 3, type="b", xpd=NA, ...)
+> doHor(-10, 0, z = -0.5, col = 2) # x in [-10, 0] -- to the very left : fine
+> doHor(-.5, 2, z = -0.52,col = 4) # x in [-0.5, 2] only {to the right} --> all fine
+> ## but now, x in [-0.5, 20] -- "too far" ==> "wrap around" problem (without 'continuous=TRUE'):
+> doHor(-.5, 20, z = -0.58, col = "steelblue", lty=2)
+> ## but it is fixed with continuous = CNT = TRUE:
+> doHor(-.5, 20, z = -0.55, CNT=TRUE, col = "skyblue")
+points cut off after point[39]
+> 
 > 
 > 
 > cleanEx()
@@ -4396,7 +4424,7 @@ NULL
 > cleanEx()
 > options(digits = 7L)
 > base::cat("Time elapsed: ", proc.time() - base::get("ptime", pos = 'CheckExEnv'),"\n")
-Time elapsed: 20.995 0.589 21.609 0 0 
+Time elapsed: 38.446 0.619 39.236 0 0 
 > grDevices::dev.off()
 null device 
  1