Question

我想在mainPanel基础上更新表的值滑块的值。以下是我的代码 -

    library(shiny)

    ui <- shinyUI(fluidPage(
      sidebarPanel(
selectInput(inputId="Zone", label="Choose Forecasting Zone:",choices = list("North", "South")),
wellPanel( 
    conditionalPanel(
      condition = "input.Zone == 'North'",
      sliderInput("num1", "No of Sellers:",0,3500,value = c(2877,3277),step=1),
      sliderInput("num3", "Activation Percentage:",0,1,value = c(0.25,0.32),step=0.01),
      sliderInput("num5", "Case Size:",0,200000,value = c(60000,75000),step=1),
      sliderInput("num7", "Case Rate:",0,4,value = c(1.34,1.45),step=0.01)
    ),
    conditionalPanel(
      condition = "input.Zone == 'South'",
      sliderInput("num1", "No of Sellers:",0,3500,value = c(1008,1148),step=1),
      sliderInput("num3", "Activation Percentage:",0,1,value = c(0.26,0.32),step=0.01),
      sliderInput("num5", "Case Size:",0,200000,value = c(70000,80000),step=1),
      sliderInput("num7", "Case Rate:",0,4,value = c(1.15,1.22),step=0.01)
    ),
  actionButton("sumbit", "Submit")
  )
),
      mainPanel("",htmlOutput("ValueTable"))
      )
    )

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

      aab <- reactive({
input$sumbit
isolate({
  a1<-cbind(input$num1[1],input$num1[2])
  a2<-cbind(input$num3[1],input$num3[2])
  a3<-cbind(input$num5[1],input$num5[2])
  a4<-cbind(input$num7[1],input$num7[2])

  aa<-cbind(input$Zone,a1,a2,a3,a4)
  aa
})
      })
      output$ValueTable <- renderUI({
input$sumbit
isolate({
  aa<-aab()
  aa<-as.data.frame(aa)
  output$aa1 <- renderDataTable(aa,options = list(paging = FALSE,searching = FALSE,info=FALSE,autowidth=TRUE))
  dataTableOutput("aa1")
})
      })
    }

    shinyApp(ui, server)

因此，当我选择Zone为North并按Submit时，它会显示正确的值。但是当我选择Zone为South时，滑块会更改基础条件面板，但表中的值仍然适用于North。

我该如何解决这个问题？

由于

Answer 1

如果我按下提交按钮，表格中的值会更新，无论我是在北方还是南方。您的aab()在submit按钮上被激活而在滑块上无效。当我不按提交时，加载应用程序并在Zone North中移动滑块也不会更新数据。

您隔离了其他控件，因此在更改滑块时不会激活反应部件。

此外，您对两个条件面板（num1 num3 num5和num7）使用了相同的名称。您应该重命名南输入，并在aab()中有条件地创建结果。

Answer 2

这是解决方案 -

    library(shiny)

    ui <- shinyUI(fluidPage(
      sidebarPanel(
selectInput(inputId="Zone", label="Choose Forecasting Zone:",choices = list("North", "South")),
sliderInput("num1", "No of Sellers:",0,3500,value = c(2877,3277),step=1),
sliderInput("num3", "Activation Percentage:",0,1,value = c(0.25,0.32),step=0.01),
sliderInput("num5", "Case Size:",0,200000,value = c(60000,75000),step=1),
sliderInput("num7", "Case Rate:",0,4,value = c(1.34,1.45),step=0.01),
actionButton("sumbit", "Submit")
      ),
      mainPanel("",htmlOutput("ValueTable"))
    )
    )

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

      observeEvent(input$Zone,{
if (input$Zone=="North"){
  updateSliderInput(session, "num1", value = c(2877,3277))
  updateSliderInput(session, "num3", value = c(0.25,0.32))
  updateSliderInput(session, "num5", value = c(60000,75000))
  updateSliderInput(session, "num7", value = c(1.34,1.45))
}
else  {}
      })
      observeEvent(input$Zone,{
if (input$Zone=="South"){
  updateSliderInput(session, "num1", value = c(1008,1148))
  updateSliderInput(session, "num3", value = c(0.26,0.32))
  updateSliderInput(session, "num5", value = c(70000,80000))
  updateSliderInput(session, "num7", value = c(1.15,1.22))
}
else  {}
      })

      aab <- reactive({
input$sumbit
isolate({
  a1<-cbind(input$num1[1],input$num1[2])
  a2<-cbind(input$num3[1],input$num3[2])
  a3<-cbind(input$num5[1],input$num5[2])
  a4<-cbind(input$num7[1],input$num7[2])

  aa<-cbind(input$Zone,a1,a2,a3,a4)
  aa
})
      })
      output$ValueTable <- renderUI({
input$sumbit
isolate({
  aa<-aab()
  aa<-as.data.frame(aa)
  output$aa1 <- renderDataTable(aa,options = list(paging = FALSE,searching = FALSE,info=FALSE,autowidth=TRUE))
  dataTableOutput("aa1")
        })
      })
    }

    shinyApp(ui, server)

操作按钮不会更新sliderinput值

2 个答案: