r - 如何在不重新加载所有内容的情况下突出显示带有 Shiny 刻面的ggplot上的点？

Question

我想动态快速地突出显示 faceted 上的点ggplot在 shiny .

我的问题:每次重新计算图形都需要花费大量时间(我经常遇到 facet 绘图)。

创意
此刻我只有两个:

想办法一次性“预计算”一次ggplot ，并且只修改一些红色的点。

想办法完美overlay原版ggplot与 ggplot仅限于红点(会轻得多)。

引用文献:我找到了这些主题:

Overlaying two graphs using ggplot2 in R

Update large plots in Shiny without Re-Rendering

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

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

我想我通过做以下两件事来压缩了一个小的速度改进:

将数字输入更改为具有受限选项的选择输入框。

简化代码以仅将调色板变成响应式(Reactive)表达式。

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)