如何突出ggplot上的点与facet闪亮而不重新加载？

Question

我想动态并迅速凸显于点faceted ggplot在闪亮.

我的问题:图形每次都需要花费很多时间才能重新计算(这经常发生在我的小平面图上).

想法 此刻我只有两个:

1. 找到一种方法为所有原始"预先计算"一次ggplot,并且只修改一些红色的点.
2. 找到一种方法来完全覆盖原来ggplot用ggplot有限的红点(这将是轻得多).

参考文献:我发现了以下主题:

• 在R中使用ggplot2覆盖两个图
• 在没有重新渲染的情况下更新Shiny中的大块图

但它似乎不适用于我的问题.请在下面找到可重现的示例.非常感谢您的帮助和支持!

library(shiny); library(ggplot2); library(dplyr)
# Dataset
data_=do.call("rbind", replicate(1000, mtcars, simplify = FALSE))
# General graphic
p_0=ggplot(data=data_,aes(x=wt,y=mpg))+geom_point()+facet_wrap(~carb)

版本1:易于阅读代码,但在更新数据时会产生重要的滞后效应

ui=fluidPage(
                fluidRow(
                    column(width = 12,
                    numericInput("choice", "Highlight in red when carb=",1,),
                    plotOutput("plot1"))
                )
                )

server=function(input, output) {
    p=reactive({return(
        p_0+geom_point(data=data_ %>% filter(carb==input$choice),aes(x=wt,y=mpg),color='red')
        )})
    output$plot1=renderPlot({p()})
}

shinyApp(ui, server)

版本2:更好的用户体验,但阅读代码困难,使用绝对面板的布局困难,仍然存在滞后问题

ui=fluidPage(
    fluidRow(
        column(width = 12,
            numericInput("choice", "Highlight in red when carb=", 1,),
            absolutePanel(plotOutput("plot1"), top = 200, left = 0,width = 500, height = 500),
            absolutePanel(plotOutput("plot2"), top = 200, left = 0,width = 500, height = 500)
        )
    )
    )

server=function(input, output) {

    p=reactive({return(ggplot(data=data_,aes(x=wt,y=mpg))+geom_blank()+facet_wrap(~carb)+
        geom_point(data=data_ %>% filter(carb==input$choice),color='red',size=3)+
        theme_bw()+
        theme(legend.position="none")+
        theme(
          panel.background =element_rect(fill = "transparent"),
          plot.background = element_rect(fill = "transparent"),
          panel.grid.major = element_blank(),
          panel.grid.minor = element_blank()
        )
        )})
    output$plot1=renderPlot({p_0},bg="transparent")
    output$plot2=renderPlot({p()},bg="transparent")

}

shinyApp(ui, server)

Answer 1

我认为通过执行以下两件事，我已经获得了小幅速度提升：

• 将数字输入更改为选择受限的输入框。
• 简化了代码，仅将调色板变成反应式表达式。

library(shiny); library(ggplot2); library(dplyr)
# Dataset
data_=do.call("rbind", replicate(1000, mtcars, simplify = FALSE))
# General graphic

ui=fluidPage(
  fluidRow(
    column(width = 12,
           selectInput("choice", "Highlight in red when carb=",1, choices = c(1:4,6,8)),
           plotOutput("plot1"))
  )
)

server=function(input, output) {

  cols <- reactive({
    cols <- c("1" = "black", "2" =  "black", "3" =  "black",
              "4" =  "black", "6" =   "black",   "8" =   "black")
    cols[input$choice] <- "red"
    return(cols)
  })

  output$plot1=renderPlot({
    ggplot(data_, aes(x=wt, y=mpg, color = as.character(carb))) +
      geom_point() +
      scale_colour_manual(values = cols()) +
      facet_wrap(~carb)
      })
}

shinyApp(ui, server)