Conditional color for reactive inputs (negative red, positive blue)

[Zappageck]

Hi

I'd like to display the number that was input in a color depending on the sign of the input (negative red, positive blue).
However this seems more difficult than anticipated. The problem seems to be that there's actually no number passed but a list:
"Error in tag("div", list(...)) :
(list) object cannot be coerced to type 'double'"

Also the same id cannot be called multiple times as would be necessary for the if condition and then again for the display.

I'm sure there are also other ways. I'd appreciate if you could share your solutions to this problem.

Example code:

library(shiny)
library(shinydashboard)

server <- function(input,output,session) {
  output$val1<-renderText({input$testinput})
}

#Elements of the UI:
header<-dashboardHeader(title = "Coloring_Test",titleWidth = 280)
sidebar<-dashboardSidebar(width = 280,sidebarMenu(id="sidebar_tabs",
                                                  menuItem("AAA", tabName = "AAA")
                                                  ))

body<-dashboardBody(title="Main",
                    tabItem(tabName = "Overview",h1("Overview"),
                      fluidPage(
                      box(sliderInput(inputId = "testinput",label="testinput",min=-30,max=20,value=5)),
# Code with coloring                       
box(title="Output",tags$p(textOutput(outputId="val1", inline=TRUE),style="color:#1E90FF")) 
                      # ,
# Code with condition, which does not work
                      # box(title="Output",if(textOutput(outputId="val1")>=0){tags$p("IF",style="color:#1E90FF")}else{tags$p("ELSE",style="color:#ff5733")})  # Condition
                    )                  
                    )
                    )

ui <- dashboardPage(skin = "black", header, sidebar, body)

shinyApp(ui = ui, server = server)

[veegpap]

One way to achieve this is to get a UI output from the server side of your app. Try this :

library(shiny)
library(shinydashboard)

server <- function(input,output,session) {
  output$val1<-renderUI({
    if(input$testinput >=0 ) { 
      a <- paste("<span style=color:#1E90FF>", input$testinput, "-  my number is blue", "</span>")
    } else{
      a <- paste0("<span style=color:#ff5733>", input$testinput, "-  my number is red", "</span>")
    }
    HTML(a)
  })
}

#Elements of the UI:
header<-dashboardHeader(title = "Coloring_Test",titleWidth = 280)
sidebar<-dashboardSidebar(width = 280,sidebarMenu(id="sidebar_tabs",
                                                  menuItem("AAA", tabName = "AAA")
))

body<-dashboardBody(title="Main",
                    tabItem(tabName = "Overview",h1("Overview"),
                            fluidPage(
                              box(sliderInput(inputId = "testinput",label="testinput",min=-30,max=20,value=5)),
                              # Code with coloring                       
                              box(title="Output",uiOutput("val1")) 
                              )                  
                    )
)

ui <- dashboardPage(skin = "black", header, sidebar, body)

shinyApp(ui = ui, server = server)

[Zappageck]

Thank you a lot, veegpap.

I also found a second way which I wanted to share. I guess yours is better or at least easier. In the sample codes, both solutions work - once for testinput 1 and once for testinput 2:

coloring <- function(x) {
  testinput <- x
  if(is.numeric(as.numeric(testinput)) & !is.na(as.numeric(testinput))) {
    ## Clean up any previously added color classes
    removeClass("elementcolor", "blue")
    removeClass("elementcolor", "red")
    ## Add the appropriate class
    cols <- c("red", "blue") # Order of colors according to intervals
    col <- cols[cut(testinput, breaks=c(-Inf, -0.00001, Inf))]
    addClass("elementcolor", col)
  } else  {}
  }

server <- function(input,output,session) {
  
  output$testinput1<-renderText({input$testinput1})
  
  # observeEvent(input$testinput, setColor(id = "testinput", val = input$testinput))
  
  observeEvent(input$testinput1, {
    
    coloring(input$testinput1)
  
    output$testinput2<-renderUI({
      if(input$testinput2 >=0 ) { 
        a <- paste("<span style=color:#1E90FF>", input$testinput2, "-  my number is blue", "</span>")
      } else{
        a <- paste0("<span style=color:#ff5733>", input$testinput2, "-  my number is red", "</span>")
      }
      HTML(a)
    })
    
    
  })

}



header<-dashboardHeader(title = "Coloring_Test",titleWidth = 280)

sidebar<-dashboardSidebar(width = 280,sidebarMenu(id="sidebar_tabs",
                                                  menuItem("AAA", tabName = "AAA")
                                                  ))


body<-dashboardBody(title="Main",useShinyjs(),  ## Set up shinyjs
                    # extendShinyjs(text = jsCode),
                    ## Add CSS instructions for three color classes
                    inlineCSS(list(.blue   = "color: blue",
                                   .red  = "color: red")),
                      tabItem(tabName = "Overview",h1("Overview"),
                      fluidPage(
                      box(sliderInput(inputId = "testinput1",label="testinput1",min=-30,max=20,value=5)),
                      box(sliderInput(inputId = "testinput2",label="testinput2",min=-30,max=20,value=5)),
                      box(title="Output1",span(id="elementcolor",textOutput(outputId="testinput1", inline=TRUE))),
                      box(title="Output2",uiOutput("testinput2"))
{tags$p("IF",style="color:#1E90FF")}else{tags$p("ELSE",style="color:#ff5733")})  # does not work :
                    )                  
                    )
                    )

ui <- dashboardPage(skin = "black",
                        header,
                        sidebar,
                        body
)

shinyApp(ui = ui, server = server)