I am trying to implement a kind of validation system inside R shiny where rows meeting a particular criteria are flagged (highlighted in red).

The problem I face is that I cannot filter out styled rows unless I make the styling conditional (applying ifelse inside StyleRow e.g StyleRow(rows = ifelse())) where I have to specify another row to take on styling. This is not ideal as this new row in turn becomes unfilterable.

Here is an example:

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr) # added needed libraries
ui <- shinydashboard::dashboardPage(
  
  dashboardHeader(title = 'test'),
  dashboardSidebar(
    menuItem("Settings", tabName = 'info', icon = icon('gears'),badgeLabel = 'new')
  ),
  dashboardBody(
    tabItem('info',
            column(2,
                   sidebarMenu(
                     selectInput('filter', label = 'Select bcd', choices = c('Able', 'Table', 'Caleb'))
                    )
                   ),
           
            
            column(12,
                   dataTableOutput('test_dt')
                   )
            )
  )
  
)

server <- function(input, output, session){
  
  output$test_dt <- renderDataTable({
    
    df <- data.frame(abc = c(1,2,3),
                     bcd = c('Able', 'Table', 'Caleb'))%>%
      dplyr::filter(!bcd %in% input$filter)
    
    datatable(df)%>%
      formatStyle(
        columns = 'bcd',
        target = 'row',
        backgroundColor = styleRow(rows = which(df$bcd == 'Table'), 'red')
      )
  })
  
}

shinyApp(ui = ui, server = server)

I am trying to implement a kind of validation system inside R shiny where rows meeting a particular criteria are flagged (highlighted in red).

The problem I face is that I cannot filter out styled rows unless I make the styling conditional (applying ifelse inside StyleRow e.g StyleRow(rows = ifelse())) where I have to specify another row to take on styling. This is not ideal as this new row in turn becomes unfilterable.

Here is an example:

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr) # added needed libraries
ui <- shinydashboard::dashboardPage(
  
  dashboardHeader(title = 'test'),
  dashboardSidebar(
    menuItem("Settings", tabName = 'info', icon = icon('gears'),badgeLabel = 'new')
  ),
  dashboardBody(
    tabItem('info',
            column(2,
                   sidebarMenu(
                     selectInput('filter', label = 'Select bcd', choices = c('Able', 'Table', 'Caleb'))
                    )
                   ),
           
            
            column(12,
                   dataTableOutput('test_dt')
                   )
            )
  )
  
)

server <- function(input, output, session){
  
  output$test_dt <- renderDataTable({
    
    df <- data.frame(abc = c(1,2,3),
                     bcd = c('Able', 'Table', 'Caleb'))%>%
      dplyr::filter(!bcd %in% input$filter)
    
    datatable(df)%>%
      formatStyle(
        columns = 'bcd',
        target = 'row',
        backgroundColor = styleRow(rows = which(df$bcd == 'Table'), 'red')
      )
  })
  
}

shinyApp(ui = ui, server = server)

• r

1 Answer 1

You can use styleEqual() which takes the value to match against ('Table' in this case) and the style to apply ('red' in this case). Your table will remain filterable and the style will only be applied, if the value "Table" is found in "bcd".

library(shiny)
library(shinydashboard)
library(DT)
library(dplyr)

ui <- dashboardPage(
  dashboardHeader(title = 'test'),
  dashboardSidebar(
    menuItem(
      "Settings",
      tabName = 'info',
      icon = icon('gears'),
      badgeLabel = 'new'
    )
  ),
  dashboardBody(tabItem(
    'info', column(2, sidebarMenu(
      selectInput(
        'filter',
        label = 'Select bcd',
        choices = c('Able', 'Table', 'Caleb')
      )
    )), column(12, dataTableOutput('test_dt'))
  ))
)

server <- function(input, output, session) {
  output$test_dt <- renderDataTable({
    df <- data.frame(abc = c(1, 2, 3),
                     bcd = c('Able', 'Table', 'Caleb')) %>%
      dplyr::filter(!bcd %in% input$filter)
    
    datatable(df) %>%
      formatStyle('bcd',
                  backgroundColor = styleEqual('Table', 'red'),
                  target = 'row')
  })
}

shinyApp(ui = ui, server = server)