Question

我有一个带有两个不同标签面板的闪亮仪表板应用程序。每个选项卡具有不同的输入值，并且当单击操作按钮时，它们都将生成图形。

每当我在这些选项卡之间切换时，它们各自的图形就会消失，并且输入值会重置为默认值。

即使用户决定在面板之间进行切换，我也希望将标签保持在用户修改的状态（即同时保留图形和输入）。

代码

library(shiny)
library(shinydashboard)


ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = "DASHBOARD"),

    dashboardSidebar(
      uiOutput("mysidebar"),
    ),

    dashboardBody(
      tabsetPanel(type = "tabs", id = "tab", 
                  tabPanel("Tab1", fluid = TRUE, value = 1,plotOutput("A")),
                  tabPanel("Tab2", fluid = TRUE, value = 2, plotOutput("B"))
      )
    )
  )

)

server <- function(input, output, session){
  output$mysidebar <- renderUI({

    if(input$tab == 1){
      tagList(
        sliderInput(inputId = "Sample",
                    label = "Enter Number of Samples:",
                    min = 1000, max = 100000,
                    value = 10000),
        fluidRow(
          column(6,
                 actionButton(inputId = "b1", label = "Generate"))
        )}

    if(input$tab == 2){
      tagList(
        sliderInput(inputId = "Weight",
                    label = "Enter Weight:",
                    value = 100),
        fluidRow(
          column(6,
                 actionButton(inputId = "b2", label = "Generate"))
        )}

    p1<- eventReactive(input$b1, {
      #creating a dataframe using input "Sample" in tab1 - Rough example
      df <- input$Sample

    })
    output$SA <- renderPlot({

        plot(df)

    })

    p2 <- eventReactive(input$b2, {
      #creating a dataframe using input "Weight" in tab2-- Rough example
      df2 <- input$Weight

    })
    output$A <- renderPlot({

      plot(p1())

    })
   output$B <- renderPlot({

      plot(p2())

    })
}

Answer 1

我宁愿您像下面的示例一样在show包中使用hide和shinyjs功能，这样当您在选项卡之间切换时

library(shiny)
library(shinyjs)
library(shinydashboard)


ui <- fluidPage(
  dashboardPage(
    dashboardHeader(title = "DASHBOARD"),

    dashboardSidebar(
      useShinyjs(),
      sliderInput("Sample","Enter Number of Samples:",min = 1000, max = 100000,value = 10000),
      sliderInput("Weight","Enter Weight:",min = 1, max = 1000,value = 100),
      fluidRow(column(6,actionButton("b1","Generate"),actionButton("b2","Generate")))
    ),

    dashboardBody(
      tabsetPanel(type = "tabs", id = "tab", 
                  tabPanel("Tab1", fluid = TRUE, value = 1,plotOutput("A")),
                  tabPanel("Tab2", fluid = TRUE, value = 2, plotOutput("B"))
      )
    )
  )

)

server <- function(input, output, session){

  observe({
    if(input$tab == 1){
      show("Sample")
      show("b1")
      hide("Weight")
      hide("b2")
    }
    if(input$tab == 2){
      hide("Sample")
      hide("b1")
      show("Weight")
      show("b2")
    }
  })

  p1<- eventReactive(input$b1,{
    df <- rnorm(input$Sample)
  })
  output$SA <- renderPlot({
    plot(df)
  })

  p2 <- eventReactive(input$b2,{
    df2 <- rnorm(input$Weight)
  })

  output$A <- renderPlot({plot(p1())})
  output$B <- renderPlot({plot(p2())})
}

shinyApp(ui, server)

Answer 2

以下代码通过使用reactiveValues来保留图形和输入。

library(shiny)
library(shinydashboard)


ui <- dashboardPage(dashboardHeader(title = "DASHBOARD"),

                    dashboardSidebar(
                      uiOutput("mysidebar")
                    ),

                    dashboardBody(
                      tabsetPanel(type = "tabs", id = "tab",
                                  tabPanel("Tab1",  value = 1,plotOutput("SA")),
                                  tabPanel("Tab2",  value = 2, plotOutput("SA1"))
                      )
                    )
)


server <- function(input, output, session){

  slider_react <- reactiveValues(b1=10000, b2 = 100)

  observe({
    if (input$tab == 1){
      output$mysidebar <- renderUI({
        tagList(
          sliderInput(inputId = "Sample",
                      label = "Enter Number of Samples:",
                      min = 1000, max = 100000,
                      # value = 10000),
                      value = slider_react$b1),
          actionButton(inputId = "b1", label = "Generate"))
      })
    }

    if(input$tab == 2){
      output$mysidebar <- renderUI({
        tagList(
          sliderInput(inputId = "Weight",
                      label = "Enter Weight:",
                      min=0, max=1000,
                      # value = 100),
                      value = slider_react$b2),
          actionButton(inputId = "b2", label = "Generate"))
      })
    }
  })


  df_react <- reactiveValues(a1=NULL, a2=NULL)

  p1<- observeEvent(input$b1, {
    #creating a dataframe using input "Sample" in tab1 - Rough example
    df <- runif(input$Sample, 0, 100)
    slider_react$b1 = input$Sample
    df_react$a1 = df
  })
  p2 <- observeEvent(input$b2, {
    #creating a dataframe using input "Weight" in tab2-- Rough example
    df2 <- runif(input$Weight, 0, 100)
    slider_react$b2 = input$Weight
    df_react$a2 = df2
  })

  output$SA <- renderPlot({
    req(df_react$a1)
    plot(df_react$a1)
  })

  output$SA1 <- renderPlot({
    req(df_react$a2)
    plot(df_react$a2)

  })
}

shinyApp(ui, server)

在选项卡之间切换时保持图和输入值

2 个答案: