基于基于radioButtons的SliderTextInput的绘图

时间:2018-07-13 20:46:49

标签: r shiny

df描述:

反复对材料施加载荷,并在材料上的不同位置记录变形。每次重复持续1秒钟,下一次重复恰好在当前一次之后或休息时间之后。姓氏是按时间顺序记录的秒数。

每个df都有不同的负载率(10kN,20kN)。较高的负载在较低的负载之后开始,并且两个负载大致同时结束。

闪亮的描述:

我想拥有一个能够绘制材质变形的闪亮应用程序。用户通过单选按钮选择负载率,并通过滑块指定一秒钟的负载。滑块会根据所选的载荷进行更新,因为每个载荷都在不同的时间施加。

当用户更改负载选择时,滑块将显示其上次启用的最后一个值,然后将其更新为新df的第一个值(在“ selected = ...”下指定)。 由于新的df没有与以前的滑块值相同的名称,因此这会造成一个临时性的问题。更新滑块后,错误“已选择未定义的列”出现并迅速消失。然后显示正确的图

This topic可能有类似的问题,但是提供的所有解决方案均不适用于我。

def10

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

def20

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")
)

server.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?)

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

谢谢您的阅读和回答!

0 个答案:

没有答案