Как повысить плавность spheres3d в rgl

Question

Когда я использую rgl::spheres3d(), оказанные сферы имеют неуклюжие ограненные грани.

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)

настройка material3d(smooth = TRUE, line_antialias = TRUE) не улучшить это. Увеличение радиуса тоже не помогает. Есть ли способ повысить плавность, с которой они нарисованы?

Answer 1

Разбираясь с превосходным ответом каракатицы44, я нашел параметризацию, которая работает лучше, то есть не имеет дефектов на полюсах (черный артефакт на светло-голубой сфере на изображении).

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")

Изображение:

Answer 2

Гораздо более простой подход заключается в использовании subdivision3d(), Вот, depth=4 не все так гладко, но вы могли бы увеличить это.

library(rgl)
sphere <- subdivision3d(cube3d(),depth=4)
sphere$vb[4,] <- apply(sphere$vb[1:3,], 2, function(x) sqrt(sum(x^2)))
open3d()
shade3d(sphere, col="red")

Answer 3

Вот мой подход с использованием 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)

Answer 4

Хотя rgl::spheres3d() это невозможно сделать, если вы не отредактируете и не перестроите исходный код rgl, альтернативой является написание собственной функции для рисования сфер. Вот функция, которая отображает сферу как сетку четырехугольников, расположенных на равных широтах и ​​долготе.

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), ...)
}

Это можно улучшить, например, используя икосферы (т. Е. Нарисовав сферу в виде растянутого икосоэдра). Но эта версия уже рисует довольно хорошие сферы, если вы делаете латы и длинные места достаточно высоко.

Пример функции в действии:

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]))

Answer 5

Это не просто; Я думаю, что если вы хотите сделать это, вам придется

• скачать исходный код из CRAN
• распакуйте его и измените строку 24 src/sphereSet.cpp, который в настоящее время

sphereMesh.setGlobe(16,16);

вызвать функцию с некоторыми большими значениями (эта функция определена в строке 25 src/SphereMesh.cpp; аргументы in_segments а также in_sections...)

• собрать / установить пакет из исходного кода; для этого потребуются не только стандартные инструменты компиляции, но и соответствующие библиотеки OpenGL (в ОС Debian Linux вы можете использовать sudo apt-get build-dep r-cran-rgl чтобы получить их, я думаю...)

Я не пробовал это. Удачи... альтернативно, вы можете попросить сопровождающего пакета сделать этот параметр настраиваемым через materials3d или каким-то другим способом...

Answer 6

Другая возможность заключается в использовании vcgSphere функция Rvcg пакет.

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")