I would like to do the following
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")
But the grid is too thin so the border dominates (You can confirm it is indeed the border and not the lighting by using border = NA. It turns to blue):
One way to address this is of course to use not so fine of a grid (for example if you change length = 600 to length= 50 it looks very pleasant, and is actually the example in ?persp). But I want the same shape and smooth exactly as this fine grid. I just don't want to draw all of the borders, maybe only 1/5th of them for example (or half which I assume I can customize).
An issue with plotting the smooth shape and then plotting a grid over top of it is that you can see through the shape to the grid on the other side. To address this, you can start by plotting the course grid on top of a white object, meaning you can't see the back side of the grid, saving the result to a file.
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()
Then, you can plot smoothed image followed by the grid with all white colors fully transparent.
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)
I have got two solutions, but I think both of them are not exactly what you are searching for. I make a line overlay, but it doesn't get overlapped by the surface.
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)
}
Here are two approaches, neither of which are not ideal. You can use NAs to force transparent "lines" onto the surface (Approach 1) or use NAs to get rid of all but the "grid lines" (Approach 2)
Approach 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)
You can then overlay plot above on a solid black surface:
# 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)
Approach 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)
Related
I am trying to plot a function which is dependent on two variables, x and y in a 3D surface plot in r. I get an error message which says that increasing 'x' and 'y' values expected. I am not sure how to arrange the two variables in increasing order which can help produce the plot.
my code:
x <- c(-1, 2, 15, 0, 1, 4, 7, 4, 5, 2)
y <- c(1.5, 3, 7, 2, 1.5, 15, 12, 8, 20, 21)
f <- sqrt(x^2+y^2)
df <- data.frame(x, y, f)
func <- function(x, y){
df$f + (x-x + y-y)}
z <- outer(x, y, func)
persp(x, y, z,
main="Perspective Plot of a function",
zlab = "Height",
theta = 30, phi = 15,
col = "springgreen", shade = 0.5,
ltheta = 120,
ticktype = "detailed")
If you are trying to plot a function of two variables as a surface plot, then you really don't need your two input vectors. You need a regularly spaced grid of input values in both the x and y direction that will cover the range of both inputs:
f <- function(x, y) sqrt(x^2 + y^2)
x <- y <- -1:20
persp(x, y, z = outer(x, y, f),
main="Perspective Plot of a function",
zlab = "Height",
theta = -45, phi = 15,
col = "springgreen", shade = 0.5,
ltheta = 120,
ticktype = "detailed")
I would like to draw a 3D plot of the function z=f(x,y)=x^2+y^2, y>x>0 see the picture
I know the way to do that without the constraint y>x>0 which is easy. could you please help me.
My code for the version without the constraint
fxy <- function(x,y){
return(x^2+y^2)}
x <- seq(-100 ,100, by=5)
y <- seq(-100 ,100, by=5)
z <- outer(x, y, fxy)
persp(x, y, z,
main="3D Plot of x2+y2",
zlab = "Function",
theta = 20, phi = 10,
col = "blue")
I don't know how to do this with the base persp function, but it's possible with rgl.
library(rgl)
fxy <- function(x,y){
return(x^2+y^2)}
x <- seq(-100 ,100, by=5)
y <- seq(-100 ,100, by=5)
z <- outer(x, y, fxy)
# First, draw the full surface:
full <- surface3d(x, y, z,
col = "blue")
# Convert it to a mesh object:
m1 <- as.mesh3d(full)
# Clip to x > 0
m2 <- clipMesh3d(m1, "x", bound = 0, greater = TRUE)
# Clip to y > x
m3 <- clipMesh3d(m2, function(x,y,z) y-x, bound = 0, greater = TRUE)
# Plot it
plot3d(m3)
You can now rotate it to whatever orientation you like.
I'm using persp() to create a 3d plot (but I'm open to anything that will get the job done). Now I want to add a 2d field to make it clear where the 3d plot is above a specific Z value. Is there a way to achieve this? Ideally it would ideally be something like a semi transparent surface where you can see the mass under the surface vs over.
Using the example from the persp documentation
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
x <- seq(-10, 10, length= 30)
y <- x
z <- outer(x, y, f)
z[is.na(z)] <- 1
persp(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue",
ltheta = 120, shade = 0.75, ticktype = "detailed",
xlab = "X", ylab = "Y", zlab = "Sinc( r )"
)
How can I insert a field that slices the graph at a certain point of the z-axis?
How about this - there are a lot more possibilities using the rgl package, but it has a persp3d function for easy upgrade from the base graphics.
library(rgl)
f <- function(x, y) { r <- sqrt(x^2+y^2); 10 * sin(r)/r }
x <- seq(-10, 10, length= 30)
y <- x
z <- outer(x, y, f)
z[is.na(z)] <- 1
persp3d(x, y, z, theta = 30, phi = 30, expand = 0.5, col = "lightblue",
ltheta = 120, shade = 0.75, ticktype = "detailed",
xlab = "X", ylab = "Y", zlab = "Sinc( r )")
# Here we add a transparent purple square to mark the top
# x and y mark the corners of the purple square, z is its height
sqdf <- data.frame(x=c(-10,-10,10,10,-10),
y=c(-10, 10,10,-10,-10),
z=c(5,5,5,5,5))
# now draw the purple square,
# note:
# - the "add=T" parameter that appends it to the previous 3d-plot
# - the coord paramter tells it what two planes to use when
# tesselating the polygon into triangles
# (a necessary step and expensive to calculate)
polygon3d(sqdf$x,sqdf$y,sqdf$z,coord=c(1,2),alpha=0.5,color="purple",add=T)
Yielding:
I'd want to plot a function: f(x,y)=x^2-2*y, with a constraint: x+y=1
in my graph functions overlap , well not seen the restricted function f(x,y). Would appreciate better if x+y-1=0 were transparent.
Mi code in R:
x <- seq(-5, 5, length= 10)
y <- x
fun1<-function(x,y){x^2-2*y}
m <- outer(x, y, fun1)
m[is.na(m)] <- 1
persp(x, y, m, theta = 30, phi = 30,
expand = 0.5, col = "royalblue", ltheta = 120,
shade = 0.75, ticktype = "detailed")
par(new=TRUE)
fun1<-function(x,y){x+y-1}
m <- outer(x, y, fun2)
m[is.na(m)] <- 1
persp(x, y, m, theta = 30, phi = 30,
expand = 0.5, col = "red", ltheta = 120,
shade = 0.75, ticktype = "detailed")
Some overplotting might help. First plot as suggested in comments above. Then de-select the segments where the constraint is violated by assigning NA, i.e. no plotting and overplot with a heavier color. ( I found that unless I froze the z-limits that they "shifted" at the last step. You may need to suppress the z-axis labels, since they are still overlaying each other.)
png(); x <- seq(-5, 5, length= 10)
y <- x
fun1<-function(x,y){x^2-2*y}
m1 <- outer(x, y, fun1)
m1[is.na(m)] <- 1
persp(x, y, m1, theta = 30, phi = 30,
expand = 0.5, col = "#4169E155", ltheta = 120,
shade = 0.75, ticktype = "detailed",zlim=c(-15,35))
par(new=TRUE)
fun2<-function(x,y){x+y-1}
m2 <- outer(x, y, fun2)
m2[is.na(m)] <- 1
persp(x, y, m2, theta = 30, phi = 30,
expand = 0.5, col = adjustcolor("red", alpha.f=0.5), ltheta = 120,
shade = 0.75, ticktype = "detailed",zlim=c(-15,35))
par(new=TRUE)
fun3<-function(x,y){x^2-2*y}
m3 <- outer(x, y, fun3)
m3[ m3 < m2 ] <- NA # <--- logical indexing; this is the key step
persp(x, y, m3, theta = 30, phi = 30,
expand = 0.5, col = "#4169E1", ltheta = 120, # solid-blue
shade = 0.75, ticktype = "detailed",zlim=c(-15,35));dev.off()
I have written a function to calculate the BMI and have the code to create a corresponding graphical output. My goal is to include the graphical output into the function so that I get the plot by just using the function.
My current code:
BMI <- function(meter, kg){
BMI <- kg/(meter^2)
return(BMI)
}
BMI(1.8,70)
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
z <- outer(x, y, FUN = function(x, y) {BMI(x, y)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = 70, v=1.8, col="darkgrey")
points(1.8,70, col="red", cex=2, pch=16, bg="red")
By just modifying the meter & kg in the function I would like to get a diagram with the correct line and point positioning. I started with the code below - however it does not work, yet.
graphicalBMI <- function(meter, kg){
BMI <- kg/(meter^2)
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
z <- outer(x, y, FUN = function(x, y) {graphicalBMI(x, y)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = kg, v= meter, col="darkgrey")
points(meter, kg, col="red", cex=2, pch=16, bg="red")
return(graphicalBMI)
}
The problem of your second function is that it produces an infinite-recursion.
If you change it like this you'll get what you want:
graphicalBMI <- function(meter, kg, showPlot=TRUE){
BMI <- kg/(meter^2)
if(showPlot){
x <- seq(1.5, 1.9, by = 0.001)
y <- seq(30, 200, by = 0.5)
# here we call graphicalBMI by setting showPlot=F to avoid infinite recursion
z <- outer(x, y, FUN = function(x, y) {graphicalBMI(x, y, FALSE)})
contour(x, y, z, nlevels = 10, method = "edge", main = "BMI")
abline(h = kg, v= meter, col="darkgrey")
points(meter, kg, col="red", cex=2, pch=16, bg="red")
}
return(BMI)
}
# usage example:
graphicalBMI(1.8,70) # plot produced
graphicalBMI(1.8,70,FALSE) # no plot produced