r - Ggiraph 不适用于圆形堆叠条形图

Question

您好，感谢您阅读我的内容对于这种特殊情况是不可能的。任何人都知道是否有任何解决方案？代码如下：

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)) 


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)

# Get the name and the y position of each label
label_data= data %>% group_by(id, individual) %>% summarize(tot=sum(value))
number_of_bar=nrow(label_data)
angle= 90 - 360 * (label_data$id-0.5) /number_of_bar     # I substract 0.5 because the letter must have the angle of the center of the bars. Not extreme right(1) or extreme left (0)
label_data$hjust<-ifelse( angle < -90, 1, 0)
label_data$angle<-ifelse(angle < -90, angle+180, angle)

# prepare a data frame for base lines
base_data=data %>% 
  group_by(group) %>% 
  summarize(start=min(id), end=max(id) - empty_bar) %>% 
  rowwise() %>% 
  mutate(title=mean(c(start, end)))

# prepare a data frame for grid (scales)
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")

# Make the plot
p <- ggplot(data) +      
  
  # Add the stacked bar
  ggiraph::geom_bar_interactive(aes(x=as.factor(id), y=value, fill=observation), stat="identity", alpha=0.5) +
  #scale_fill_viridis(discrete=TRUE) +
  scale_fill_manual(values = rhg_cols)+
  # Add a val=100/75/50/25 lines. I do it at the beginning to make sur barplots are OVER it.
  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 ) +
  
  # Add text showing the value of each 100/75/50/25 lines
  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() +
  
  # Add labels on top of each bar
  geom_text(data=label_data, aes(x=id, y=tot+3, label=individual, hjust=hjust), color="black", fontface="bold",alpha=0.6, size=2, angle= label_data$angle, inherit.aes = FALSE ) 
  
  # Add base line information
  #geom_segment(data=base_data, aes(x = start, y = -5, xend = end, yend = -5), colour = "black", alpha=0.8, size=0.6 , inherit.aes = FALSE )  
  #geom_text(data=base_data, aes(x = title, y = -18, label=group), hjust=c(1,1,0,0), colour = "black", alpha=0.8, size=4, fontface="bold", inherit.aes = FALSE)

p
# interactive plot
girafe(
  ggobj = p, 
  width_svg = 7, height_svg = 4, bg = "#D7E0DA",
  options = list(
    opts_hover(css = "fill:#5eba7d88;cursor:pointer;"),
    opts_hover_theme(css = "fill:red;cursor:pointer;"),
    opts_selection(css = "fill:#5eba7d;cursor:pointer;", only_shiny = FALSE, selected = "J"),
    opts_tooltip(css = "background-color:white;padding:5px;border-radius:2px;border: black 1px solid;color:black;")
  )
  
)

更新

现在我使用 geom_col (geom_col_interactive) 但是当我将对象导出到 girafe() 时，取景器中什么也没有

代码如下：

p <- ggplot(data) +      
  geom_col_interactive(aes(x=as.factor(id), y=value, fill=observation), stat="identity", alpha=0.5) +
  scale_fill_manual_interactive(values = rhg_cols)+
  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), color="black", fontface="bold",alpha=0.6, 
            size=2, angle= label_data$angle, inherit.aes = FALSE ) 

p
    girafe(
  ggobj = p, 
  width_svg = 7, height_svg = 4, bg = "#D7E0DA",
  options = list(
    opts_hover(css = "fill:#5eba7d88;cursor:pointer;"),
    opts_hover_theme(css = "fill:red;cursor:pointer;"),
    opts_selection(css = "fill:#5eba7d;cursor:pointer;", only_shiny = FALSE, selected = "J"),
    opts_tooltip(css = "background-color:white;padding:5px;border-radius:2px;border: black 1px solid;color:black;")
  )
)

Answer 1

您的代码中存在 ggplot 问题，例如，geom_bar 不应与 a 一起使用，而应y使用 geom_col。

举一个简单的例子，这里是如何做（来自https://www.r-graph-gallery.com/128-ring-or-donut-plot.html）

# load library
library(ggplot2)
library(ggiraph)

# Create test data.
data <- data.frame(
  category=c("A", "B", "C"),
  count=c(10, 60, 30)
)

# Compute percentages
data$fraction = data$count / sum(data$count)

# Compute the cumulative percentages (top of each rectangle)
data$ymax = cumsum(data$fraction)

# Compute the bottom of each rectangle
data$ymin = c(0, head(data$ymax, n=-1))

# Make the plot
p <- ggplot(data, aes(ymax=ymax, ymin=ymin, xmax=4, xmin=3, fill=category)) +
  geom_rect_interactive(aes(tooltip = paste(category,count), data_id = category)) +
  coord_polar(theta="y") + # Try to remove that to understand how the chart is built initially
  xlim(c(2, 4)) # Try to remove that to see how to make a pie chart

girafe(
  ggobj = p, 
  width_svg = 7, height_svg = 4, bg = "#D7E0DA",
  options = list(
    opts_hover(css = "fill:#5eba7d88;cursor:pointer;"),
    opts_hover_theme(css = "fill:red;cursor:pointer;"),
    opts_selection(css = "fill:#5eba7d;cursor:pointer;", only_shiny = FALSE, selected = "J"),
    opts_tooltip(css = "background-color:white;padding:5px;border-radius:2px;border: black 1px solid;color:black;")
  )
  
)