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
|
image3d <- function (v, x = 1:dim(v)[1], y = 1:dim(v)[2], z = 1:dim(v)[3],
vlim = quantile(v, c(.9, 1),na.rm=TRUE),
col = heat.colors(256),
alpha.power = 2,
alpha = ((1:length(col))/ length(col))^alpha.power,
breaks,sprites = TRUE, jitter = FALSE,
radius = min(diff(x), diff(y), diff(z)),
add = FALSE,...)
{
loadRGL()
if (!is.array(v) && length(dim(v)) != 3)
stop("'v' must be a 3D array")
nx <- dim(v)[1]
ny <- dim(v)[2]
nz <- dim(v)[3]
if (length(x) != nx || length(y) != ny || length(z) != nz)
stop("dimensions of v do not match x, y, or z")
if (missing(breaks)) {
nc <- length(col)
if (any(!is.finite(vlim)) || diff(vlim) < 0)
stop("invalid v limits")
if (diff(vlim) == 0)
vlim <- if (vlim[1] == 0)
c(-1, 1)
else vlim[1] + c(-0.4, 0.4) * abs(vlim[1])
v <- (v - vlim[1])/diff(vlim)
vi <- floor((nc - 1e-05) * v + 1e-07)
vi[vi < 0 | vi >= nc] <- NA
if (length(alpha) == 1)
alpha <- rep(alpha, nc)
else if (length(alpha) != nc)
stop("number of colors and alpha levels must be identical")
}
else {
if (length(breaks) != length(col) + 1)
stop("must have one more break than colour")
if (length(breaks) != length(alpha) + 1)
stop("must have one more break than alpha levels")
if (any(!is.finite(breaks)))
stop("breaks must all be finite")
vi <- .C("bincode", as.double(v), length(v), as.double(breaks),
length(breaks), code = integer(length(v)), as.logical(TRUE),
as.logical(TRUE), nok = TRUE, NAOK = TRUE, DUP = FALSE,
PACKAGE = "base")$code - 1
}
if (!add)
rgl.clear()
i <- which(is.finite(vi))
xi <- x[as.integer((i - 1) %% nx + 1)]
yi <- y[as.integer(((i - 1) %/% nx) %% ny + 1)]
zi <- z[as.integer((i - 1) %/% (nx * ny) + 1)]
vi <- vi[i] + 1
if (jitter) {
ni <- length(i)
xi <- xi + runif(ni, max = min(diff(x)))
yi <- yi + runif(ni, max = min(diff(y)))
zi <- zi + runif(ni, max = min(diff(z)))
}
if (sprites) {
texture <- system.file("textures/particle.png", package="rgl")
rgl.sprites(xi, zi, -yi, color = col[vi], alpha = alpha[vi],
lit=FALSE, radius = radius, textype="alpha",
texture = texture, ...)
}
else rgl.points(xi, zi, -yi, color = col[vi], alpha = alpha[vi], ...)
}
|
