Row-wise conditional formatting in Shiny Reactable table

Question

I have the following dataframe that I am importing into a Shiny app:

final_odds <- structure(list(player_prop = c("Aaron Jones: Rush + Rec Yards", 
                                             "Aaron Jones: Rush + Rec Yards", "Aaron Rodgers: Interceptions", 
                                             "Aaron Rodgers: Interceptions", "Aaron Rodgers: Pass TDs", "Aaron Rodgers: Pass TDs", 
                                             "Aaron Rodgers: Pass Yards", "Aaron Rodgers: Pass Yards", "Adam Thielen: Rec Yards", 
                                             "Adam Thielen: Rec Yards"), Side = c("Over", "Under", "Over", 
                                                                                  "Under", "Over", "Under", "Over", "Under", "Over", "Under"), 
                             DraftKings = c("1300.5 (-115)", "1300.5 (-115)", "7.5 (115)", 
                                            "7.5 (-140)", "31.5 (-120)", "31.5 (100)", "4050.5 (-110)", 
                                            "4050.5 (-110)", "750.5 (-110)", "750.5 (-120)"), BetMGM = c("-", 
                                                                                                         "-", "-", "-", "-", "-", "-", "-", "699.5 (-125)", "699.5 (-105)"
                                            ), FanDuel = c("-", "-", "-", "-", "30.5 (-112)", "30.5 (-112)", 
                                                           "3950.5 (-112)", "3950.5 (-112)", "750.5 (-112)", "750.5 (-112)"
                                            ), Caesars = c("-", "-", "-", "-", "30.5 (-115)", "30.5 (-115)", 
                                                           "4000.5 (-115)", "4000.5 (-115)", "775.5 (-115)", "775.5 (-115)"
                                            )), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"
                                            ))

What I want to do is make it so that the lowest value (of the numbers not in parentheses) in columns 3-6 is highlighted in green for each row of data. The complications here are two-fold: 1) there isn't always a value in each of the columns, and 2) I just need to evaluate the numbers outside of the parentheses.

Here is a basic outline of the Shiny app as it stands:

library(shiny)
library(tidyverse)
library(dplyr)
library(reactable)


final_odds <- structure(list(player_prop = c("Aaron Jones: Rush + Rec Yards", 
                                             "Aaron Jones: Rush + Rec Yards", "Aaron Rodgers: Interceptions", 
                                             "Aaron Rodgers: Interceptions", "Aaron Rodgers: Pass TDs", "Aaron Rodgers: Pass TDs", 
                                             "Aaron Rodgers: Pass Yards", "Aaron Rodgers: Pass Yards", "Adam Thielen: Rec Yards", 
                                             "Adam Thielen: Rec Yards"), Side = c("Over", "Under", "Over", 
                                                                                  "Under", "Over", "Under", "Over", "Under", "Over", "Under"), 
                             DraftKings = c("1300.5 (-115)", "1300.5 (-115)", "7.5 (115)", 
                                            "7.5 (-140)", "31.5 (-120)", "31.5 (100)", "4050.5 (-110)", 
                                            "4050.5 (-110)", "750.5 (-110)", "750.5 (-120)"), BetMGM = c("-", 
                                                                                                         "-", "-", "-", "-", "-", "-", "-", "699.5 (-125)", "699.5 (-105)"
                                            ), FanDuel = c("-", "-", "-", "-", "30.5 (-112)", "30.5 (-112)", 
                                                           "3950.5 (-112)", "3950.5 (-112)", "750.5 (-112)", "750.5 (-112)"
                                            ), Caesars = c("-", "-", "-", "-", "30.5 (-115)", "30.5 (-115)", 
                                                           "4000.5 (-115)", "4000.5 (-115)", "775.5 (-115)", "775.5 (-115)"
                                            )), row.names = c(NA, -10L), class = c("tbl_df", "tbl", "data.frame"
                                            ))



ui <- fluidPage(
  reactableOutput("odds_table")
)

server <- function(input, output) {

    output$odds_table <- renderReactable({
    reactable(final_odds)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

akrun · Answer 1 · 2022-07-26T20:30:44.507

We may get the index of the min values from columns 3 to 6 by looping across those columns, get the number outside the () with parse_number, find the min and get the index with which

library(dplyr)
library(reactable)
final_odds1 <-  final_odds %>%
          summarise(across(3:6, ~ {
              x1 <- readr::parse_number(.x)
              which(x1 %in% min(x1, na.rm = TRUE))
          }))

Now, we create the reactable object by specifying the columns and loop over the row index in style to highlight the rows where they are minimum by comparing with the index stored data from 'final_odds1'

reactable(final_odds, columns = list(
  DraftKings = colDef(
    style = function(value, index) {
      if(index %in% final_odds1$DraftKings) {
        color <- "green"
      } else {
        color <- "black"
      }
      list(color = color)
        
      
      
    }
  ),
  BetMGM = colDef(
    style = function(value, index) {
      if(index %in% final_odds1$BetMGM) {
        color <- "green"
      } else {
        color <- "black"
      }
      list(color = color)
      
      
      
    }
  ),
  FanDuel = colDef(
    style = function(value, index) {
      if(index %in% final_odds1$FanDuel) {
        color <- "green"
      } else {
        color <- "black"
      }
      list(color = color)
      
      
      
    }
  ), 
  
  
  Caesars = colDef(
    style = function(value, index) {
      if(index %in% final_odds1$Caesars) {
        color <- "green"
      } else {
        color <- "black"
      }
      list(color = color)
      
      
      
    }
  )
  
  
))

-output

If there are many columns, create a function wrapper and then loop over the names with map or imap

library(purrr)
final_odds1 <-  final_odds %>%
          summarise(across(3:6, ~ {
              x1 <- readr::parse_number(.x)
              which(x1 %in% min(x1, na.rm = TRUE))
          }))


style_fun <- function(colnm) {
        colDef(
          style =  function(value, index) {
            if(index %in% final_odds1[[colnm]]) {
              color <- "green"
            } else {
              color <- "black"
            }
            list(color = color)
            
            
            
          }
        )
  
  
  
}
reactable(final_odds, 
 columns = setNames(map(names(final_odds)[3:6], 
      ~ style_fun(.x)), names(final_odds[3:6])))

If it is grouped by 'player_prop'

library(stringr)
final_odds1 <-  final_odds %>%
          mutate(rn = row_number()) %>%
          group_by(player_prop) %>%
          mutate(across(DraftKings:Caesars, ~ {
              x1 <- as.numeric(na_if(str_remove(.x, "\\s*\\(.*"), "-"))
              
              list(if(all(is.na(x1))) NA_integer_ else 
      rn[x1 %in% min(x1, na.rm = TRUE)])
              
          })) %>%
        ungroup


style_fun <- function(colnm) {
        colDef(
          style =  function(value, index) {
            if(index %in% final_odds1[[colnm]][[index]]) {
              color <- "green"
            } else {
              color <- "black"
            }
            list(color = color)
            
            
            
          }
        )
  
  
  
}
reactable(final_odds, columns = setNames(map(names(final_odds)[3:6],
      ~ style_fun(.x)), names(final_odds[3:6])))

I realized I didn't clarify in my original post, but I wanted to find the minimum in each column by group of the `player_prop` column - how would you change the code to reflect that? — Sam Hoppen, Jul 26 '22 at 20:02
@SamHoppen you may need the `final_odds1` as `group_by(player_prop)` before the `summarise` step or create new columns with `mutate` after grouping in the same data (which would be better). I will update — akrun, Jul 26 '22 at 20:05
@SamHoppen with gruoped by 'player_prop, from your example, it is all distinct values. Thus all the elements will green? — akrun, Jul 26 '22 at 20:28
@SamHoppen I updated the code, but your example may not be reflecting the correct change — akrun, Jul 26 '22 at 20:31
yeah it doesn't seem to be working for me. I get values like "1:2" as cell values when I use the updated code. — Sam Hoppen, Jul 27 '22 at 14:39
@SamHoppen It works fine for me though. can you check the `final_odds1` data. Those are list columns. which I subset in the reactable code — akrun, Jul 27 '22 at 14:45

Row-wise conditional formatting in Shiny Reactable table

1 Answers1