0

When we have a all missing columns in the data frame, typically we don't want the user to select them to plot. There are many ways to do this but is it possible to let the items in the selectInput have conditional colors.

For example, how to let all missing column names (like the var2 column in my sample code) in the selectInput item list go grey. In other words, how to rewrite the selectInput for us to pass in a indicator vector for the conditional formatting.

library(shiny)

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

  DATA = data.frame(var1 = c(2,3,4,1,5), var2 = c(NA,NA,NA,NA,NA))

  output$select_1 = renderUI({
    variables = names(DATA)
    selectInput("select_input","select", choices = variables)

    # is.all.na.indicator = sapply(DATA, function(x) all(is.na(x))) 
    # selectInput("select_input","select", choices = variables, goGrey = is.all.na.indicator)
  }) 
}

ui <- fluidPage(
    uiOutput("select_1")
)

shinyApp(ui = ui, server = server)
John
  • 1,779
  • 3
  • 25
  • 53
  • Since you are dynamically generating the UI why don't you select columns to display in `selectInput` considering the NAs? I mean remove all columns that have all NAs in the select input list already. – discipulus Mar 01 '17 at 04:27
  • AFAIK, options of `selectInput` can't be greyed out in any circumstances. – discipulus Mar 01 '17 at 05:15
  • I know removing columns with all NAs is easy, but I just wonder if the user can see more. – John Mar 01 '17 at 06:00

1 Answers1

2
library(shiny)

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

  DATA <- data.frame(var1 = c(2,3,4,1,5), var2 = c(NA,NA,NA,NA,NA))

  output$select_1 <- renderUI({
    variables <- variableNames <- names(DATA)
    emptyColumns <- which(sapply(DATA, function(x) all(is.na(x))))
    for(i in emptyColumns){
      variableNames[i] <- 
        sprintf("<span style='color:red;'>%s</span>", variables[i])
    }
    selectizeInput("select_input", "select", 
                   choices = setNames(variables, variableNames), 
                   options = list(render = I("
  {
    item: function(item, escape) { return '<div>' + item.label + '</div>'; },
    option: function(item, escape) { return '<div>' + item.label + '</div>'; }
  }")))
  }) 
}

ui <- fluidPage(
  uiOutput("select_1")
)

shinyApp(ui = ui, server = server)

enter image description here

Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225