使用自定义图像的3D散点图

Question

我正在尝试使用ggplot并使用ggimage自定义图像创建3D散点图。在2D模式下效果很好：

library(ggplot2)
library(ggimage)
library(rsvg)

set.seed(2017-02-21)
d <- data.frame(x = rnorm(10), y = rnorm(10), z=1:10,
  image = 'https://image.flaticon.com/icons/svg/31/31082.svg'
)

ggplot(d, aes(x, y)) + 
  geom_image(aes(image=image, color=z)) +
  scale_color_gradient(low='burlywood1', high='burlywood4')

我尝试了两种创建3D图表的方法：

1. plotly-尽管它已作为将来的请求排队，但目前不适用于geom_image。

2. gg3D-这是一个R包，但是我不能让它与自定义图像配合使用。合并这些库的结果如下：

library(ggplot2)
library(ggimage)
library(gg3D)

ggplot(d, aes(x=x, y=y, z=z, color=z)) +
  axes_3D() +
  geom_image(aes(image=image, color=z)) +
  scale_color_gradient(low='burlywood1', high='burlywood4')

任何帮助，将不胜感激。如果解决方案存在，我可以使用python库，javascript等。

Answer 1

Here's a hacky solution that converts the image into a dataframe, where each pixel becomes a voxel (?) that we send into plotly. It basically works, but it needs some more work to:

1) adjust image more (with erosion step?) to exclude more low-alpha pixels

2) use requested color range in plotly

Step 1: import image and resize, and filter out transparent or partly transparent pixels

library(tidyverse)
library(magick)
sprite_frame <- image_read("coffee-bean-for-a-coffee-break.png") %>% 
  magick::image_resize("20x20") %>% 
  image_raster(tidy = T) %>%
  mutate(alpha = str_sub(col, start = 7) %>% strtoi(base = 16)) %>%
  filter(col != "transparent", 
     alpha > 240)

EDIT: adding result of that chunk in case useful to anyone:

sprite_frame <- 
structure(list(x = c(13L, 14L, 10L, 11L, 12L, 13L, 14L, 15L, 
16L, 17L, 8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 7L, 
8L, 9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 6L, 7L, 8L, 9L, 
10L, 11L, 12L, 13L, 14L, 15L, 16L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 13L, 14L, 15L, 19L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 
13L, 14L, 19L, 20L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 
13L, 18L, 19L, 20L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 17L, 
18L, 19L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 15L, 16L, 17L, 18L, 19L, 
2L, 3L, 4L, 5L, 6L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 2L, 3L, 
4L, 5L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 1L, 2L, 3L, 9L, 
10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 1L, 2L, 7L, 8L, 
9L, 10L, 11L, 12L, 13L, 14L, 15L, 16L, 17L, 2L, 6L, 7L, 8L, 9L, 
10L, 11L, 12L, 13L, 14L, 15L, 16L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 
12L, 13L, 14L, 15L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 
14L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 4L, 5L, 6L, 
7L, 8L, 9L, 10L, 11L, 6L, 7L, 8L), y = c(1L, 1L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 
4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 4L, 5L, 5L, 5L, 5L, 5L, 5L, 
5L, 5L, 5L, 5L, 5L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 6L, 
6L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 7L, 8L, 8L, 
8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 8L, 9L, 9L, 9L, 9L, 
9L, 9L, 9L, 9L, 9L, 9L, 9L, 9L, 10L, 10L, 10L, 10L, 10L, 10L, 
10L, 10L, 10L, 10L, 10L, 10L, 11L, 11L, 11L, 11L, 11L, 11L, 11L, 
11L, 11L, 11L, 11L, 11L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 12L, 
12L, 12L, 12L, 12L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 13L, 
13L, 13L, 13L, 13L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 14L, 
14L, 14L, 14L, 14L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 15L, 
15L, 15L, 15L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 16L, 
16L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 17L, 18L, 
18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 18L, 19L, 19L, 19L, 19L, 
19L, 19L, 19L, 19L, 20L, 20L, 20L), col = c("#000000f6", "#000000fd", 
"#000000f4", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000f8", "#000000f4", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000fd", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000f9", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000fd", 
"#000000f4", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000fa", "#000000ff", "#000000ff", "#000000f6", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000fb", "#000000ff", "#000000ff", 
"#000000ff", "#000000f3", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000fa", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000f1", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000f3", 
"#000000ff", "#000000ff", "#000000ff", "#000000f6", "#000000f9", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000f5", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000f5", 
"#000000fc", "#000000ff", "#000000fd", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000f3", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000ff", 
"#000000ff", "#000000f5", "#000000f8", "#000000ff", "#000000ff", 
"#000000ff", "#000000ff", "#000000ff", "#000000ff", "#000000f4", 
"#000000f1", "#000000fe", "#000000f7"), alpha = c(246L, 253L, 
244L, 255L, 255L, 255L, 255L, 255L, 255L, 248L, 244L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 253L, 255L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 249L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 253L, 244L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 250L, 255L, 
255L, 246L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 251L, 
255L, 255L, 255L, 243L, 255L, 255L, 255L, 255L, 255L, 255L, 250L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 241L, 255L, 
255L, 255L, 255L, 255L, 243L, 255L, 255L, 255L, 246L, 249L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 245L, 255L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 245L, 252L, 255L, 253L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 243L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 
255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 255L, 245L, 248L, 
255L, 255L, 255L, 255L, 255L, 255L, 244L, 241L, 254L, 247L)), row.names = c(NA, 
-210L), class = "data.frame")

Here's what that looks like:

ggplot(sprite_frame, aes(x,y, fill = col)) + 
  geom_raster() + 
  guides(fill = F) +
  scale_fill_identity()

Step 2: bring those pixels in as voxels

pixels_per_image <- nrow(sprite_frame)
scale <- 1/40  # How big should a pixel be in coordinate space?

set.seed(2017-02-21)
d <- data.frame(x = rnorm(10), y = rnorm(10), z=1:10)
d2 <- d %>%
  mutate(copies = pixels_per_image) %>%
  uncount(copies) %>%
  mutate(x_sprite = sprite_frame$x*scale + x,
         y_sprite = sprite_frame$y*scale + y,
         col = rep(sprite_frame$col, nrow(d)))

We can plot that in 2d space with ggplot:

ggplot(d2, aes(x_sprite, y_sprite, z = z, alpha = col, fill = z)) + 
  geom_tile(width = scale, height = scale) + 
  guides(alpha = F) +
  scale_fill_gradient(low='burlywood1', high='burlywood4')

Or bring it into plotly. Note that plotly 3d scatters do not currently support variable opacity, so the image currently shows up as a solid oval until you're closely zoomed into one sprite.

library(plotly)
plot_ly(d2, x = ~x_sprite, y = ~y_sprite, z = ~z, 
    size = scale, color = ~z, colors = c("#FFD39B", "#8B7355")) %>%
    add_markers()

Edit: attempt at plotly mesh3d approach

It seems like another approach would be to convert the SVG glyph into coordinates for a mesh3d surface in plotly.

My initial attempt to do this has been impractically manual:

1. Load SVG in Inkscape and use "flatten beziers" option to approximate shape without bezier curves.
2. Export SVG and cross fingers that file has raw coordinates. I'm new to SVGs and it looks like the output can often be a mix of absolute and relative points. Complicated further in this case since the glyph has two disconnected sections.
3. Reformat coordinates as data frame for plotting with ggplot2 or plotly.

例如，以下坐标表示一个bean的一半，我们可以对其进行转换以得到另一半：

library(dplyr)
half_bean <- read.table(
  header = T,
  stringsAsFactors = F,
  text = "x y
  153.714 159.412 
  95.490016 186.286 
  54.982625 216.85 
  28.976672 247.7425 
  14.257 275.602 
  0.49742188 229.14067 
  5.610375 175.89737 
  28.738141 120.85839 
  69.023 69.01 
  128.24827 24.564609 
  190.72412 2.382875 
  249.14492 3.7247031 
  274.55165 13.610674 
  296.205 29.85 
  296.4 30.064 
  283.67119 58.138937 
  258.36 93.03325 
  216.39731 128.77994 
  153.714 159.412"
) %>%
  mutate(z = 0)

other_half <- half_bean %>%
  mutate(x = 330 - x,
         y = 330 - y,
         z = z)

ggplot() + coord_equal() +
  geom_path(data = half_bean, aes(x,y)) +
  geom_path(data = other_half, aes(x,y))

但是，尽管在ggplot中看起来不错，但我无法使凹入的部分正确显示在图中：

library(plotly)
plot_ly(type = 'mesh3d',
        split = c(rep(1, 19), rep(2, 19)),
             x = c(half_bean$x, other_half$x),
             y = c(half_bean$y, other_half$y),
             z = c(half_bean$z, other_half$z)
)