如何将2D图像投影为三维散点图中的曲面(在R中)?

时间:2016-05-23 23:00:16

标签: r plot texture-mapping rgl

我正在使用三维坐标数据,我在散点图中绘图,我有~30,000个数据点,我已经包含了前10个数据点,以便您可以重现它< / p>

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)

现在我的问题&#34;,是我希望在z = 0时将外部图像文件叠加到其上的2d表面,如果我可以投影热图/轮廓,则作为奖励从该图像上的散点图数据(用于轮廓的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中使用热图创建图像,保存,然后将其用作表面覆盖的输入,但如果可以在一次调用中完成所有内容,那当然会非常酷。

2 个答案:

答案 0 :(得分: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)

产生这个:

enter image description here

答案 1 :(得分:2)

(第二次编辑)我尝试编写更好的代码并确认两个xy坐标是相同的。 ggplot2 theme with no axes or grid帮助我只绘制面板区域。

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 !

plot