richard — Apr 10, 2014, 2:04 PM
library(lattice)
alpha <- seq(from = 0, to = 180, length = 20)
beta <- alpha
surfQ <- expand.grid(x = alpha, y = beta)
surfQ$z <- with(surfQ, {-cos((x-y)*pi/180)})
surfQ$key <- 0
head(surfQ)
x y z key
1 0.000 0 -1.0000 0
2 9.474 0 -0.9864 0
3 18.947 0 -0.9458 0
4 28.421 0 -0.8795 0
5 37.895 0 -0.7891 0
6 47.368 0 -0.6773 0
tail(surfQ)
x y z key
395 132.6 180 -0.6773 0
396 142.1 180 -0.7891 0
397 151.6 180 -0.8795 0
398 161.1 180 -0.9458 0
399 170.5 180 -0.9864 0
400 180.0 180 -1.0000 0
nrow(surfQ)
[1] 400
alphaE <- c(0, 90)
betaE <- c(45, 135)
ptsQ <- expand.grid(x = alphaE, y = betaE)
ptsQ$z <- with(ptsQ, {-cos((x-y)*pi/180)})
ptsQ
x y z
1 0 45 -0.7071
2 90 45 -0.7071
3 0 135 0.7071
4 90 135 -0.7071
ptsC <- ptsQ
ptsC$z <- with(ptsC, {- 1 + 2 * abs((x-y)/180)})
ptsC
x y z
1 0 45 -0.5
2 90 45 -0.5
3 0 135 0.5
4 90 135 -0.5
pts <- rbind(ptsQ, ptsC)
pts$key <- c(rep(1, 4), rep(2, 4))
pts
x y z key
1 0 45 -0.7071 1
2 90 45 -0.7071 1
3 0 135 0.7071 1
4 90 135 -0.7071 1
5 0 45 -0.5000 2
6 90 45 -0.5000 2
7 0 135 0.5000 2
8 90 135 -0.5000 2
wireframe(z ~ x * y, surfQ, aspect = c(1, .5),
main = "Quantum surface (blue), quantum points (blue), classical points (red)",
par.settings = simpleTheme(col=c("blue", "red"),
pch=c(13,3,16), cex=2, lwd=1),
scales = list(arrows = FALSE),
pts = pts,
groups = surfQ$key,
panel.3d.wireframe =
function(x, y, z,
xlim, ylim, zlim,
xlim.scaled, ylim.scaled, zlim.scaled,
pts,
...) {
panel.3dwire(x = x, y = y, z = z,
xlim = xlim,
ylim = ylim,
zlim = zlim,
xlim.scaled = xlim.scaled,
ylim.scaled = ylim.scaled,
zlim.scaled = zlim.scaled,
col = "blue",
...)
xx <-
xlim.scaled[1] + diff(xlim.scaled) *
(pts$x - xlim[1]) / diff(xlim)
yy <-
ylim.scaled[1] + diff(ylim.scaled) *
(pts$y - ylim[1]) / diff(ylim)
zz <-
zlim.scaled[1] + diff(zlim.scaled) *
(pts$z - zlim[1]) / diff(zlim)
panel.3dscatter(x = xx,
y = yy,
z = zz,
xlim = xlim,
ylim = ylim,
zlim = zlim,
xlim.scaled = xlim.scaled,
ylim.scaled = ylim.scaled,
zlim.scaled = zlim.scaled,
groups = pts$key,
...)
})
## and now the classical LHV model
surfC <- surfQ
surfC$z <- with(surfC, {- 1 + 2 * abs((x-y)/180)})
wireframe(z ~ x * y, surfC, aspect = c(1, .5),
main = "Classical surface (red), classical points (red), quantum points (blue)",
par.settings = simpleTheme(col=c("blue", "red"),
pch=c(13,3,16), cex=2, lwd=1),
scales = list(arrows = FALSE),
pts = pts,
groups = surfC$key,
panel.3d.wireframe =
function(x, y, z,
xlim, ylim, zlim,
xlim.scaled, ylim.scaled, zlim.scaled,
pts,
...) {
panel.3dwire(x = x, y = y, z = z,
xlim = xlim,
ylim = ylim,
zlim = zlim,
xlim.scaled = xlim.scaled,
ylim.scaled = ylim.scaled,
zlim.scaled = zlim.scaled,
col = "red",
...)
xx <-
xlim.scaled[1] + diff(xlim.scaled) *
(pts$x - xlim[1]) / diff(xlim)
yy <-
ylim.scaled[1] + diff(ylim.scaled) *
(pts$y - ylim[1]) / diff(ylim)
zz <-
zlim.scaled[1] + diff(zlim.scaled) *
(pts$z - zlim[1]) / diff(zlim)
panel.3dscatter(x = xx,
y = yy,
z = zz,
xlim = xlim,
ylim = ylim,
zlim = zlim,
xlim.scaled = xlim.scaled,
ylim.scaled = ylim.scaled,
zlim.scaled = zlim.scaled,
groups = pts$key,
...)
})
