Question

我开发了一款闪亮的应用。但我不清楚如何验证textOutput中的文本。这里，textOutput显示求和后的最终值。所需条件是如果textOutput中的值正好为100，则textOutput的颜色应更改为某种颜色（例如aqua green）。如果该值超过100或者小于100，则颜色不应更改。

有没有可用的解决方案？

使用的 Rcode 如下：

require(shiny)

ui = fluidPage(
  fluidRow(
    column(3,numericInput("count", "No. of boxes",value = 3, min = 2, max = 10),actionButton("View","view")
    )
  ),
  fluidRow(uiOutput("inputGroup")),
  fluidRow(column(3,wellPanel(textOutput("text3"))))
)

# 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{0}
          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()
        if(output$text3 > 100){
        output$text = 0
      }
    })
}

shinyApp(ui=ui, server = server)

以上代码抛出运行时错误。任何人都可以帮我这个代码吗？

Answer 1

我已更新修复错误的代码。那个错误是因为你试图在闪亮的服务器中使用shinyobject。我改用了反应值。

require(shiny)

ui = fluidPage(
  fluidRow(
    column(3,numericInput("count", "No. of boxes",value = 3, min = 2, max = 10),actionButton("View","view")
    )
  ),
  fluidRow(uiOutput("inputGroup")),
  fluidRow(column(3,wellPanel(textOutput("text3"))))
)

# 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{0}
          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()
    if(getvalues() > 100){
      0
    }
    else(getvalues())

  })
}

shinyApp(ui=ui, server = server)

验证输出和更改颜色的代码：

require(shiny)
require(shinyjs)

ui = fluidPage( useShinyjs(),
                inlineCSS(list(.red   = "background-color: red")),


  fluidRow(
    column(3,numericInput("count", "No. of boxes",value = 3, min = 2, max = 10),actionButton("View","view")
    )
  ),
  fluidRow(uiOutput("inputGroup")),
  fluidRow(column(3,wellPanel(textOutput("text3"))))
)

# 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{0}
          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()
   # if(getvalues() > 100){
  #    0


   # }
    #else(getvalues())

    getvalues()

  })

  observeEvent(getvalues(), {
    nn <- getvalues()
    if(is.numeric(as.numeric(nn)) & !is.na(as.numeric(nn)) & nn == 100) {

      addClass("text3", 'red')

    } else  { removeClass('text3','red')}
  })

}

shinyApp(ui=ui, server = server)

截图：

在Rshiny中验证TextOutput中的数据

1 个答案: