I would like to plot two planes in a 3D plot. I have tried persp3d and it generates two planes. But instead of the whole two planes, I just want to show parts of them divided by the intersection line, i.e, "left" part of the blue plane, and "upper" part of the red plane. I tried xlim, ylim, but it seems my lims are not single values, but functions.
library(rgl)
x <- seq(-10, 10, length = 30)
y <- x
region = expand.grid(x=x, y=y)
z1 = region$x+2*region$y + 2
z2=3*region$x+region$y
persp3d(x,y,z1,col="steelblue")
persp3d(x,y,z2,col="red",add=TRUE)
grid = mesh(x,y)
z = with(grid,ifelse(x+2*y>3*x+y,x+2*y,3*x+y))
persp3D(z = z, x = x, y = y,col = NULL)
for (i in 1:900){
z[i] = ifelse(region$x[i]+2*region$y[i] + 2 >
3*region$x[i]+region$y[i],region$x[i]+2*region$y[i] + 2,3*region$x[i]+region$y[i])}
persp3d(x,y,z,col="steelblue")
This is inspired by Huang Rui's suggestion
Related
I have a plot where I draw arrows from points to points. I would like to put this arrow heads not to the end of the line, but to middle. Is there a simple way to do it other than placing extra arrows with half length of the according line?
My code is this:
plot(x, y, xlim=range(x), ylim=range(y), xlab="x", ylab="y", pch=16,
main="Filled Plane")
for(i in 1:20){
arrows(x[i], y[i], x[i+1], y[i+1], length = 0.25, angle = 30, col = i)
}
Make a custom function myArrow() and add one new argument cut to control the proportion of the arrows
myArrow <- function(x0, y0, x1, y1, cut = 1, ...){
x.new <- (1 - cut) * x0 + cut * x1
y.new <- (1 - cut) * y0 + cut * y1
# segments(x0, y0, x1, y1, ...)
arrows(x0, y0, x.new, y.new, ...)
}
Note1 : The computation of x.new and y.new in this custom function uses a simple mathematical concept, i.e. the Section Formula. The value of cut must be between 0 to 1.
Note2 : The use of this function is equivalent to that of the original functionarrows() other than that it has one more new argument cut.
Note3 : If you want complete lines behind the arrows, just remove the hash(#) in the function.
Plot and try different cut value. For example, I use cut = 0.7. (If you want the arrowheads to the middle, use cut = 0.5.)
# Toy Data
x <- seq(1, 5.5, by = 0.5)
y <- rep(c(1, 5), 5)
plot(x, y, pch = 16)
for(i in 1:9){
myArrow(x[i], y[i], x[i+1], y[i+1], cut = 0.7, col = i, lwd = 2)
}
Since you do not provide your x and y, I made up some data. There is no need for the loop. arrows will handle a vector of coordinates. One way is to draw a full-length arrow with no arrowhead and another that just goes halfway but has the arrowhead.
## Some bogus data
set.seed(123)
x = runif(4)
y = runif(4)
## Compute the midpoints
midx = diff(x)/2 + x[-length(x)]
midy = diff(y)/2 + y[-length(y)]
## Draw it
plot(x,y,xlim=range(x), ylim=range(y), xlab="x", ylab="y",
main="Filled Plane",pch=16)
arrows(x[-length(x)], y[-length(y)],x[-1],y[-1],
angle = 0, col = 1:3)
arrows(x[-length(x)], y[-length(y)],midx,midy,
length = 0.25, angle = 30, col = 1:3)
So I have this code that produces the exact surface
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
plot3d(f, col = colorRampPalette(c("blue", "white")),
xlab = "X", ylab = "Y", zlab = "Z",
xlim = c(-3, 3), ylim = c(-3, 3),
aspect = c(1, 1, 0.5))
Giving the following plot:
Now I have some code that does a random walk metropolis algorithm to reproduce the above image. I think it works as if I do another plot of these calculated values I get the next image with 500 points. Here is the code
open3d()
plot3d(x0, y0, f(x0, y0), type = "p")
Which gives the following plot:
I know it's hard looking at this still image but being able to rotate the sampling is working.
Now here is my question: How can I use plot3d() so that I can have a surface that connects all these points and gives a more jagged representation of the exact plot? Or how can I have each point in the z axis as a bar from the xy plane? I just want something more 3 dimensional than points and I can't find how to do this.
Thanks for your help
You can do this by triangulating the surface. You don't give us your actual data, but I can create some similar data using
f = function(x, y){
z = ((x^2)+(3*y^2))*exp(-(x^2)-(y^2))
}
x <- runif(500, -3, 3)
y <- runif(500, -3, 3)
z <- f(x, y)
Then the plotting is done using the method in ?persp3d.deldir:
library(deldir)
library(rgl)
col <- colorRampPalette(c("blue", "white"))(20)[1 + round(19*(z - min(z))/diff(range(z)))]
dxyz <- deldir::deldir(x, y, z = z, suppressMsge = TRUE)
persp3d(dxyz, col = col, front = "lines", back = "lines")
This might need some cosmetic fixes, e.g.
aspect3d(2, 2, 1)
After some rotation, this gives me the following plot:
I'm not sure to understand what you want. If my understanding is correct, here is a solution. Define a parametric representation of your surface:
fx <- function(u,v) u
fy <- function(u,v) v
fz <- function(u,v){
((u^2)+(3*v^2))*exp(-(u^2)-(v^2))
}
Let's say you have these points:
x0 <- seq(-3, 3, length.out = 20)
y0 <- seq(-3, 3, length.out = 20)
Then you can use the function parametric3d of the misc3d package, with the option fill=FALSE to get a wireframe:
library(misc3d)
parametric3d(fx, fy, fz, u=x0, v=y0,
color="blue", fill = FALSE)
Is it what you want?
To get some vertical bars, use the function segments3d of rgl:
i <- 8
bar <- rbind(c(x0[i],y0[i],0),c(x0[i],y0[i],f(x0[i],y0[i])))
segments3d(bar, color="red")
Here is a plot with only 50 points using my original code.
When I then apply what was said by Stéphane Laurent I then get this plot which feels too accurate when given the actual points I have
Perhaps you need to explain to me what is actually happening in the function parametric3d
In the above image the surface colored in z axis (like heat map). I am using plot3d()
plot3d(data$x, data$y, data$z, name = 'Plotly3D graph', type = 'l', axes=F)
I have to repeat the same color as of in the image. By using above code I can get the 3D square but I dont know where to set the color of z axis as same as the image. Please help me in plot3D. If full code is needed will post if required.
Here is sample code:
data1 <- read.csv(file.choose(),1)
# retrieve age column from csv file
var1 <- data1$age
z1 <- rep(1, times=length(var1))
plot3d(var1, length(var1), z1, type="l", xaxt='n', yaxt='n', xlab="Jitter in
ns", ylab="Counts", size=0.05,expand=0.75, col=color[zcol],
ticktype="detailed", zlab="")
Here's one version, using a function from one of the answers to How do I generate a mapping from numbers to colors in R?.
# A function based on Dave X's answer to the colour mapping question
map2color <- function(x, pal, limits = range(x)){
pal[findInterval(x, seq(limits[1], limits[2], length.out = length(pal) + 1),
all.inside=TRUE)]
}
persp3d(volcano, col = map2color(volcano, rainbow(100)))
This produces this image:
To produce solid edges ("curtains" in plot3D), just surround the data with extra rows and columns of its minimum value. For example,
m <- min(volcano)
volcano2 <- cbind(m, rbind(m, volcano, m), m)
To make the edges look flat, you need to add x and y values, just a tiny bit outside the original ones:
x <- c(0.9999, 1:nrow(volcano), nrow(volcano) + 0.0001)
y <- c(0.9999, 1:ncol(volcano), ncol(volcano) + 0.0001)
persp3d(x, y, volcano2, col = map2color(volcano2, heat.colors(100)))
I switched the palette to heat.colors just for some variety.
I am new to R environment. I have generated a simulated time lapse plot using the following code.
seq_x<-seq(1,10)
seq_y<-function(y)
{
z<-y^2+y+1
return (c(z))
}
yrange<-seq_y(1)
yrange[2]<-seq_y(length(seq_x))
for(i in 1:length(seq_x) )
{
xdata<-seq_x[1:i]
ydata<-seq_y(xdata)
plot(xdata,ydata,xlim=range(seq_x),ylim=range(yrange),type="o",col="royalblue",plot.first=grid())
Sys.sleep(1)
}
I get the following plot(after the final iteration).
Now I need to plot a straight line and a circle right across the plot as shown below.
The straight line should grow with the data sequence. The circle should be at the center of the data sequence with user specified radius. Any advice in this regard will be highly appreciated.
Try this:
#draw circle
require(plotrix)
userRadius <- 1
draw.circle(median(xdata), median(ydata), userRadius)
#draw line
segments(x0=xdata[1],y0=ydata[1],
x1=xdata[length(xdata)],y1=ydata[length(ydata)])
You can use lines to add additional lines to your plot. Then you just have to calculate the points on the circle (or ellipsis) and you can draw both the extra line and the circle.
# data
x <- seq(1,10)
y <- x^2 + x + 1
# function to calculate points on the ellipsis
ellipsis_fct <- function(mx, my, rx, ry){
phi <- seq(0, 2*pi, length = 100) # change length if you need better resolution
data.frame(x = mx + rx*sin(phi),
y = my + ry*cos(phi))
}
# actually calculate the points.
circ <- ellipsis_fct(mean(range(x)), mean(range(y)), diff(range(x))/5, diff(range(y))/5)
# plotting commands
plot(x, y, xlim=range(x), ylim=range(y), type="o", col="royalblue", plot.first=grid())
lines(range(x), range(y), col = "darkred", lty = "dashed")
lines(circ, col = "orange")
I want to plot a matrix of z values with x rows and y columns as a surface similar to this graph from MATLAB.
Surface plot:
Code to generate matrix:
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 0.240)# 2013 length
y<-seq(from = -241.440, to = 241.440, by = 0.240)
matrix_fun<-matrix(data = 0, nrow = length(x), ncol = length(y))
# Generate two dimensional travel distance probability density function
for (i in 1:length(x)) {
for (j in 1:length(y)){
dxy<-sqrt(x[i]^2+y[j]^2)
prob<-1/(scale^(shape)*gamma(shape))*dxy^(shape-1)*exp(-(dxy/scale))
matrix_fun[i,j]<-prob
}}
# Rescale 2-d pdf to sum to 1
a<-sum(matrix_fun)
matrix_scale<-matrix_fun/a
I am able to generate surface plots using a couple methods (persp(), persp3d(), surface3d()) but the colors aren't displaying the z values (the probabilities held within the matrix). The z values only seem to display as heights not as differentiated colors as in the MATLAB figure.
Example of graph code and graphs:
library(rgl)
persp3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
surface3d(x=x, y=y, z=matrix_scale, color=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)))
persp(x=x, y=y, z=matrix_scale, theta=30, phi=30, col=rainbow(25, start=min(matrix_scale), end=max(matrix_scale)), border=NA)
Image of the last graph
Any other tips to recreate the image in R would be most appreciated (i.e. legend bar, axis tick marks, etc.)
So here's a ggplot solution which seems to come a little bit closer to the MATLAB plot
# Parameters
shape<-1.849241
scale<-38.87986
x<-seq(from = -241.440, to = 241.440, by = 2.40)
y<-seq(from = -241.440, to = 241.440, by = 2.40)
df <- expand.grid(x=x,y=y)
df$dxy <- with(df,sqrt(x^2+y^2))
df$prob <- dgamma(df$dxy,shape=shape,scale=scale)
df$prob <- df$prob/sum(df$prob)
library(ggplot2)
library(colorRamps) # for matlab.like(...)
library(scales) # for labels=scientific
ggplot(df, aes(x,y))+
geom_tile(aes(fill=prob))+
scale_fill_gradientn(colours=matlab.like(10), labels=scientific)
BTW: You can generate your data frame of probabilities much more efficiently using the built-in dgamma(...) function, rather than calculating it yourself.
In line with alexis_laz's comment, here is an example using filled.contour. You might want to increase your by to 2.40 since the finer granularity increases the time it takes to generate the plot by a lot but doesn't improve quality.
filled.contour(x = x, y = y, z = matrix_scale, color = terrain.colors)
# terrain.colors is in the base grDevices package
If you want something closer to your color scheme above, you can fiddle with the rainbow function:
filled.contour(x = x, y = y, z = matrix_scale,
color = (function(n, ...) rep(rev(rainbow(n/2, ...)[1:9]), each = 3)))
Finer granularity:
filled.contour(x = x, y = y, z = matrix_scale, nlevels = 150,
color = (function(n, ...)
rev(rep(rainbow(50, start = 0, end = 0.75, ...), each = 3))[5:150]))