如何在R中将二维图像投影为三维散点图的表面？

Question

我正在处理三维坐标数据，并在散点图上进行绘制，共有约3万个数据点，此处提供前10个数据以便您复现。

library(rgl)
library(plot3D)
library(car)

df <- data.frame(meanX = c(147.34694,
                       173.89244,
                       135.73004,
                       121.93766,
                       109.72152,
                       92.53709,
                       165.46588,
                       169.77744,
                       127.01796,
                       99.34347),
             meanY = c(140.40816,
                       110.99128,
                       134.56023,
                       164.18703,
                       166.04051,
                       155.97329,
                       105.29377,
                       104.42683,
                       130.17066,
                       155.99696),
             avgDist = c(40.788118,
                         12.957329,
                         14.24348,
                         39.10424,
                         34.694258,
                         25.532335,
                         21.491695,
                         23.528944,
                         9.309201,
                         31.916879))

我一直在使用scatter3d函数来绘制这个图。

scatter3d(x = df$meanX, y = df$meanY, z = df$avgDist, surface = FALSE)

现在我的“问题”是，我想要一个带有外部图像文件的2D表面覆盖在z = 0处，如果我能够将散点图数据（用于等高线的meanX和meanY）的热力图/等高线投影到该图像上，那就太好了。这是我想要的z = 0的图片：http://i.imgur.com/m6j4q3M.png。这张图片是使用ggplot制作的。

map.colors <- colorRampPalette(c("green","yellow","red"))

densityPlot <- ggplot(direData, aes(x = meanX, y = ,meanY)) + 
  stat_density2d(geom="tile", aes(fill=..density.., alpha=sqrt(sqrt(..density..))), contour=FALSE, n=100) +
  scale_alpha(range = c(0, 1.0)) + scale_fill_gradientn(colours = map.colors(5)) + 
  xlim(70,185) + ylim(70,185)

minimap <- readPNG('~/yasp/minimap.png')

densityPlot + annotation_raster(minimap, ymin = 70 ,ymax=185 ,xmin = 70,xmax = 185) + 
  stat_density2d(geom="tile", aes(fill=..density.., alpha=10*sqrt(..density..)), contour=FALSE, n=100)

有没有办法做到这一点？我已经通过谷歌搜索了很多解决方案，但没有找到真正的方法。我不介意首先在ggplot2中创建带有热图的图像，保存它，然后将其用作表面贴合的输入，但如果可以在一个绘图调用中完成所有操作，那当然是非常酷的。

- Kári Gunnarsson

---

这不是你想要的吗？ - Mike Wise

@KG 我认为fish666的答案值得一看。如果你认为这样更好，我不介意你移动正确检查 - 尽管它没有解决纹理映射的问题。也许可以将其合并进去。 - Mike Wise

嗨，Mike，感谢你在这个话题上的所有帮助，非常感激。由于他的解决方案使我能够调用ggplot2函数，我只是在他的代码中使用了annotation_raster，一切都完美地解决了，它还通过使用plot3d而不是scatter3d解决了我的范围问题（在我的另一个问题中发现scatter3d似乎存在一些范围问题，而plot3d则没有）。 - Kári Gunnarsson

完全没问题。对于一个 Stack Overflow 的初学者来说，这是一个不错的尝试。无论如何，我对获得赞（徽章）比解决方案积分更感兴趣。 - Mike Wise

Answer 1

(第二次编辑) 我尝试编写更好的代码并确认两个xy坐标是相同的。 ggplot2没有坐标轴或网格的主题 帮助我仅绘制面板区域。

library(rgl); library(grid); library(gtable)

df <- data.frame(meanX = c(147.34694, 173.89244, 135.73004, 121.93766,
                           109.72152,  92.53709, 165.46588, 169.77744,
                           127.01796,  99.34347),
                 meanY = c(140.40816, 110.99128, 134.56023, 164.18703,
                           166.04051, 155.97329, 105.29377, 104.42683,
                           130.17066, 155.99696),
                 avgDist = c(40.788118, 12.957329, 14.24348, 39.10424,
                             34.694258, 25.532335, 21.491695,23.528944,
                             9.309201,  31.916879))

map.colors <- colorRampPalette(c("green","yellow","red"))

# set scale_*_continuous() to plot only the panel region. limits mean xlim (or ylim)
# change "tile" into "raster" because of making noise lines on my screen
densityPlot <- ggplot(df[,1:2], aes(x = meanX, y = ,meanY)) + 
  stat_density2d(geom="raster", aes(fill=..density.., alpha=sqrt(sqrt(..density..))), contour=FALSE, n=100) +
  scale_alpha(range = c(0, 1.0)) + scale_fill_gradientn(colours = map.colors(5)) + 
  scale_x_continuous(limits=c(70,185), expand = c(0,0)) + scale_y_continuous(limits=c(70,185), expand = c(0,0)) +
  geom_point(size=4)               # to test XY-coordinate (black points on the map)

open3d()
plot3d( df, type="s", radius=1, col="red", axes=F, 
        xlim = c(70,185), ylim = c(70,185),
        expand = 1 )
plot3d( df, type="h", col="blue", add=T )  # to test XY-coordinate (line segments from z = 0)
axes3d(c("x","y","z") )
show2d({                  # show2d uses 2D plot function's output as a texture on a box.
  grid.draw(gtable_filter(ggplotGrob(densityPlot), "panel"))
},
expand = 1 , texmipmap = F )   # texmipmap = F makes tone clear (not essential)

# I think this is clearly better than using a intermediate file,
# so I deleted related code. Thanks Mike !

- cuttlefish44

---

小地图是指定的文件吗？你应该解释一下你在做什么（至少一点），并说明这与之前有何不同/更好。看起来很有趣。 - Mike Wise

感谢您的建议和投票。我会努力成为一个优秀的回答者。 - cuttlefish44

我知道这增加了工作量，但是好的答案会得到更多的赞同，并且确保你在现实生活中的声誉。 :) - Mike Wise

太棒了！我使用annotation_raster添加了迷你地图，在定义新的“densityPlot2”时，minimap <- readPNG('~/ yasp / minimap.png') densityPlot2 <- densityPlot + annotation_raster（minimap，ymin = 70，ymax = 185，xmin = 70，xmax = 185）+ stat_density2d（geom =“tile”，aes（fill =..density ..，alpha = 10 * sqrt（..density ..）），contour = FALSE，n = 100）。然后在您的代码中只需调用densityPlot2即可，一切都完美无缺 :) - Kári Gunnarsson

我很高兴你喜欢它。 - cuttlefish44

Answer 2

这个怎么样？

我将您的线条图像文件存储在本地目录中的png中，可能有一种方法可以在没有中间文件的情况下完成，但我建议另外提问。

请注意，这实际上是纹理映射的简单案例。 纹理保存在您指定的gameshot.png文件中。你可以通过添加更多几何点并相应调整纹理映射坐标来使文本围绕更复杂的对象弯曲。

虽然它们在这里不应该绝对必要，但我添加了纹理映射坐标，因为看起来文件和数据默认情况下未对齐 - 实际上gameshot.png文件显示为反向。 我觉得您指定的png文件与数据不太匹配，我认为在保存之前某个地方存在倒置。

library(rgl)
library(plot3D)
library(car) 

df <- data.frame(meanX = c(147.34694, 173.89244, 135.73004, 121.93766,
                           109.72152,  92.53709, 165.46588, 169.77744,
                           127.01796,  99.34347),
                 meanY = c(140.40816, 110.99128, 134.56023, 164.18703,
                           166.04051, 155.97329, 105.29377, 104.42683,
                           130.17066, 155.99696),
                 avgDist = c(40.788118, 12.957329, 14.24348, 39.10424,
                             34.694258, 25.532335, 21.491695,23.528944,
                             9.309201,  31.916879))

car::scatter3d(x = df$meanX, y = df$meanY, z = df$avgDist, surface = FALSE)

xvek <- c(0,1)
yvek <- c(0,1)
lnx <- length(xvek)
lny <- length(yvek)
zmat <- matrix(0,lnx,lny)

# Setup the Texture coordinates - defaults seem to invert image
# tms <- matrix(c(0,0,1,1),lnx,lny) # generic case (xy-maped texture looks like png file)
# tmt <- matrix(c(0,1,0,1),lnx,lny)   

tmt <- matrix(c(1,1,0,0),lnx,lny) # "correct case" (ball density look more like picture)
tms <- matrix(c(1,0,1,0),lnx,lny) # I think the gameshot.png is in error  


# Texture file specified in question was stored locally in "gameshot.png"
surface3d(xvek,yvek,zmat,coord=c(3,1),texture_s=tms,texture_t=tmt,
          lit=F,fog=T,color="white",textype="rgb",texture="gameshot.png",add=T)

产生以下结果：

- Mike Wise

---

谢谢你，Mike！我稍微修正了地图的方向，并用大约5000个点绘制了这里的图片http://i.imgur.com/1UwnQsc.png。我的问题现在是我需要找到一种方式来限制图片或者绘图的x和y轴的范围，但是xlim和ylim似乎没有任何作用，有没有办法可以解决这个问题呢？应该在x和y轴上都限制在70和185之间，但是它不允许我使用xlim = c(70,185)。我知道rgl不允许剪裁，但是在180之上没有任何数据点，所以我有点不确定为什么它不配合。 - Kári Gunnarsson

我猜这也是为什么你指出热力图与数据点不匹配的原因，因为该图像是使用x和y限制70,185创建的，但将其绑定到xlim = c（80,200）和ylim = c（90,200），尽管没有任何点超过185的限制。 - Kári Gunnarsson

目前正在喝啤酒，明天再看。 - Mike Wise

所以这个问题和答案非常成功。我会标记它为正确，并发布另一个关于它的问题。尽量让它成为一个最小的例子。再有一个问题的赞同，然后你也可以点赞——这对所有相关人员来说都更有益。而且 rgl 需要更多的活动。 - Mike Wise

听起来是个好计划，抱歉我的个人时间只有晚上几个小时，所以我回复需要花费一些时间。 - Kári Gunnarsson