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

Question

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

作为旁注，假设在我的服务器中有第三个函数在单击操作按钮（无论是否有复选框）时生成绘图。有没有一种方法可以对我的“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

模态运行良好，因为这两个功能花费的时间都很短运行它创造了一种感觉，而不是应该的感觉。我们可以通过添加一个 sys.sleep 来模拟长时间计算来显示这一点。

关于复选框，使用 conditionalPanel 将独立于服务器内部是否存在 isolate 来隐藏或显示绘图。解决方法是在未单击复选框时 return 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)

Answer 2

也许你应该使用 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 3

离开conditionalPanel-方法，这是指讨论:

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)

此外，请参阅。

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

R shiny - checkboxes and action button combination issue

checkbox

r

shiny

shinydashboard