在R中的ggplotly中图例的奇怪格式化

Question

我想把一个ggplot转换成plotly。ggplot渲染正常，但是当我将它通过ggplotly处理后，图例的标签后面会增加括号和",1"。

这是一个样本假数据：

sorted1<-data.frame(CommDate=c(as.Date("2017-09-12"), as.Date("2017-10-15")), CommName=c("Foo", "Bar"), PubB4=c(2,3))

以下是我试图在上面运行的代码：

ggplotly(ggplot(sorted1, aes(x=as.Date(CommDate), y=PubB4))+
           geom_smooth(level=0.0, aes(colour="Moving average"), se=FALSE)+
           geom_point(aes(fill=CommName), size=4)+
           expand_limits(y=c(0,4.5))+
           geom_line(mapping=aes(y=4),colour="orangered3",size=1)+
           geom_text(mapping=aes(y=4.2, x=min(sorted1$CommDate)+4), label="Target", size=3)+
           xlab("Committee Date")+
           guides(fill=guide_legend(title="Committee Names"), colour=guide_legend(title.theme=element_blank(),title=NULL))+
           scale_x_date(labels = date_format("%b-%y"))+
           theme_light()+
           theme(plot.title=element_text(hjust=0.5, size=12),panel.grid.major.x = (element_blank()), 
                 panel.grid.minor.x = (element_blank()), 
                 axis.title = element_text(size=8), legend.title = element_text(size=10),
                 legend.text = element_text(size=8), legend.box = 'vertical', legend.spacing.y = unit(-2,"mm"))+
           scale_colour_manual(name="",values="#0072B2"))

（geom_smooth在这里没有渲染，但在完整数据中会渲染。）

我从中得到了以下信息:

为什么图例显示为“(foo,1)”？

我尝试删除geom_smooth，它实际上解决了问题，但我需要它在那里-如何保留它并修复图例？

谢谢！

更新：好的，我开始注释一些东西看看会发生什么。如果我从geom_smooth中删掉()这个，也可以解决问题，只要我把scale_colour_manual也注释掉就可以了。但是我真的希望对geom_smooth的美学有所控制，并将其包括在图例中。所以我正在取得进展，但还不够...

- iod

Answer 1

这里是另一种优雅的解决方案。在底层，它会检测 plotly 的图例名称选项是否可用，如果是，则删除括号和",1"。

library(ggplot2)
library(plotly)
library(stringr)
library(dplyr)

data = data.frame(Date=as.Date(c("2017-09-12","2017-10-15")), PubB4=c(2,3), category=c("Foo", "Bar"))

myplot = ggplotly(ggplot(data, aes(x=Date, y=PubB4))+
    geom_hline(aes(yintercept=2.5, color="my line label"))+
    geom_point(aes(fill=category), size=4))

for (i in 1:length(myplot$x$data)){
    if (!is.null(myplot$x$data[[i]]$name)){
        myplot$x$data[[i]]$name =  gsub("\\(","",str_split(myplot$x$data[[i]]$name,",")[[1]][1])
    }
}

myplot

- Isaac Zhao

Answer 2

这里有一个对我有用的方法，它涉及到深入研究生成的 plotly 对象并清理图例名称。

第一部分创建一个函数来检测 plotly 列表元素是否有指定的图例，然后清理它们。

clean_plotly_leg <- function(.plotly_x, .extract_str) {
  # Inpects an x$data list in a plotly object, cleans up legend values where appropriate
  if ("legendgroup" %in% names(.plotly_x)) {
    # The list includes a legend group

    .plotly_x$legendgroup <- stringr::str_extract(.plotly_x$legendgroup, .extract_str)
    .plotly_x$name <- stringr::str_extract(.plotly_x$name, .extract_str)

  }
  .plotly_x


}

第二部分将其应用于您的示例，但需要一个中间步骤。

sorted_plotly <-
  ggplotly(ggplot(sorted1, aes(x=as.Date(CommDate), y=PubB4))+
           geom_smooth(level=0.0, aes(colour="Moving average"), se=FALSE)+
           geom_point(aes(fill=CommName), size=4)+
           expand_limits(y=c(0,4.5))+
           geom_line(mapping=aes(y=4),colour="orangered3",size=1)+
           geom_text(mapping=aes(y=4.2, x=min(sorted1$CommDate)+4), label="Target", size=3)+
           xlab("Committee Date")+
           guides(fill=guide_legend(title="Committee Names"), colour=guide_legend(title.theme=element_blank(),title=NULL))+
           scale_x_date(labels = date_format("%b-%y"))+
           theme_light()+
           theme(plot.title=element_text(hjust=0.5, size=12),panel.grid.major.x = (element_blank()), 
                 panel.grid.minor.x = (element_blank()), 
                 axis.title = element_text(size=8), legend.title = element_text(size=10),
                 legend.text = element_text(size=8), legend.box = 'vertical', legend.spacing.y = unit(-2,"mm"))+
           scale_colour_manual(name="",values="#0072B2"))

sorted_plotly$x$data <-
  sorted_plotly$x$data %>% 
  map(clean_plotly_leg, "[^\\(][^,]*") # ie remove the opening bracket, if one exists, and extract each character up to the first comma

sorted_plotly 

我很欢迎任何关于让这段代码更高效的建议，但至少它能够工作。

- James N

Answer 3

由于我所做的一切都没有起作用，我决定自己学习如何直接在plotly中创建图表。为了可能未来的观众的利益，这里是如何在plotly中重新创建图表（省略了一些美化处理，我会在另一个时间处理）：

plot_ly(sorted, x=~CommDate) %>%
  add_markers(y=~PubB4, color=~factor(CommName), size=I(15)) %>% 
  add_lines(x=loess.smooth(sorted$CommDate,sorted$PubB4)$x,         
    y=loess.smooth(sorted$CommDate,sorted$PubB4)$y, name = "Rolling Average", 
    showlegend = TRUE, size=I(3)) %>%
  add_lines(x=c(min(sorted$CommDate),max(sorted$CommDate)),y=4, 
    color=I("red"), name="target", size=I(3)) %>%
  layout(yaxis=(list(range=c(0,max(c(4.5,sorted$PubB4))))),xaxis=list(range=c(min(sorted$CommDate)-10, max(sorted$CommDate)+5))) 

- iod

Answer 4

截至2023年10月26日，解决Plotly在虚拟刻度上添加括号的已知问题的最简单和最干净的方法是将相应的指南/图例设置为none，例如使用guides(color = "none") +。

完整的示例代码：

# set to FALSE to use original code
fix_plotly_legend = T

sorted1<-data.frame(CommDate=c(as.Date("2017-09-12"), as.Date("2017-10-15")), CommName=c("Foo", "Bar"), PubB4=c(2,3))
plotly::ggplotly(ggplot(sorted1, aes(x=as.Date(CommDate), y=PubB4))+
                   geom_smooth(level=0.0, aes(colour="Moving average"), se=FALSE)+
                   geom_point(aes(fill=CommName), size=4)+
                   expand_limits(y=c(0,4.5))+
                   geom_line(mapping=aes(y=4),colour="orangered3",size=1)+
                   geom_text(mapping=aes(y=4.2, x=min(sorted1$CommDate)+4), label="Target", size=3)+
                   xlab("Committee Date")+
                   guides(fill=guide_legend(title="Committee Names"), colour=guide_legend(title.theme=element_blank(),title=NULL))+
                   scale_x_date(labels = scales::date_format("%b-%y"))+
                   theme_light()+
                   theme(plot.title=element_text(hjust=0.5, size=12),panel.grid.major.x = (element_blank()), 
                         panel.grid.minor.x = (element_blank()), 
                         axis.title = element_text(size=8), legend.title = element_text(size=10),
                         legend.text = element_text(size=8), legend.box = 'vertical', legend.spacing.y = unit(-2,"mm"))+
                   scale_colour_manual(name="",values="#0072B2") +
                   {if (fix_plotly_legend) guides(color = "none") else NULL}
)

- Juergen

Answer 5

如果有人仍然遇到这个问题，请检查您是否在设置fill时，将其设置为scale_fill_viridis_d或类似内容，而应该使用scale_color_viridis_d（即请检查您的aes()是否同时使用color和fill）。

另一个要检查的是数据集是否已经分组，如果已经分组，则在进行图形绘制之前应该执行ungroup()。

- Andrea Vargas

Answer 6

这是一个真正有效的解决方法：

# First, repeating your code, noting the plot as p1
# --------------------------------------------------
sorted1<-data.frame(CommDate=c(as.Date("2017-09-12"), as.Date("2017-10-15")), CommName=c("Foo", "Bar"), PubB4=c(2,3))
p1 <- ggplotly(ggplot(sorted1, aes(x=as.Date(CommDate), y=PubB4))+
           geom_smooth(level=0.0, aes(colour="Moving average"), se=FALSE)+
           geom_point(aes(fill=CommName), size=4)+
           expand_limits(y=c(0,4.5))+
           geom_line(mapping=aes(y=4),colour="orangered3",size=1)+
           geom_text(mapping=aes(y=4.2, x=min(sorted1$CommDate)+4), label="Target", size=3)+
           xlab("Committee Date")+
           guides(fill=guide_legend(title="Committee Names"), colour=guide_legend(title.theme=element_blank(),title=NULL))+
           scale_x_date(labels = date_format("%b-%y"))+
           theme_light()+
           theme(plot.title=element_text(hjust=0.5, size=12),panel.grid.major.x = (element_blank()), 
                 panel.grid.minor.x = (element_blank()), 
                 axis.title = element_text(size=8), legend.title = element_text(size=10),
                 legend.text = element_text(size=8), legend.box = 'vertical', legend.spacing.y = unit(-2,"mm"))+
           scale_colour_manual(name="",values="#0072B2"))

现在我们可以继续进行解决方法：

# Now, the workaround:
# ------------------------------------------------------
p1Names <- unique(sorted1$CommName) # we need to know the "true" legend values
for (i in 1:length(p1$x$data)) { # this goes over all places where legend values are stored
  n1 <- p1$x$data[[i]]$name # and this is how the value is stored in plotly
  n2 <- " "
  for (j in 1:length(p1Names)) {
    if (grepl(x = n1, pattern = p1Names[j])) {n2 = p1Names[j]} # if the plotly legend name contains the original value, replace it with the original value
  }
  p1$x$data[[i]]$name <- n2 # now is the time for actual replacement
  if (n2 == " ") {p1$x$data[[i]]$showlegend = FALSE}  # sometimes plotly adds to the legend values that we don't want, this is how to get rid of them, too
}
p1   # now we can see the result :-)

- Hovav Dror