When I use rgl::spheres3d()
, the rendered spheres have clunky facetted edges.
spheres = data.frame(x = c(1,2,3), y = c(1,3,1),
color = c("#992222" , "#222299", "#229922"))
open3d()
spheres3d(spheres$x, spheres$y, radius = 1, color = spheres$color)
Setting material3d(smooth = TRUE, line_antialias = TRUE)
does not improve this. Increasing the radius does not help either. Is there any way to increase the smoothness with which they are drawn?
Although rgl::spheres3d()
can't do this, an alternative is to write your own function to draw spheres. Here is a function that renders a sphere as a grid of quadrilaterals spaced at equal degrees of latitude and longitude.
drawSphere = function(xc=0, yc=0, zc=0, r=1, lats=50L, longs=50L, ...) {
#xc,yc,zc give centre of sphere, r is radius, lats/longs for resolution
vertices = vector(mode = "numeric", length = 12L * lats * longs)
vi = 1L
for(i in 1:lats) {
lat0 = pi * (-0.5 + (i - 1) / lats)
z0 = sin(lat0)*r
zr0 = cos(lat0)*r
lat1 = pi * (-0.5 + i / lats)
z1 = sin(lat1)*r
zr1 = cos(lat1)*r
for(j in 1:longs) {
lng1 = 2 * pi * (j - 1) / longs
lng2 = 2 * pi * (j) / longs
x1 = cos(lng1)
y1 = sin(lng1)
x2 = cos(lng2)
y2 = sin(lng2)
vertices[vi] = x1 * zr0 + xc; vi = vi + 1L
vertices[vi] = y1 * zr0 + yc; vi = vi + 1L
vertices[vi] = z0 + zc; vi = vi + 1L
vertices[vi] = x1 * zr1 + xc; vi = vi + 1L
vertices[vi] = y1 * zr1 + yc; vi = vi + 1L
vertices[vi] = z1 + zc; vi = vi + 1L
vertices[vi] = x2 * zr1 + xc; vi = vi + 1L
vertices[vi] = y2 * zr1 + yc; vi = vi + 1L
vertices[vi] = z1 + zc; vi = vi + 1L
vertices[vi] = x2 * zr0 + xc; vi = vi + 1L
vertices[vi] = y2 * zr0 + yc; vi = vi + 1L
vertices[vi] = z0 + zc; vi = vi + 1L
}
}
indices = 1:(length(vertices)/3)
shade3d(qmesh3d(vertices, indices, homogeneous=F), ...)
}
It should be possible to improve on this, for example using icospheres (ie drawing the sphere as a stretched icosohedron). But this version already draws pretty good spheres if you make lats and longs high enough.
An example of the function in action:
spheres = data.frame(x = c(1,2,3), y = c(1,3,1), z=c(0,0,0), color = c("#992222" , "#222299", "#229922"))
open3d()
material3d(ambient = "black", specular = "grey60", emission = "black", shininess = 30.0)
rgl.clear(type = "lights")
rgl.light(theta = -30, phi = 60, viewpoint.rel = TRUE, ambient = "#FFFFFF", diffuse = "#FFFFFF", specular = "#FFFFFF", x = NULL, y = NULL, z = NULL)
rgl.light(theta = -0, phi = 0, viewpoint.rel = TRUE, diffuse = "gray20", specular = "gray25", ambient = "gray80", x = NULL, y = NULL, z = NULL)
sapply(1:NROW(spheres), function(i)
drawSphere(spheres$x[i], spheres$y[i], spheres$z[i], r=1, lats = 400, longs = 400, color=spheres$color[i]))
It's not easy; I think if you want to do this you're going to have to
src/sphereSet.cpp
, which is currently sphereMesh.setGlobe(16,16);
to call the function with some larger values (this function is defined on line 25 of src/SphereMesh.cpp
; the arguments are in_segments
and in_sections
...)
sudo apt-get build-dep r-cran-rgl
to get them, I think ...) I haven't tried this. Good luck ... alternately, you could ask the package maintainer to make this a settable parameter via materials3d
or in some other way ...
Here is my approach using persp3d.function()
sphere.f <- function(x0 = 0, y0 = 0, z0 = 0, r = 1, n = 101, ...){
f <- function(s, t) cbind(r * cos(s) * cos(t) + x0,
r * sin(s) * cos(t) + y0,
r * sin(t) + z0)
persp3d(f, slim = c(0, pi), tlim = c(0, 2*pi), n = n, add = T, ...)
}
sphere.f(col = rainbow)
Expanding on cuttlefish44's excellent answer , I found a parameterization that works better - ie it has no defect at the poles (the black artifact on the lightblue sphere in the image).
library(rgl)
sphere.f <- function(x0 = 0, y0 = 0, z0 = 0, r = 1, n = 101, ...){
f <- function(s, t) cbind(r * cos(s) * cos(t) + x0,
r * sin(s) * cos(t) + y0,
r * sin(t) + z0)
persp3d(f, slim = c(0, pi), tlim = c(0, 2*pi), n = n, add = T, ...)
}
sphere1.f <- function(x0 = 0, y0 = 0, z0 = 0, r = 1, n = 101, ...){
f <- function(s,t){
cbind( r * cos(t)*cos(s) + x0,
r * sin(s) + y0,
r * sin(t)*cos(s) + z0)
}
persp3d(f, slim = c(-pi/2,pi/2), tlim = c(0, 2*pi), n = n, add = T, ...)
}
sphere.f( -1.5,0, col = "lightblue")
sphere1.f( 1.5,0, col = "pink")
The image:
Another possibility is to use the vcgSphere
function of the Rvcg
package.
library(Rvcg)
sphr <- vcgSphere(subdivision = 4) # unit sphere centered at (0,0,0)
library(rgl)
shade3d(sphr, color="red")
# sphere with given radius and center
radius <- 0.5
center <- c(2,1,1)
sphr2 <- translate3d(
scale3d(sphr, radius, radius, radius),
center[1], center[2], center[3])
shade3d(sphr2, color="green")
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.