R闪亮 - 复选框和操作按钮组合问题

Question

我有 2 个复选框和 1 个操作按钮。单击任一复选框时，图形应仅在单击操作按钮后才输出。我下面的代码已经很好地做到了。我的问题是，一旦单击操作按钮并生成图形，取消单击复选框就会删除图形。同样，再次单击会生成一个新图形，而无需单击操作按钮。只要我不再单击操作按钮，我希望图表一直留在屏幕上。我想这与“隔离”复选框有关，但我不太确定该怎么做。

作为旁注，想象一下当单击操作按钮（不管复选框）时，我的服务器中有第三个函数会生成一个绘图。有没有办法对我的“showmodal，removemodal”进行编码，以便在所有功能运行时（而不是仅在第一个功能期间）弹出窗口？

这是我的代码

library(shiny)

#Function 1
X <- function(a,b,c){
    plot(c(a,b),c(b,c))
}

#Function 2
Y <- function(d,e,f){
    plot(c(d,e),c(e,f))
}

ui <- fluidPage(
    
    titlePanel("title"),
    
    sidebarLayout(
        sidebarPanel(
            checkboxInput("EF", "Efficient Frontier"),
            checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
            actionButton("Go", "Go", style="color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
        ),
        
        mainPanel(
            fluidRow(
                align = "center",
                conditionalPanel(condition = "input.EF == true", plotOutput("GraphEF")),
                conditionalPanel(condition = "input.MonteCarlo == true", plotOutput("GraphMC"))
            )
        )
    )
)

server <- function(input, output) {
    
    OPw <- reactiveValues()
    output$Graphw <- renderPlot({ 
        OPw$PC}, height = 400, width = 400)
    
    observeEvent(input$Go, {
        showModal(modalDialog("Loading... Please Wait", footer=NULL)) 
    
        output$GraphEF <- renderPlot({ #Efficient Frontier
            if(input$EF){
                X(5,10,15)
            }
        }, height = 550, width = 700)
        
        output$GraphMC <- renderPlot({ #Monte Carlo Simulation
            if(input$MonteCarlo){
                Y(5,10,15)
            }
        },height = 550, width = 700)
        
        removeModal() #Removes Loading Pop-up Message
        
        
    })
}

shinyApp(ui = ui, server = server)

非常感谢您的帮助！

Answer 1

也许你应该使用eventReactive()。试试这个

library(shiny)

# Function 1
X <- function(a, b, c) {
  plot(c(a, b), c(b, c))
}

# Function 2
Y <- function(d, e, f) {
  plot(c(d, e), c(e, f))
}

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
      actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
    ),
    mainPanel(
      fluidRow(
        align = "center", 
        uiOutput("plot1"),
        plotOutput("GraphMC")
      )
    )
  )
)

server <- function(input, output) {

  GEF <- eventReactive(input$Go, {
    if (input$EF) {
      X(5, 10, 15)
    } else {
      NULL
    }
  })
  
  showme <- eventReactive(input$Go, {
    if (input$EF) TRUE else FALSE
  })

  GMC <- eventReactive(input$Go, {
    if (isolate(input$MonteCarlo)) {
      Y(5, 10, 15)
    } else {
      NULL
    }
  })
  
  output$GraphMC <- renderPlot({
    GMC()
  })
  
  output$GraphEF <- renderPlot({ # Efficient Frontier
    GEF()
  })
  
  output$plot1 <- renderUI({
    if (showme()) {plotOutput("GraphEF")} else NULL
  })

  observeEvent(input$Go, {
    showModal(modalDialog("Loading... Please Wait", footer = NULL))

    Sys.sleep(2)
    
    removeModal() # Removes Loading Pop-up Message
  })

}

shinyApp(ui = ui, server = server)

Answer 2

留下一个conditionalPanel-approach，指的是讨论over here：

library(shiny)

# Function 1
X <- function(a, b, c) {
  plot(c(a, b), c(b, c))
}

# Function 2
Y <- function(d, e, f) {
  plot(c(d, e), c(e, f))
}

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
      actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
    ),
    mainPanel(
      fluidRow(
        align = "center", 
        conditionalPanel("output.showme == true", plotOutput("GraphEF")),
        plotOutput("GraphMC")
      )
    )
  )
)

server <- function(input, output) {
  
  GEF <- eventReactive(input$Go, {
    if (input$EF) {
      X(5, 10, 15)
    } else {
      NULL
    }
  })
  
  output$showme <- eventReactive(input$Go, {
    if (input$EF) TRUE else FALSE
  })
  outputOptions(output, "showme", suspendWhenHidden = FALSE)
  
  GMC <- eventReactive(input$Go, {
    if (isolate(input$MonteCarlo)) {
      Y(5, 10, 15)
    } else {
      NULL
    }
  })
  
  output$GraphMC <- renderPlot({
    GMC()
  })
  
  output$GraphEF <- renderPlot({ # Efficient Frontier
    GEF()
  })
  
  observeEvent(input$Go, {
    showModal(modalDialog("Loading... Please Wait", footer = NULL))
    
    Sys.sleep(2)
    
    removeModal() # Removes Loading Pop-up Message
  })
  
}

shinyApp(ui = ui, server = server)

另外，请看this related answer。

Answer 3

模态运行良好，因为这两个函数运行时间都很短，它所产生的感觉比它应有的要少。我们可以通过添加sys.sleep 来模拟长计算来证明这一点。

关于复选框，使用conditionalPanel 将隐藏或显示绘图，而与服务器内部isolate 的存在无关。解决方法是在未单击复选框时返回NULL。

library(shiny)

# Function 1
X <- function(a, b, c) {
  plot(c(a, b), c(b, c))
}

# Function 2
Y <- function(d, e, f) {
  plot(c(d, e), c(e, f))
}

ui <- fluidPage(
  titlePanel("title"),
  sidebarLayout(
    sidebarPanel(
      checkboxInput("EF", "Efficient Frontier"),
      checkboxInput("MonteCarlo", "Monte Carlo Simulation"),
      actionButton("Go", "Go", style = "color: #fff; background-color: #337ab7; border-color: #2e6da4; margin: auto")
    ),
    mainPanel(
      fluidRow(
        align = "center",
        plotOutput("GraphEF"),
        plotOutput("GraphMC")
      )
    )
  )
)

server <- function(input, output) {
  OPw <- reactiveValues()
  output$Graphw <- renderPlot(
    {
      OPw$PC
    },
    height = 400,
    width = 400
  )

  observeEvent(input$Go, {
    showModal(modalDialog("Loading... Please Wait", footer = NULL))

    output$GraphEF <- renderPlot(
      { # Efficient Frontier
        if (isolate(input$EF)) {
          X(5, 10, 15)
        } else {
          NULL
        }
      },
      height = 550,
      width = 700
    )
    Sys.sleep(2)
    output$GraphMC <- renderPlot(
      { # Monte Carlo Simulation
        if (isolate(input$MonteCarlo)) {
          Y(5, 10, 15)
        } else {
          NULL
        }
      },
      height = 550,
      width = 700
    )

    removeModal() # Removes Loading Pop-up Message
  })
}

shinyApp(ui = ui, server = server)