使用rayshader的render_label为ggplot转换的3D图表添加正确标注的问题

问题根源 #

你遇到的标注位置错误核心原因是：render_label()使用的坐标系统和ggplot的原始数据坐标（包括散点的xy、地图的经纬度）并不一致：

• rayshader调用plot_gg()后会将ggplot的画布映射为一个固定尺寸的渲染网格，x轴范围为0 ~ 高度矩阵的列数，y轴范围为0 ~ 高度矩阵的行数
• ggplot的y轴原点在左下角，rayshader的y轴原点在左上角，二者y轴方向是翻转的
• 手动试错填坐标效率极低，用坐标映射公式可以直接完成原始坐标到渲染坐标的转换

通用解决步骤 #

1. 提取ggplot的坐标轴范围
   调用layer_scales()直接拿到你绘制的ggplot的x、y轴的最大最小值：

scales <- layer_scales(p)
x_min <- scales$x$range$range[1]
x_max <- scales$x$range$range[2]
y_min <- scales$y$range$range[1]
y_max <- scales$y$range$range[2]

2. 提取渲染网格的尺寸
   从返回的高度矩阵里直接拿宽高：

render_width <- ncol(ht_matrix)
render_height <- nrow(ht_matrix)

3. 原始坐标转rayshader坐标
   写个简单的转换公式即可，z值可以直接从高度矩阵取值，再加少量偏移让标注浮在图形上方：

# 输入你要标注的原始数据坐标
target_x_original <- 10.4
target_y_original <- 472

# 转换为rayshader坐标
target_x <- (target_x_original - x_min)/(x_max - x_min) * render_width
target_y <- render_height - (target_y_original - y_min)/(y_max - y_min) * render_height
# 自动取对应位置的高度，加10作为偏移避免被图形挡住
target_z <- ht_matrix[round(target_y), round(target_x)] + 10

4. 调用render_label标注
   直接传入转换后的坐标即可：

render_label(ht_matrix, text = "Pick this car", x = target_x, y = target_y, z = target_z)

修改后的mtcars示例完整代码 #

library(ggplot2)
library(rayshader)
p <- ggplot(mtcars) + 
  geom_point(aes(x=mpg, y=disp, color=cyl)) + 
  scale_color_continuous(limits=c(0,8)) 

# 提取ggplot坐标范围
scales <- layer_scales(p)
x_min <- scales$x$range$range[1]
x_max <- scales$x$range$range[2]
y_min <- scales$y$range$range[1]
y_max <- scales$y$range$range[2]

filename_movie = tempfile()
ht_matrix <- plot_gg(p, save_height_matrix = TRUE)

# 转换坐标
render_width <- ncol(ht_matrix)
render_height <- nrow(ht_matrix)
target_x_original <- 10.4
target_y_original <- 472
target_x <- (target_x_original - x_min)/(x_max - x_min) * render_width
target_y <- render_height - (target_y_original - y_min)/(y_max - y_min) * render_height
target_z <- ht_matrix[round(target_y), round(target_x)] + 10

render_label(ht_matrix, text = "Pick this car", x = target_x, y = target_y, z = target_z)
render_snapshot(filename = "fig_2.png")
rgl::rgl.close()

澳大利亚地图示例适配 #

对于sf的经纬度坐标，转换逻辑完全一致，不需要再试错填坐标：

#remotes::install_github("wfmackey/absmapsdata")
library(absmapsdata)
library(tidyverse)
library(ggthemes)
library(rayshader)
library(sf)
state_map <- absmapsdata::state2016

p <- state_map %>% 
  ggplot() +
  geom_sf(aes(geometry = geometry, fill = areasqkm_2016)) +
  theme_map() +
  scale_fill_viridis_c(option = "C")

# 提取ggplot坐标轴（经纬度）范围
scales <- layer_scales(p)
lon_min <- scales$x$range$range[1]
lon_max <- scales$x$range$range[2]
lat_min <- scales$y$range$range[1]
lat_max <- scales$y$range$range[2]

filename_movie = tempfile()
ht_mx <- plot_gg(p,
                 multicore=TRUE,
                 width=5,
                 height=5,
                 scale = 350,
                 windowsize = c(1000, 1000),
                 phi = 30,
                 save_height_matrix = TRUE,
                 theta = 0
)

# 转换经纬度到渲染坐标
render_width <- ncol(ht_mx)
render_height <- nrow(ht_mx)

# 标注Northern Territory，替换为你要标的真实经纬度
nt_lon <- 133
nt_lat <- -20
nt_x <- (nt_lon - lon_min)/(lon_max - lon_min) * render_width
nt_y <- render_height - (nt_lat - lat_min)/(lat_max - lat_min) * render_height
nt_z <- ht_mx[round(nt_y), round(nt_x)] + 50

# 标注Queensland，替换为你要标的真实经纬度
qld_lon <- 145
qld_lat <- -22
qld_x <- (qld_lon - lon_min)/(lon_max - lon_min) * render_width
qld_y <- render_height - (qld_lat - lat_min)/(lat_max - lat_min) * render_height
qld_z <- ht_mx[round(qld_y), round(qld_x)] + 50

render_label(ht_mx, text = "Northern Territory", x = nt_x, y = nt_y, z = nt_z)
render_label(ht_mx, text = "Queensland", x = qld_x, y = qld_y, z = qld_z)
render_snapshot(filename = "fig_1")
rgl::rgl.close()

内容的提问来源于stack exchange，提问作者Zhiqiang Wang