在RShiny中动态启用和禁用ActionButton

时间:2017-11-22 06:35:57

标签: r shiny

我正在开发RShiny应用程序。有一个完整的按钮。它的ID是“提交”只有在填写某些详细信息时才应启用完整按钮。最初有三个数字输入。 ID是“current”“next”“next1”

数字输入的屏幕截图是:

enter image description here

在它之后,有三个选择输入。 ID是“sel1”“sel2”“sel3”

Selectize Input的截图是:

enter image description here

后来有三个textOutputs。 ID是“text2”“text3”“text4”。它应该是100%。为了获得100%,使用3 “反应性()”

这是使用的RCode。

    require(shiny)
require(shinyjs)
#install.packages("shinyjs")
ui = fluidPage( useShinyjs(),
                inlineCSS(list('.lightpink' = "background-color: lightpink",'.red'   = "background-color: red", "textarea" = 'text-align: center', '#text3 ' = 'text-align: center', '.form-control' = 'padding:8.5px ')),

                fluidRow(
                  column(3,numericInput("count", "No. of boxes",value = 3, min = 2, max = 10),actionButton("View","view")
                  ),
                  column(3, actionButton("submit", "Complete"))
                ),

                fluidRow(
                  column(3,tags$h3("Actual Work Hours")
                  ),
                  column(3, wellPanel(
                    numericInput("current", "Current Week",value = 40, min = 40, max = 80)
                  )),
                  column(3, wellPanel(
                    numericInput("next1", "Next Week", value = 40, min = 40, max = 80)
                  )),
                  column(3, wellPanel(
                    numericInput("next2", "Two weeks from now", value = 40, min = 40, max = 80)
                  ))),
                fluidRow(
                  column(3,tags$h3("About Your Work-Week")
                  ),
                  column(3, wellPanel(
                    selectizeInput("sel1", "How was your current week?",
                                   choices = c("aa",
                                               "bb",
                                               "cc"),
                                   options = list(
                                     placeholder = "Current week",
                                     onInitialize = I('function() { this.setValue(""); }')
                                   )))),
                  column(3, wellPanel(
                    selectizeInput("sel2", "How busy will be the next week?",
                                   choices = c("aa",
                                               "bb",
                                               "cc"),
                                   options = list(
                                     placeholder = "Next week",
                                     onInitialize = I('function() { this.setValue(""); }')
                                   )))),
                  column(3, wellPanel(
                    selectizeInput("sel3", "How busy will be the next two weeks?",
                                   choices = c("aa",
                                               "bb",
                                               "cc"),
                                   options = list(
                                     placeholder = "Next two week",
                                     onInitialize = I('function() { this.setValue(""); }')
                                   ))))),
                fluidRow(uiOutput("inputGroup")),
                fluidRow(column(3,wellPanel(textOutput("text3")),
                                tags$head(tags$style("#text3{color: white;
                                                     font-style: italic;
                                                     }"
                         )
                                )))
)
# takes in two arguments
sumN <- function(a, x){
  a <- sum(a, as.numeric(x),na.rm=T)
  return(a)
}
server <- function(input, output, session) {
  Widgets <- eventReactive(input$View,{ input_list <- lapply(1:(input$count),
                                                             function(i) {
                                                               inputName <- paste("id", i, sep = "")
                                                               textInputRow <- function (inputId,value) {
                                                                 textAreaInput(inputName,"", width = "200px", height = "43px", resize = "horizontal" )
                                                                 #numericInput(inputName,"",1,0,100)
                                                               }
                                                              column(4,textInputRow(inputName, "")) })
  do.call(tagList, input_list)},ignoreInit = T)
  output$inputGroup = renderUI({Widgets()})
  getvalues <- reactive({
    val <- 0
    for(lim in 1:input$count){
      observeEvent(input[[paste0("id",lim)]], { 
        updateTextAreaInput(session,paste0("id",lim), value = ({
          x =  as.numeric(input[[paste0("id",lim)]])
          if(!(is.numeric(x))){0}
          else if(!(is.null(x) || is.na(x))){
            if(x < 0){
              0 
            }else if(x > 100){
              100
            } else{
              return (isolate(input[[paste0("id",lim)]]))
            } 
          } 
          else if((is.null(x) || is.na(x))){
            0
          } 
        })
        )
      })
      req(as.numeric(input[[paste0("id",lim)]]) >= 0 & as.numeric(input[[paste0("id",lim)]]) <= 100)
      val <- sumN(val,as.numeric(input[[paste0("id",lim)]]))
    }
    val
  })
  output$text3 <- renderText({
    getvalues()
  })
  observeEvent(getvalues(), {
    nn <- getvalues()
    if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn)) & nn == 100) {

      removeClass("text3", 'red')
      addClass('text3','lightpink')

    } else  { addClass('text3','red')}
  })
}
shinyApp(ui=ui, server = server)

上述代码不会产生所需的输出。简而言之,只有在填充数字输入,选择输入并且textOutput应为100%时,才应启用“完成”按钮。任何人都可以为这个问题提供解决方案吗?

1 个答案:

答案 0 :(得分:0)

使用disable的{​​{1}}和enable更新了代码,并考虑了工作周选择的条件。

shinyjs