用rgl在球上填充一个区域

huangapple go评论103阅读模式
英文:

Filling a region on a sphere with rgl

问题

这是世界首都的球面Voronoï镶嵌图:

用rgl在球上填充一个区域

我有定义每个国家边界的点的坐标。我想用颜色填充这些国家。动机是用与海洋相同的颜色绘制Voronoï边缘,这样我们在国家外部就看不到它们了。换句话说,我正在寻找一个类似于 polygon 函数但用于球面多边形的函数。


编辑

好的,我现在明白了。但出于某种原因,水的青色和Voronoï边缘的青色不同:

用rgl在球上填充一个区域

英文:

Here is the spherical Voronoï tessellation of the world capitals:

用rgl在球上填充一个区域

I have the coordinates of the points defining the boundary of each country. I'd like to fill the countries with a color. The motivation is to plot the Voronoï edges with the same color as the seas/oceans so that we will not see them outside the countries. In other words, I'm looking for a function similar to the polygon function but for spherical polygons.


Edit

Well, I get it now. But for some reason, the cyan color of the water and the cyan color of the Voronoï edges are different:

用rgl在球上填充一个区域

答案1

得分: 1

以下是代码的翻译部分:

  1. # 载入地图库和数据
  2. library(maps)
  3. data(worldMapEnv)
  4. # 创建一个填充国家的二维世界地图的PNG图像
  5. world <- map("world", plot = FALSE, fill = TRUE, wrap = c(0, 360))
  6. png("world2D.png", width = 1024L, height = 1024L)
  7. opar <- par(mar = c(0, 0, 0, 0))
  8. plot(world$x, world$y, type = "n", xlab = NA, ylab = NA, axes = FALSE,
  9. xaxs = "i", yaxs = "i", xlim = c(0, 360), ylim = c(-90, 90))
  10. polygon(world$x, world$y, col="orangered", lwd = 2)
  11. par(opar)
  12. dev.off()
  1. # 使用球面坐标创建单位球体的网格
  2. library(cgalMeshes)
  3. sphericalCoordinates <- function(θ, ϕ){
  4. x <- cos(θ) * sin(ϕ)
  5. y <- sin(θ) * sin(ϕ)
  6. z <- cos(ϕ)
  7. rbind(x, y, z)
  8. }
  9. rmesh <- parametricMesh(
  10. sphericalCoordinates, urange = c(0, 2*pi), vrange = c(0, pi),
  11. periodic = c(TRUE, TRUE), nu = 1024L, nv = 1024L
  12. )
  13. rmesh$normals <- rmesh$vb[-4L, ]
  14. # 获取网格顶点的角度θ和ϕ
  15. UV <- cooltools::car2sph(t(rmesh$vb[-4L, ]))
  16. UV <- cbind(UV[, 3L], UV[, 2L])
  17. # 现在加载PNG图像
  18. library(imager)
  19. img <- load.image("world2D.png")
  20. # 获取r、g、b通道
  21. r <- squeeze(R(img))
  22. g <- squeeze(G(img))
  23. b <- squeeze(B(img))
  24. # 创建插值函数以获取UV点的颜色
  25. library(cooltools) # 获取`approxfun2`函数
  26. x_ <- seq(0, 2*pi, length.out = 1024L)
  27. y_ <- seq(0, pi, length.out = 1024L)
  28. f_r <- approxfun2(x_, y_, r)
  29. f_g <- approxfun2(x_, y_, g)
  30. f_b <- approxfun2(x_, y_, b)
  31. # 插值r、g、b值
  32. UV_r <- f_r(UV[, 1L], UV[, 2L])
  33. UV_g <- f_g(UV[, 1L], UV[, 2L])
  34. UV_b <- f_b(UV[, 1L], UV[, 2L])
  35. # 将rgb转换为十六进制代码
  36. clrs <- rgb(UV_r, UV_g, UV_b)
  37. clrs[clrs == "#FFFFFF"] <- "cyan" # 用青色替换白色
  38. # 将颜色分配给网格的顶点
  39. # 我不知道为什么,但必须反转颜色
  40. rmesh$material <- list(color = rev(clrs))
  41. # 绘制
  42. library(rgl)
  43. open3d(windowRect = 50 + c(0, 0, 512, 512), zoom = 0.7)
  44. shade3d(rmesh, meshColor = "vertices")
  45. snapshot3d("world3D.png", webshot = FALSE)

以上是代码的翻译部分。

英文:

Here is how to fill the countries.

  1. library(maps)
  2. data(worldMapEnv)
  3. # make a PNG image of the world in 2D with filled countries
  4. world &lt;- map(&quot;world&quot;, plot = FALSE, fill = TRUE, wrap = c(0, 360))
  5. png(&quot;world2D.png&quot;, width = 1024L, height = 1024L)
  6. opar &lt;- par(mar = c(0, 0, 0, 0))
  7. plot(world$x, world$y, type = &quot;n&quot;, xlab = NA, ylab = NA, axes = FALSE,
  8. xaxs = &quot;i&quot;, yaxs = &quot;i&quot;, xlim = c(0, 360), ylim = c(-90, 90))
  9. polygon(world$x, world$y, col=&quot;orangered&quot;, lwd = 2)
  10. par(opar)
  11. dev.off()

用rgl在球上填充一个区域

  1. # use spherical coordinates to make a mesh of the unit sphere
  2. library(cgalMeshes)
  3. sphericalCoordinates &lt;- function(θ, ϕ){
  4. x &lt;- cos(θ) * sin(ϕ)
  5. y &lt;- sin(θ) * sin(ϕ)
  6. z &lt;- cos(ϕ)
  7. rbind(x, y, z)
  8. }
  9. rmesh &lt;- parametricMesh(
  10. sphericalCoordinates, urange = c(0, 2*pi), vrange = c(0, pi),
  11. periodic = c(TRUE, TRUE), nu = 1024L, nv = 1024L
  12. )
  13. rmesh$normals &lt;- rmesh$vb[-4L, ]
  14. # get the angles θ and ϕ of the vertices of the mesh
  15. UV &lt;- cooltools::car2sph(t(rmesh$vb[-4L, ]))
  16. UV &lt;- cbind(UV[, 3L], UV[, 2L])
  17. # now load the PNG image
  18. library(imager)
  19. img &lt;- load.image(&quot;world2D.png&quot;)
  20. # take the r, g, b channels
  21. r &lt;- squeeze(R(img))
  22. g &lt;- squeeze(G(img))
  23. b &lt;- squeeze(B(img))
  24. # make interpolation functions to get the colors of the UV points
  25. library(cooltools) # to get the `approxfun2` function
  26. x_ &lt;- seq(0, 2*pi, length.out = 1024L)
  27. y_ &lt;- seq(0, pi, length.out = 1024L)
  28. f_r &lt;- approxfun2(x_, y_, r)
  29. f_g &lt;- approxfun2(x_, y_, g)
  30. f_b &lt;- approxfun2(x_, y_, b)
  31. # now, interpolate the r, g, b values
  32. UV_r &lt;- f_r(UV[, 1L], UV[, 2L])
  33. UV_g &lt;- f_g(UV[, 1L], UV[, 2L])
  34. UV_b &lt;- f_b(UV[, 1L], UV[, 2L])
  35. # convert rgb to hex codes
  36. clrs &lt;- rgb(UV_r, UV_g, UV_b)
  37. clrs[clrs == &quot;#FFFFFF&quot;] &lt;- &quot;cyan&quot; # replace white with cyan
  38. # assign the colors to the vertices of the mesh
  39. # I don&#39;t know why, but one has to reverse the colors
  40. rmesh$material &lt;- list(color = rev(clrs))
  41. # plot
  42. library(rgl)
  43. open3d(windowRect = 50 + c(0, 0, 512, 512), zoom = 0.7)
  44. shade3d(rmesh, meshColor = &quot;vertices&quot;)
  45. snapshot3d(&quot;world3D.png&quot;, webshot = FALSE)

用rgl在球上填充一个区域

huangapple
  • 本文由 发表于 2023年6月22日 20:08:18
  • 转载请务必保留本文链接:https://go.coder-hub.com/76531722.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定