问题
I have developed a shiny app. But I am not clear about how to validate the text in textOutput. Here, textOutput displays the final value after summing. The required condition is if the value in textOutput is exactly 100, the color of the textOutput should be changed to some color (say aqua green). If the value exceeds above 100 or if it is less than 100, the color should not change.
Is there any solution available for this?
The Rcode used is as follows :
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)
The above code throws Runtime error. Can anyone help me with this code?
回答1:
I've updated the code fixing the error. That error was because you were trying to use shinyobject inside shiny server. I've used the reactive values instead.
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)
Code to validate the output and changing color:
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)
Screenshot:
来源：https://stackoverflow.com/questions/47017520/validating-the-data-in-textoutput-in-rshiny