如何使滑块输入独立于内部的反应变量？

Question

在这个闪亮的应用程序中，3 个 selectInputs 是链接的，如果我们在第一个 selectInput 中选择一个国家，选择的国家不会出现在第二个中，第三个也是一样的。 未选择的 2 个国家出现在滑块输入的标签中（反应变量） 当您盯着滑块输入，并在上面的 selectInputs 中修改任何国家/地区时，sliderInput 不会保留先前选择的值。

我的问题是，如何保持滑块输入独立于修改 selectInput？感谢您的帮助

ui <- fluidPage(
  sidebarLayout(
    
    sidebarPanel(
      uiOutput("BoxLPbilan"),
      uiOutput("BoxLPX"),
      uiOutput("BoxLPY"),
      uiOutput("Balance_country1"),
      uiOutput("Balance_country2")
    ),
    mainPanel (
      
    )
  )
)

server <- function(input, output) {

  countries<-reactive({
    c('FR','DE','BE','NL','AT')
  })
  output$BoxLPbilan <- renderUI({
    # as.character: to get names of levels and not a numbers as choices in case of factors
    selectInput("countrybilan",label = tags$span(style="color: blue;","Select the balance country") ,countries())
  })
  liste_paysX <- reactive (
    {
      w=countries()
      sort(w[!w %in% input$countrybilan])
    })
  
  output$BoxLPX <- renderUI({
    # as.character: to get names of levels and not a numbers as choices in case of factors
    selectInput("countryX", label = tags$span(style="color: red;","Select the country of the X axis"),liste_paysX())
  })
  
  liste_paysY <- reactive (
    {
      w=countries()
      w=(w[!w %in% input$countrybilan])
      sort(w[!w %in% input$countryX])
    })
  
  output$BoxLPY <- renderUI({
    # as.character: to get names of levels and not a numbers as choices in case of factors
    selectInput("countryY", label = tags$span(style="color: red;","Select the country of the Y axis"),liste_paysY())
  })
  
  remaining_countries <- reactive (
    {
      w=countries()
      w=(w[!w %in% input$countrybilan])
      w=(w[!w %in% input$countryX])
      sort(w[!w %in% input$countryY])
      
    })

  output$Balance_country1 <- renderUI({
    sliderInput(inputId = "remaining_country1",
                paste(remaining_countries()[1]," balance"),
                min = -10000,
                max = 10000,
                step = 100,
                value = 0)
    
  })
  
  output$Balance_country2 <- renderUI({
    
    sliderInput(inputId = "remaining_country2",
                paste(remaining_countries()[2]," balance"),
                min = -10000,
                max = 10000,
                step = 100,
                value = 0)
    
  })
  
 
}

shinyApp(ui = ui, server = server)
    

Answer 1

您可以使用以下技巧 -

创建一个reactiveValues 来存储sliderInput 的当前值，并将sliderInput 的默认值作为存储值传递。

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    
    sidebarPanel(
      uiOutput("BoxLPbilan"),
      uiOutput("BoxLPX"),
      uiOutput("BoxLPY"),
      uiOutput("Balance_country1"),
      uiOutput("Balance_country2")
    ),
    mainPanel (
      
    )
  )
)

server <- function(input, output) {
  
  rv <- reactiveValues(val1 = 0, val2 = 0)
  
  countries<-reactive({
    c('FR','DE','BE','NL','AT')
  })
  output$BoxLPbilan <- renderUI({
    # as.character: to get names of levels and not a numbers as choices in case of factors
    selectInput("countrybilan",label = tags$span(style="color: blue;","Select the balance country") ,countries())
  })
  liste_paysX <- reactive (
    {
      w=countries()
      sort(w[!w %in% input$countrybilan])
    })
  
  output$BoxLPX <- renderUI({
    # as.character: to get names of levels and not a numbers as choices in case of factors
    selectInput("countryX", label = tags$span(style="color: red;","Select the country of the X axis"),liste_paysX())
  })
  
  liste_paysY <- reactive (
    {
      w=countries()
      w=(w[!w %in% input$countrybilan])
      sort(w[!w %in% input$countryX])
    })
  
  output$BoxLPY <- renderUI({
    # as.character: to get names of levels and not a numbers as choices in case of factors
    selectInput("countryY", label = tags$span(style="color: red;","Select the country of the Y axis"),liste_paysY())
  })
  
  remaining_countries <- reactive (
    {
      w=countries()
      w=(w[!w %in% input$countrybilan])
      w=(w[!w %in% input$countryX])
      sort(w[!w %in% input$countryY])
      
    })
  
  
  output$Balance_country1 <- renderUI({
    sliderInput(inputId = "remaining_country1",
                paste(remaining_countries()[1]," balance"),
                min = -10000,
                max = 10000,
                step = 100,
                value = rv$val1)
    
  })
  
  output$Balance_country2 <- renderUI({
    
    sliderInput(inputId = "remaining_country2",
                paste(remaining_countries()[2]," balance"),
                min = -10000,
                max = 10000,
                step = 100,
                value = rv$val2)
    
  })
  
  
  observe({
    req(input$remaining_country1, input$remaining_country2)
    rv$val1 <- input$remaining_country1
    rv$val2 <- input$remaining_country2
  })
  
}

shinyApp(ui = ui, server = server)