I have created a 3d sphere with rgl.spheres() using rgl, and plotted two point on the surface of the sphere. Does anyone know how to draw an arc between these two point?
You'll have to calculate points along the arc, and use lines3d to draw the curve. You might want to move the arc a little bit outside
the sphere to avoid problems if they intersect: neither one is really
spherical, so intersections are likely to look ugly.
For example,
r <- 1.3
center <- matrix(1:3, ncol=3)
library(rgl)
open3d()
spheres3d(center, radius = r, col = "white")
# A couple of random points
pts <- matrix(rnorm(6, mean=c(center, center)), ncol = 3)
# Set the radius to 1.001*r
setlen <- function(pt) {
center + 1.001*r*(pt - center)/sqrt(sum((pt - center)^2))
}
pts <- t(apply(pts, 1, setlen))
points3d(pts, col = "black")
# Now draw the arc
n <- 20
frac <- seq(0, 1, len = n)
arc <- matrix(0, ncol = 3, nrow = n)
for (i in seq_along(frac)) {
# First a segment
arc[i,] <- frac[i]*pts[1,] + (1-frac[i])*pts[2,]
# Now set the radius
arc[i,] <- setlen(arc[i,])
}
lines3d(arc, col = "red")
This produces
Edited to add:
The very latest version of rgl (0.100.5, only currently available on R-forge) has a new function arc3d. With that version the code to draw the image can be simplified to
library(rgl)
open3d()
spheres3d(center, radius = r, col = "white")
points3d(pts, col = "black")
arc3d(pts[1,], pts[2,], center, col = "red")
If the points are at different distances from center, it will join them
with an arc from a logarithmic spiral instead of a circular arc.
Related
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
I've found a way to plot 3D bar chart (ggplot2 3D Bar Plot). Thank you #jbaums
However, is there a way to change the bottom facet to a map? So I can clearly visualize, for example, the population density using bar chart on a map to show the differences between different parts? Thank you in advance. plotting 3D bars on top of the map
Here's one way
# Plotting 3D maps using OpenStreetMap and RGL. For info see:
# http://geotheory.co.uk/blog/2013/04/26/plotting-3d-maps-with-rgl/
map3d <- function(map, ...){
if(length(map$tiles)!=1){stop("multiple tiles not implemented") }
nx = map$tiles[[1]]$xres
ny = map$tiles[[1]]$yres
xmin = map$tiles[[1]]$bbox$p1[1]
xmax = map$tiles[[1]]$bbox$p2[1]
ymin = map$tiles[[1]]$bbox$p1[2]
ymax = map$tiles[[1]]$bbox$p2[2]
xc = seq(xmin,xmax,len=ny)
yc = seq(ymin,ymax,len=nx)
colours = matrix(map$tiles[[1]]$colorData,ny,nx)
m = matrix(0,ny,nx)
surface3d(xc,yc,m,col=colours, ...)
return(list(xc=xc, yc=yc, colours=colours))
}
require(rgl)
require(OpenStreetMap)
map <- openproj(openmap(c(52.5227,13.2974),c(52.4329,13.5669), zoom = 10))
set.seed(1)
n <- 30
bbox <- unlist(map$bbox, use.names = F)
x <- do.call(runif, c(list(n), as.list(bbox[c(1,3)])))
y <- do.call(runif, c(list(n), as.list(bbox[c(4,2)])))
z <- runif(n, 0, .1)
m <- rbind(cbind(x,y,z=0), cbind(x,y,z))
m <- m[as.vector(mapply(c, 1:n, (n+1):(2*n))),]
open3d(windowRect=c(100,100,800,600))
coords <- map3d(map, lit=F)
segments3d(m, col="red", add=T)
which gives you something like:
And another way, which you can extend to use box3D to maybe make it more look like your example:
library(plot3D)
with(coords, {
image3D(
z = 0, x = xc, y = yc, colvar = colours, zlim = c(0,max(z)),
scale=F, theta = 0, bty="n")
segments3D(x,y,rep(0,length(x)),x,y,z, col="red", add=T)
})
I have a triangle living in a 3d space, I want to plot only the edges of the triangle in an efficient way, since I will repeat it for a huge number of triangles.
I am able to plot it as a coloured surface using the package rgl:
rgl.open()
vertices = c(
0,0,0,1,
1,1,0,1,
0,0,1,1)
col = "blue"
shade3d( tmesh3d(vertices,indices) , col=col)
bg3d(color = "white")
But what I want is just the 3 lines connecting the points.
What I tried was:
vertices = c(
0,0,0,
1,1,0,
0,0,1)
rgl.lines(x=c(vertices[1],vertices[4]),y=c(vertices[2],vertices[5]),z=c(vertices[3],vertices[6]),col="black")
rgl.lines(x=c(vertices[4],vertices[7]),y=c(vertices[5],vertices[8]),z=c(vertices[6],vertices[9]),col="black")
rgl.lines(x=c(vertices[7],vertices[1]),y=c(vertices[8],vertices[2]),z=c(vertices[9],vertices[3]),col="black")
bg3d(color = "white")
However, this approach is considerably slower than the first one (around 10 times when tried on a real mesh).
I am wondering, is there a way to plot with shade3d the triangles as transparent with only their edges?
You should just be able to something like this:
wire3d( tmesh3d(vertices,indices) , col=col)
works for me.
Example using something I found in the rgl docs:
library(rgl)
# A trefoil knot
open3d()
theta <- seq(0, 2*pi, len = 25)
cen <- cbind( sin(theta) + 2*sin(2*theta),
2*sin(3*theta),
cos(theta) - 2*cos(2*theta) )
e1 <- cbind( cos(theta) + 4*cos(2*theta),
6*cos(3*theta),
sin(theta) + 4*sin(2*theta) )
knot <- cylinder3d( center=cen,e1=e1,radius = 0.8, closed = TRUE)
wire3d(addNormals(subdivision3d(knot, depth = 2)), col = "green")
yields:
where as using:
shade3d(addNormals(subdivision3d(knot, depth = 2)), col = "green")
yields:
i tried something like this a few weeks ago (Stackoverflow question):
library("rgl")
CCl4=c(5,5,5,10)
Luminol=c(0.01,0.001,0.005,0.005)
Na2CO3=c(0.01,0.01,0.1,0.05)
plot3d( Luminol, Na2CO3, CCl4, type = "s")
for(i in 1:4){
for(k in 1:4){
segments3d(x=Luminol[c(i,k)],y=Na2CO3[c(i,k)],z=CCl4[c(i,k)])
}
}
I hope this provide a guide for solving your problem
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]))