Ggiraph在环形堆叠柱状图中无交互效果问题咨询

问题原因 #

你的代码存在3个核心问题导致交互效果失效、查看器无内容：

1. 所有_interactive后缀的交互图层没有配置tooltip、data_id这两个必要的映射参数，ggiraph无法识别需要触发交互的元素
2. 手动添加的空白间隔行包含大量NA值，会导致SVG渲染异常
3. 交互配置里selected = "J"对应的标识在数据集中不存在，会触发配置错误

修复方案 #

以下是可直接运行的完整代码：

# 先加载必要包
library(tidyverse)
library(ggiraph)

# 原始数据构建
data <- data.frame(
  stringsAsFactors = FALSE,
  individual = c("INDUSTRIAL","DE COMERCIO INTERIOR",
                 "DE COMERCIO EXTERIOR",
                 "DE ATRACCION DE INVERSION EXTRANJERA",
                 "POLÍTICA DE DESARROLLO PARA LA COMPETITIVIDAD DE LAS MIPYMES","DE MEJORA REGULATORIA",
                 "EN MATERIA MINERA","DE ABASTO","DE PRECIOS",
                 "DE PROTECCION AL CONSUMIDOR",
                 "NACIONAL DE CALIDAD",
                 "NACIONAL EN MATERIA DE NORMALIZACION, ESTANDARIZACION, EVALUACION DE LA",
                 "CONFORMIDAD Y METROLOGIA",
                 "DE INDUSTRIALIZACION, DISTRIBUCION Y CONSUMO DE LOS PRODUCTOS AGRICOLAS, GANADEROS, FORESTALES, MINERALES Y PESQUEROS",
                 "NACIONAL DE FOMENTO ECONOMICO",
                 "PARA CREAR Y APOYAR EMPRESAS QUE ASOCIEN A GRUPOS DE ESCASOS RECURSOS EN AREAS URBANAS"),
  group = c("A","A","A","A","B","B","B","B",
            "B","B","B","C","C","C","C","C"),
  value1 = c(30L,3L,7L,3L,0L,3L,1L,2L,0L,1L,
             7L,5L,1L,12L,0L,4L),
  value2 = c(10L,0L,2L,0L,0L,6L,0L,0L,0L,11L,
             7L,6L,0L,3L,1L,0L),
  value3 = c(0L,0L,1L,2L,14L,2L,1L,0L,0L,0L,
             1L,1L,0L,2L,0L,0L),
  value4 = c(9L,0L,13L,8L,2L,5L,1L,1L,0L,0L,
             0L,1L,2L,2L,0L,0L)
)
data = data %>% 
  gather(key = "observation", value="value", -c(1,2)) 

# 添加空白间隔行，同时把NA替换为0避免渲染错误
empty_bar=2
nObsType=nlevels(as.factor(data$observation))
to_add = data.frame( matrix(NA, empty_bar*nlevels(data$group)*nObsType, ncol(data)) )
colnames(to_add) = colnames(data)
to_add$group=rep(levels(data$group), each=empty_bar*nObsType )
data=rbind(data, to_add)
data=data %>% arrange(group, individual)
data$id=rep( seq(1, nrow(data)/nObsType) , each=nObsType)
# 新增：把数值列的NA替换为0
data$value[is.na(data$value)] <- 0

# 标签数据处理
label_data= data %>% group_by(id, individual) %>% summarize(tot=sum(value), .groups = "drop")
number_of_bar=nrow(label_data)
angle= 90 - 360 * (label_data$id-0.5) /number_of_bar
label_data$hjust<-ifelse( angle < -90, 1, 0)
label_data$angle<-ifelse(angle < -90, angle+180, angle)

# 基线和网格数据处理
base_data=data %>% 
  group_by(group) %>% 
  summarize(start=min(id), end=max(id) - empty_bar, .groups = "drop") %>% 
  rowwise() %>% 
  mutate(title=mean(c(start, end)))

grid_data = base_data
grid_data$end = grid_data$end[ c( nrow(grid_data), 1:nrow(grid_data)-1)] + 1
grid_data$start = grid_data$start - 1
grid_data=grid_data[-1,]

rhg_cols <- c("#12A09A", "#1E5C4F", "#941B80", "#F19100")

# 绘图 新增交互映射参数
p <- ggplot(data) +      
  geom_col_interactive(aes(x=as.factor(id), y=value, fill=observation,
                           # 配置悬停显示的提示内容
                           tooltip = paste0("类别：", individual, "\n指标：", observation, "\n数值：", value),
                           # 配置每个交互块的唯一标识
                           data_id = interaction(id, observation)), 
                       stat="identity", alpha=0.5) +
  scale_fill_manual(values = rhg_cols)+
  # 网格线
  geom_segment(data=grid_data, aes(x = end, y = 0, xend = start, yend = 0), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
  geom_segment(data=grid_data, aes(x = end, y = 50, xend = start, yend = 50), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
  geom_segment(data=grid_data, aes(x = end, y = 100, xend = start, yend = 100), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
  geom_segment(data=grid_data, aes(x = end, y = 150, xend = start, yend = 150), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
  geom_segment(data=grid_data, aes(x = end, y = 200, xend = start, yend = 200), colour = "grey", alpha=1, size=0.3 , inherit.aes = FALSE ) +
  # 刻度文本
  annotate("text", x = rep(max(data$id),5), y = c(0, 50, 100, 150, 200), label = c("0", "50", "100", "150", "200") , color="grey", size=2 , angle=0, fontface="bold", hjust=1) +
  ylim(-25,max(label_data$tot, na.rm=T)) +
  theme_minimal() +
  theme(
    legend.position = "none",
    axis.text = element_blank(),
    axis.title = element_blank(),
    panel.grid = element_blank(),
    plot.margin = unit(rep(-1,4), "cm") 
  ) +
  coord_polar() +
  # 条形标签也配置交互
  geom_text_interactive(data=label_data, aes(x=id, y=tot+3, label=individual, hjust=hjust,
                                             tooltip = individual, data_id = id), 
                        color="black", fontface="bold",alpha=0.6, size=2, angle= label_data$angle, inherit.aes = FALSE ) 

# 生成交互图，修正错误配置
interactive_plot <- girafe(
  ggobj = p, 
  width_svg = 9, height_svg = 9, bg = "#D7E0DA",
  options = list(
    opts_hover(css = "fill:#5eba7d88;cursor:pointer;"),
    opts_hover_theme(css = "fill:red;cursor:pointer;"),
    # 删掉不存在的selected参数，或者设置为你数据里存在的data_id值
    opts_selection(css = "fill:#5eba7d;cursor:pointer;", only_shiny = FALSE),
    opts_tooltip(css = "background-color:white;padding:5px;border-radius:2px;border: black 1px solid;color:black;")
  )
)

# 显式打印交互图，就会在RStudio查看器显示
print(interactive_plot)

补充说明 #

• 如果需要调整悬停提示的内容，修改tooltip参数对应的拼接字符串即可
• 环形图的画布尺寸建议设置为正方形（宽高参数一致），避免图形拉伸变形
• 如果需要在Shiny中使用，直接把girafeOutput和renderGirafe对应绑定interactive_plot对象即可

内容的提问来源于stack exchange，提问作者Jorge Hernández