Jak mieć tylko co drugi brzeg w persp

Question

Chciałbym wykonaj następujące czynności

set.seed(1) 
x <- seq(-10, 10, length= 600) 
y <- x 
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r } 
z <- outer(x, y, f) 
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue") 

Ale siatka jest zbyt cienkie, więc dominuje granicy (można go potwierdzić jest rzeczywiście granica i nie oświetlenie za pomocą border = NA okazuje się niebieski).

Jednym ze sposobów rozwiązania tego jest oczywiście użyć, nie tak dobrze z siatki (na przykład w przypadku zmiany length = 600 do length= 50 wygląda bardzo zarzuty mrówka i faktycznie jest przykładem w perspekcie). Ale chcę ten sam kształt i gładkość dokładnie tak, jak ta drobna siatka. Po prostu nie chcę narysować wszystkich granic, może tylko 1/5 z nich na przykład (lub pół, który zakładam, że mogę dostosować).

Answer 1

Problem z wykreślając gładki kształt, a następnie kreślenia siatki nad górnej części jest to, że widać przez kształtem do sieci po drugiej stronie. Aby rozwiązać ten problem, możesz rozpocząć od wykreślenia siatki przebiegu na wierzchu białego obiektu, co oznacza, że ​​nie widzisz tylnej strony siatki, zapisując wynik w pliku.

x <- seq(-10, 10, length=50) 
y <- x 
z <- outer(x, y, f) 
png("top.png") 
print(persp(x, y, z, theta = 30, phi = 30, expand = 0.5, border="black", col="white")) 
dev.off() 

Następnie można wykreślić wygładzony obraz następnie siatce z białych kolorach całkowicie przejrzyste.

x <- seq(-10, 10, length= 600) 
y <- x 
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r } 
z <- outer(x, y, f) 
png("bottom.png") 
print(persp(x, y, z, theta = 30, phi = 30, expand = 0.5, border="lightblue", col="lightblue")) 
dev.off() 

par(oma=c(0, 0, 0, 0), mar=c(0, 0, 0, 0)) 
library(png) 
top.img <- readPNG("top.png") 
top.img[,,4][top.img[,,1] + top.img[,,2] + top.img[,,3] > 2] <- 0 

plot.new() 
rasterImage(bottom.img, 0, 0, 1, 1) 
rasterImage(top.img, 0, 0, 1, 1) 

Answer 2

Mam dwa rozwiązania, ale uważam, że oba nie są dokładnie tym, czego szukasz. Tworzę nakładkę liniową, ale nie nakłada się ona na powierzchnię.

set.seed(1) 
x <- seq(-10, 10, length= 600) 
y <- x 
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r } 
z <- outer(x, y, f) 
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA, shade=0.75, ticktype = "detailed") 

par(new=T) 

set.seed(1) 
x <- seq(-10, 10, length=20) 
y <- x 
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r } 
z <- outer(x, y, f) 
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = NA, border="green") 

set.seed(1) 
x <- seq(-10, 10, length= 600) 
y <- x 
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r } 
z <- outer(x, y, f) 
res <- persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA, shade=0.75, ticktype = "detailed") 

library(grDevices) 
xlines <- seq(1, length(x), length.out=20) 
for(line in xlines){ 
    lines (trans3d(x=x[line], y = y, z = z[line, ], pmat = res), col = 3, lwd=2) 
} 

ylines <- seq(1, length(y), length.out=20) 
for(line in ylines){ 
    lines (trans3d(x=x, y = y[line], z = z[,line], pmat = res), col = 3, lwd=2) 
} 

Answer 3

Oto dwa sposoby, z których żadna nie są idealne. Można użyć NAS wymusić przejrzyste „linie” na powierzchni (metoda 1) lub użyć NAS, aby pozbyć się wszystkich ale „linii siatki” (Sposób 2)

Podejście 1:

z2 <- z 
lin.seq<- seq(10, 600, 10) 
z2[lin.seq,] <- NA 
z2[,lin.seq] <- NA 
persp(x, y, z2, theta = 30, phi = 30, expand = 0.5, 
     border=NA, col="lightblue", box=TRUE) 

można wtedy nakładki działka powyżej na stałe czarnym powierzchni:

# using original example data 
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "black", border=NA) 

par(new=TRUE) 
z2 <- z 
lin.seq<- seq(10, 600, 10) 
z2[lin.seq,] <- NA 
z2[,lin.seq] <- NA 
persp(x, y, z2, theta = 30, phi = 30, expand = 0.5, 
     border=NA, col="lightblue", box=FALSE) 

Podejście 2:

# using original example data 
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue", border=NA) 

z3 <- matrix(ncol=600, nrow=600)    # NA matrix 
lin.seq <- seq(25, 600, 25)     # spacing of "grid lines" 
lin.seq <- c(lin.seq, lin.seq-1, lin.seq-2) # to make lines a bit thicker 

# replace some NAs on "grid lines" with values from z.  
z3[lin.seq,] <- z[lin.seq,] 
z3[,lin.seq] <- z[,lin.seq] 

par(new=TRUE) 
persp(x, y, z3, theta = 30, phi = 30, expand = 0.5, 
     border=NA, col="black", box=FALSE)