如何使用Shiny中的checkboxGroupInput来有效地控制ggplot2图中的多个反应层？

Question

我在图中做了三个反应层。 在下面的可重现示例中，图形以绘制的function1开始。 如果我检查function2，闪亮会重新计算并重绘function1和function2。 然后，如果我勾选function3，则将重新计算并重绘所有3个函数。

说我要运行的函数是很长的推断，每个推断都需要几分钟。

我如何才能做到这样，当我检查（或取消选中）一个功能时，shiny不会重新计算并重新绘制所有已检查的功能？

在下面的代码中，我包含了print语句，这些语句表明每次调用renderPlot时（即input $ fun更改时）都运行每个反应式。

library(shiny)
library(ggplot2)
x <-  seq(0, 10, by=0.1)

runApp(shinyApp(

  ui = shinyUI(fluidPage(
    titlePanel("Test Shiny"),
    sidebarLayout(
      sidebarPanel(
        checkboxGroupInput("fun", label = "Function", 
                           choices = list("function1: x^2" = 1, 
                                          "function2: x^2 + x" = 2, 
                                          "function3: x^2 - x" = 3),
                           selected = c(1))
      ),
      mainPanel(
        plotOutput("plot")
      )
    )
  )),

  server = shinyServer(function(input, output) {


    fn1 <- reactive({ 
      print("we are in fn1 <- reactive({})")
      if (1 %in% input$fun ) { 
        geom_line(mapping = aes(x, y=x^2), color="blue") }
    })


    fn2 <- reactive({
      print("we are in fn2 <- reactive({})")
      if (2 %in% input$fun)  { 
        geom_line(mapping = aes(x, y=x^2 + x), color="red") }
    })


    fn3 <- reactive({
      print("we are in fn3 <- reactive({})")
      if (3 %in% input$fun) { 
        geom_line(mapping = aes(x, y=x^2 - x), color="green") }
    })

    output$plot <- renderPlot({

      cat("\n we are in output$plot <-  renderPlot({}) \n")
      ggplot() + fn1() + fn2() + fn3()
    })  
  })
))

我可以使用单个复选框（checkboxInput）来达到这种效率，但我不希望不使用单个复选框。 单个复选框看起来不那么好，除非有一种方法可以使它们看起来更像复选框“组输入”？

我一直在努力解决这个问题，并搜索了一段时间。 我将非常感谢对此的任何帮助！！！

编辑这是一些使用基本R plot()和lines()来响应@Jimbou闪亮代码的代码。 请在提供的闪亮代码@Jimbou下方查看我的评论。

    output$plot <- renderPlot({
  cat("\n we are in output$plot <- renderPlot({}) \n")
  plot(NULL, xlim = c(0,10), ylim = c(0,100))
  if(1 %in% input$fun) {
    print("we are in  if(1 %in% input$fun){} ")
    lines(x=x, y=x^2, col=2)
  }
  if(2 %in% input$fun) {
    print("we are in  if(2 %in% input$fun){} ")
    lines(x=x, y=x^2 + x, col=3)
  }
  if(3 %in% input$fun) {
    print("we are in  if(3 %in% input$fun){} ")
    lines(x=x, y=x^2 - x, col=4)
  }
})

Answer 1

我认为可以得到的最接近的结果是延迟对图层的处理，直到您单击操作按钮以明确告知服务器何时开始处理绘图为止。

library(shiny)
library(ggplot2)
x <-  seq(0, 10, by=0.1)

runApp(shinyApp(

  ui = shinyUI(fluidPage(
    titlePanel("Test Shiny"),
    sidebarLayout(
      sidebarPanel(
        checkboxGroupInput("fun", label = "Function", 
                           choices = list("function1: x^2" = 1, 
                                          "function2: x^2 + x" = 2, 
                                          "function3: x^2 - x" = 3),
                           selected = c(1)),
        actionButton(inputId = "btn_update_plot",
                     label = "Update Plot")
      ),
      mainPanel(
        plotOutput("plot")
      )
    )
  )),

  server = shinyServer(function(input, output) {


    p <- eventReactive(
      input$btn_update_plot,
      {
        ggp = ggplot()

        if (1 %in% input$fun ) 
        { 
          ggp <- ggp + geom_line(mapping = aes(x, y=x^2), color="blue") 
        }

        if (2 %in% input$fun)  
        { 
          ggp <- ggp + geom_line(mapping = aes(x, y=x^2 + x), color="red") 
        }

        if (3 %in% input$fun) 
        { 
          ggp <- ggp + geom_line(mapping = aes(x, y=x^2 - x), color="green") 
        }

        ggp
      }
    )

    output$plot <- renderPlot({
      print("we are in output$plot <-  renderPlot({})")
      p()
    })  
  })
))

Answer 2

这是使用带有线的基本R绘图功能的解决方案。

library(shiny)
library(ggplot2)
x <-  seq(0, 10, by=0.1)

runApp(shinyApp(

  ui = shinyUI(fluidPage(
    titlePanel("Test Shiny"),
    sidebarLayout(
      sidebarPanel(
        checkboxGroupInput("fun", label = "Function", 
                           choices = list("function1: x^2" = 1, 
                                          "function2: x^2 + x" = 2, 
                                          "function3: x^2 - x" = 3),
                           selected = c(1))
      ),
      mainPanel(
        plotOutput("plot")
      )
    )
  )),

  server = shinyServer(function(input, output) {

    output$plot <- renderPlot({
      plot(NULL, xlim = c(0,10), ylim = c(0,100))
      if(1 %in% input$fun) lines(x=x, y=x^2, col=2)
      if(2 %in% input$fun) lines(x=x, y=x^2 + x, col=3)
      if(3 %in% input$fun) lines(x=x, y=x^2 - x, col=4)
    })  
  })
))

Answer 3

我已经考虑过一种方法。 在下面的代码中，checkboxGroupInput像以前一样具有选项“ function1”，“ function2”或“ function3”。 如果选中“功能1”和“功能2”，然后用户选中“功能3”，则仅会计算功能3。 在原始帖子的代码中，Shiny将计算所有三个函数。

checkboxGroupInput中的任何更改都会使所有这三个反应式表达式fn1 <- reactive({...}) ， fn2 <- reactive({...}) fn3 <- reactive({...}) fn2 <- reactive({...}) ， fn3 <- reactive({...}) fn2 <- reactive({...}) fn3 <- reactive({...})重新运行。

但是，在下面的新代码中，上面的每个反应式表达式（如果已经被检查）都将通过另一个反应式表达式返回缓存的值

我已经包含了打印语句，以表明选中或取消选中checkboxGroupInput中的一个框（“ function1”，“ function2”或“ function3”）不会导致Shiny重新计算所有选中的函数，就像上面我原始代码中所做的那样

我之前提到过使用单个复选框，因此我也提供了一个单个复选框“ relation4”的示例，以显示使用单个复选框checkboxInput（）不会导致其他反应式不必要地重新运行

NB观看打印到控制台的内容

library(shiny)
library(ggplot2)

runApp(shinyApp(

  ui = shinyUI(fluidPage(
    titlePanel("Test Shiny"),
    sidebarLayout(
      sidebarPanel(
        checkboxGroupInput("fun", label = "Function", 
                           choices = list("function1: x^2" = 1, 
                                          "function2: x^2 + x" = 2, 
                                          "function3: x^2 - x" = 3),
                           selected = c(1)),
        h5("A single checkbox"),
        checkboxInput("relation4", label = "relation4", value = FALSE)
      ),
      mainPanel(
        plotOutput("plot")
      )
    )
  )),

  server = shinyServer(function(input, output) {

    x <-  seq(0, 10, by=0.1)

    fn1.geom <- reactive({
      print("we are in fn1.geom <- reactive({})")
      geom_line(mapping = aes(x, y=x^2), color="blue")
    })
    fn1 <- reactive({
      print("we are in fn1 <- reactive({})")
      if (1 %in% input$fun ) { 
        fn1.geom()}
    })

    fn2.geom <- reactive({
      print("we are in fn2.geom <- reactive({})")
      geom_line(mapping = aes(x, y=x^2 + x), color="red") 
    })
    fn2 <- reactive({
      print("we are in fn2 <- reactive({})")
      if (2 %in% input$fun)  { 
        fn2.geom()}
    })

    fn3.geom <- reactive({
      print("we are in fn3.geom <- reactive({})")
      geom_line(mapping = aes(x, y=x^2 - x), color="green")
    })
    fn3 <- reactive({
      print("we are in fn3 <- reactive({})")
      if (3 %in% input$fun) { 
        fn3.geom() }
    })


    # using single checkbox input (checkboxInput() above)
    relation4.geom <- reactive({
      print("we are in relation4.geom <- reactive({})")
        list( geom_line(mapping = aes(x, y=x), color="orange"),
              geom_line(mapping = aes(x, y=6*x), color="purple"),
              geom_line(mapping = aes(x, y=11*x), color="violet") ) 
    })
    relation4 <- reactive({
      print("we are in relation4 <- reactive({})")
      if (input$relation4) {
        relation4.geom()
      }
    })


    output$plot <- renderPlot({
      cat("\n we are in output$plot <-  renderPlot({}) \n")
      ggplot() + fn1() + fn2() + fn3() + relation4() 
    })

  })
))