R/args3d.R In p3d: Plot 3d data and fitted surfaces

```##
## p3d:args3d.R
## 2011-12-22
##

args3d <-   # remove this version is the next one works
function(...) {
help <- "

- returns a list with a matrix, x with xyz values and with other args
- can specify 'min', 'max', 'mid' as values not mixed with numerical
values
CAUTION: If first argument is positional then variables
must be in order x,y,z
"
na2f <- function( x ) {
x[is.na(x)] <- FALSE
x
}
args <- list(...)
#disp(args)
getdim <- function(nam, args){
pos <- regexpr(nam, names(args))
#disp(nam)
#disp(pos)
arg.ind <- pos > 0
#disp(arg.ind)
if( length(pos <- pos [ pos > 0 ])==0) return(0)
#disp( args[arg.ind] )
#disp(cbind( args[arg.ind][[1]]))
#disp(pos)

#disp(cbind( args[arg.ind][[1]])[,pos])
cbind( args[arg.ind][[1]])[,pos]
}

if( is.null(names(args))) names(args) <- rep("",length(args) )
nn <- names(args)
#disp(nn)
if ( (length(nn) >2) && all( nn[1:3] =="")) names(args) [1:3] <- c('x','y','z')
nn <- names(args)
if ( (length(nn) > 0) && (nn[1] == "") ){
names(args)[1] <- 'xyz'
args[[1]] = rbind( args[[1]])
}
nn <- names(args)
#disp(nn)
nxyz <- sapply( nn, regexpr, "xyzyxzxzyyzxzxyzyz")
#disp(nxyz)

xyzs <- args[nxyz > 0]
#disp(xyzs)
oargs <- args[nxyz < 0]
#disp(oargs)
xyz <- cbind( x=getdim('x', xyzs), y=getdim('y',xyzs), z=getdim('z',xyzs))
if ( is.character(xyz) ) {
bbox <- par3d('bbox')
mins <- matrix(bbox[c(1,3,5)], nrow = nrow(xyz), ncol=3, byrow = TRUE)
maxs <- matrix(bbox[1+c(1,3,5)], nrow = nrow(xyz), ncol=3, byrow = TRUE)
mids <- (mins + maxs)/2
xyz[na2f(xyz=='min')] <- mins[na2f(xyz=='min')]
xyz[na2f(xyz=='max')] <- maxs[na2f(xyz=='max')]
xyz[na2f(xyz=='mid')] <- mids[na2f(xyz=='mid')]
mode(xyz) <- "numeric"
}
a <- list(x = xyz)
#disp(c(a,oargs))
c(a,oargs)
}

# Following is changed so
# 1) keeps unnamed arguments
# 2) changes 'col' to 'color'

args3d <-
function (...)
{
na2f <- function(x) {
x[is.na(x)] <- FALSE
x
}
args <- list(...)
#disp(args)
getdim <- function(nam, args) {
pos <- regexpr(nam, names(args))
arg.ind <- pos > 0
if (length(pos <- pos[pos > 0]) == 0)
return(0)
cbind(args[arg.ind][[1]])[, pos]
}
if (is.null(names(args)))
names(args) <- rep("", length(args))
nn <- names(args)
if ((length(nn) > 2) && all(nn[1:3] == ""))
names(args)[1:3] <- c("x", "y", "z")
nn <- names(args)
if ((length(nn) > 0) && (nn[1] == "")) {
names(args)[1] <- "xyz"
args[[1]] = rbind(args[[1]])
}
#disp(args)
nn <- names(args)
#disp(nn)
nxyz <- sapply(nn, regexpr, "xyzyxzxzyyzxzxyzyz")
nxyz[nn==""]<--1
#disp(nxyz)
xyzs <- args[nxyz > 0]
oargs <- args[nxyz < 0]
xyz <- cbind(x = getdim("x", xyzs), y = getdim("y", xyzs),
z = getdim("z", xyzs))
if (is.character(xyz)) {
bbox <- par3d("bbox")
mins <- matrix(bbox[c(1, 3, 5)], nrow = nrow(xyz), ncol = 3,
byrow = TRUE)
maxs <- matrix(bbox[1 + c(1, 3, 5)], nrow = nrow(xyz),
ncol = 3, byrow = TRUE)
mids <- (mins + maxs)/2
xyz[na2f(xyz == "min")] <- mins[na2f(xyz == "min")]
xyz[na2f(xyz == "max")] <- maxs[na2f(xyz == "max")]
xyz[na2f(xyz == "mid")] <- mids[na2f(xyz == "mid")]
mode(xyz) <- "numeric"
}
a <- list(x = xyz)
ret <- c(a, oargs)
names(ret) <- sub("^col\$","color",names(ret))
# warning("Using an experimental version of args3d that changes argname from 'col' to 'color'")
ret
}
```

Try the p3d package in your browser

Any scripts or data that you put into this service are public.

p3d documentation built on May 2, 2019, 5:25 p.m.