根据其输出更新滑块输入默认值

Posted 2023-03-24

【中文标题】根据其输出更新滑块输入默认值

【英文标题】：updating sliderinput default value based on its output

【发布时间】：2018-08-06 14:01:16

【问题描述】：

我无法弄清楚如何在闪亮中做到这一点： 我有几个变量（a、b、c），用户可以在它们之间进行选择（比如说使用 selectinput）。我有一个滑块输入来确定这个变量的权重。因此，如果选择了变量“a”，则滑块输入值将作为权重分配给该变量。到目前为止没有问题。当我更改我选择的变量（让我们说变量“b”）并且我想更新sliderinput显示的初始值是变量“b”的权重（而不是最后一个权重是变量“a”）时，问题就出现了）。我尝试了很多方法都无法理解它。底部的代码生成一个循环事件。

shinyUI(fluidPage(

  selectInput("SelectIndicator", "Select Indicator", choices = c("a", "b", "c"),

  sliderInput('SelectIndicatorWeight', 'Select Indicator Weight',
              min=1, max=4, value= weight_holder[,1], # initial value
              step=1, round=0)
))

shinyServer(function(input, output, session) 
observe(
  indic_selected <- input$SelectIndicator
  x <- which(colnames(weight_holder) == indic_selected)
  updatesliderinput(session, "SelectIndicator", value = weight_holder[,x]
  weight_holder[,x] <- input$SelectIndicatorWeight
)
)

【问题讨论】：

你能提供 weight_holder 对象吗？请注意，您可以使用 dput() 或创建一个简单的 data.frame 作为替代品。

【参考方案1】：

您可以使用reactiveVal 或reactiveValues 来存储权重，并使用observeEvents 来监听您的输入之一的变化。这是一个工作示例，希望对您有所帮助！

---

---

library(shiny)

# Values
my_object = c('a'=1,'b'=2,'c'=3)

ui <- fluidPage(

  selectInput("SelectIndicator", "Select Indicator", choices = c("a", "b", "c")),

  sliderInput('SelectIndicatorWeight', 'Select Indicator Weight',
              min=1, max=4, value= 1, # initial value
              step=1, round=0),

  tableOutput('mytable')
)


server <- function(input, output, session) 

  # initialize the weights
  my_weights = reactiveValues(a=1,b=1,c=1)

  # If selected element changes, then update the slider
  observeEvent(input$SelectIndicator, 
    selected_weight = my_weights[[input$SelectIndicator]]
    updateSliderInput(session, "SelectIndicatorWeight", value = selected_weight)
  )

  # If slider changes, update the weights reactiveValues  
  observeEvent(input$SelectIndicatorWeight,
               
                 my_weights[[input$SelectIndicator]] <- input$SelectIndicatorWeight
               )

  # Output the table
  output$mytable <- renderTable(
    weights = sapply(names(my_object),function(x) my_weights[[x]]) # get weights
    cbind(data.frame(my_object), weights) # create dataframe
  )



shinyApp(ui,server)