r - 基于基于单选按钮的 SliderTextInput 绘图

Question

df 说明：

反复向材料施加载荷，并在材料的不同位置记录变形。每次重复持续 1 秒，下一次重复是在当前重复之后或休息时间之后。Colnames 是按时间顺序记录的秒数。

每个 df 具有不同的负载率（10kN、20kN）。较高的负载在较低的负载之后开始，并且两者大致同时结束。

闪亮说明：

我想要一个闪亮的应用程序来绘制材料的变形。用户通过单选按钮选择加载速率，并通过滑块选择加载的特定秒数。滑块会根据所选负载更新，因为每个负载在不同时间应用。

当用户更改负载选择时，滑块会显示其上一个值，然后将其更新为新 df 的第一个值（如“selected = ...”下指定）。这会产生一个临时问题，因为新的 df 没有与先前滑块值的 colname。更新滑块后，错误“未定义的列已选择”出现并迅速消失。然后显示正确的图

这个主题可能有类似的问题，但所有提供的解决方案都不适用于我。

定义10

loc    1      2      21      22     45     46
0      -100   -95    -99     -94    -122   -110
200    -90    -88    -87     -84    -113   -106
400    -81    -70    -76     -73    -98    -94
600    -62    -59    -65     -61    -87    -83

定义20

loc    33     34     40      41     46     47
0      -144   -139   -141    -137   -142   -133
200    -134   -130   -132    -128   -131   -124
400    -122   -118   -120    -115   -121   -114
600    -111   -106   -108    -103   -107   -100

ui.R:

ui <- fluidPage(
  radioButtons(inputId = "Load", 
               label = "Select Load",
               choices = list("10kN" = 10, 
                              "20kN" = 20),
               selected = 10),
               
  uiOutput("sliderCycle"),
  
  plotOutput("defPlot")
)

服务器.R：

shinyServer <- function(input, output) {
  
  output$sliderCycle <- renderUI({
    if (input$Load == 10) {
      sliderTextInput(inputId = "sliderCycle",
                      label = NULL,
                      choices = colnames(def10[,2:ncol(def10)]),
                      selected = names(def10)[2])}
    else if (input$Load == 20) {
      sliderTextInput(inputId = "sliderCycle",
                      label = NULL,
                      choices = colnames(def20[,2:ncol(def20)]),
                      selected = names(def20)[2])}
  })
  
  dfStatLoad <- reactive({
    if (input$Load == 10) {
      def10}
    else if (input$Load == 20) {
      def20}
  })
  
  defData <- reactive({
    data.frame(location = dfStatLoad()$loc, deformation = dfStatLoad()[,input$sliderCycle])
  })

  output$defPlot <- renderPlot({
    # the slider is NULL at first
    validate( 
      need(input$sliderCycle, "loading data...")) 
    ggplot(defData(), aes(location, deformation)) +
      geom_point() +
      geom_line()
   })

  # to check what values I get in the console
  checkcon <- reactive({
    print(input$Load) 
    print(input$sliderCycle)
  }) 
  observe(print(checkcon()))

}

控制台打印以下内容：

[1] "10" # run app
NULL     # slider is empty
NULL     # again (why?)
[1] "10" # again Load choice
[1] "1"  # updated slider value
[1] "1"  # again (why?)
[1] "20" # user chooses "20kN"
[1] "1"  # previous slider value
[1] "1"  # again (why?)
[1] "20" # again Load choice
[1] "33" # updated slider value
[1] "33" # again (why?)

为什么滑块有双输入？为什么不立即更新？

感谢您的阅读和回答！

标签： rshiny