plotly:可以只使某些图形对象交互吗?

plotly: possible to make only certain graphical objects interactive?

我有一个 ggplot,我想将其变为交互式。但是,我不希望所有对象都具有交互性,因为有些对象实际上是用作一种背景图(在这种情况下,是一排排温室植物)。 上面方块中的数据应该是交互的,但绿色植物点或灰色行不是。

这甚至可以用 plotly 实现吗?如果是这样:如何?

我的代码和结果(我添加了 theme_update() 所以复制品看起来和我的一模一样,尽管它不太重要):

代码

    # counts in greenhouse 
Wtot <- c(10,65,139,87) 
plant <- c(15,15,30,30) 
row <- c(10,20,10,20) 
df <- data.frame(Wtot,plant,row)

    # df for greenhouse background 
nrows = 40 
nplants = 50 
greenh <- data.frame(   
  Row <- rep(1:nrows, each=nplants),   
  Plant <- rep(1:nplants, times=nrows),   
  Plantnr <- paste("plant",1:(nrows*nplants)) 
)

    # plottheme
theme_set(theme_bw()) 
theme_update(axis.title.x = element_text(size = 16, colour = 'black'),
             axis.title.y = element_text(size = 16, colour = 'black', angle = 90),
             axis.text.x = element_text(size = 12, colour = 'black'),
             axis.text.y = element_text(size = 12, colour = 'black'),
             legend.text = element_text(size = 14, colour = 'black'),
             legend.title = element_blank(),
             legend.position = "right",
             legend.box = "vertical",
             strip.text.x = element_text(size = 14, colour = 'black'),
             strip.text.y = element_text(size = 14, colour = 'black', angle = -90),
             panel.background = element_rect(fill = "gray94"),
             panel.grid.minor = element_blank(),
             panel.grid.major = element_blank())

    # plot 
p <- ggplot(data=df, aes(row, plant, colour=Wtot)) +   
   xlim(0,nrows) +   
   ylim(0,nplants) +   
   coord_equal() +   
   geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +    
   geom_point(data=greenh, aes(x=Row, y=Plant), colour="darkgreen", alpha=0.3) +  
   geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +  
   scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey", 
                           limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +   
   scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +    
   guides(fill=guide_legend(), size = guide_legend())

图表

您有两个选择:

选项 1:使用 ggplotly 您将失去传奇。但是您必须手动添加积分。

 # p <- ggplot(data=df, aes(row, plant, colour=Wtot)) +   
   p <- ggplot(data=greenh, aes(x=Row, y=Plant)) + 
   xlim(0,nrows) +   
   ylim(0,nplants) +   
   coord_equal() +   
   geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +    
   geom_point(colour="darkgreen", alpha=0.3) +  
  #geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +  
   scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey", 
                         limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +   
   scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +    
   guides(fill=guide_legend(), size = guide_legend())

  pp <- ggplotly(p, tooltip = "none")
  pp %>% add_markers(x = c(10, 20, 10, 20), y = c(15, 15, 30, 30), color = I("green"), text = c(10, 65, 139, 87), symbol = I('square'), marker = list(size = c(14, 13, 15, 12)))

选项 2:使用 plot_ly 您可以获得与图例类似的内容。您只需根据需要设置颜色和尺寸。

plot_ly(data=greenh, x=~Row, y= ~Plant) %>% 
add_markers(showlegend = FALSE, color = I("green"), hoverinfo = "none") %>% 
add_markers(data=df, x=~row, y= ~plant, showlegend = TRUE, color = ~ Wtot, size = ~ Wtot)

所以我找到了解决方案,并且还认为我遗漏了 quite 关键信息:我在 flexdashboard 中使用这个交互式绘图。我省略了那部分以使示例简单,但显然它掌握了关键!

这个问题的答案让我走上正轨:

使用 shiny 函数 plotOutput()renderPlot() 时,您可以通过 plotOutput 中的参数 hover = 添加 hover-function。 Flexdashboards 没有单独的 ui 和服务器部分,因此不使用 plotOutput()。这意味着您需要单独指定悬停选项,然后通过参数 outputArgs = (更多信息:https://shiny.rstudio.com/articles/output-args.html).

 # specify hover details
 HO <- hoverOpts(id = "plot_hover", delay = 300, delayType = c("debounce", "throttle"), 
                 clip = TRUE, nullOutside = TRUE)

 # reactive plot function
 renderPlot({
 ggplot(data=df, aes(row, plant, colour=Wtot)) +   
   xlim(0,40) +   
   ylim(0,50) +   
   coord_equal() +   
   geom_vline(xintercept=1:nrows, colour="darkgrey", alpha=0.5, size=0.7) +    
   geom_point(data=greenh, aes(x=Row, y=Plant), colour="darkgreen", alpha=0.3) +  
   geom_point(aes(fill=Wtot, size=Wtot), colour="black", pch=22) +  
   scale_fill_gradient2(low="green", mid="yellow", high="red", na.value="grey", 
                           limits=c(0,300), midpoint=150, breaks=c(0,75,150,225,300)) +   
   scale_size_continuous(range=c(3,6), limits=c(0,300), breaks=c(0,75,150,225,300)) +    
   guides(fill=guide_legend(), size = guide_legend())
}, outputArgs = list(hover = HO)) # include hover options

现在绘图已准备好显示悬停信息,但还没有显示任何内容。您必须指定要查看的信息。在这里我可以告诉它只显示正方形的信息而不是温室元素的信息:

# shown hover results
renderPrint({ 
  hover <- input$plot_hover
  y <- nearPoints(df, input$plot_hover)
  req(nrow(y) != 0)
  y
})

您可以进一步调整代码以将信息显示为工具提示(参见上面提到的线程)。

希望对其他人有所帮助!