How to Color Specific Cells in a Data Frame/Table in R

How to color specific cells in a Data Frame / Table in R?

Have you considered DT?

library(DT)
datatable(df, rownames = FALSE) %>%
  formatStyle(columns = "inputval", 
              background = styleInterval(c(0.7, 0.8, 0.9)-1e-6, c("white", "lightblue", "magenta", "white"))) %>%
  formatStyle(columns = "outcome", 
              background = styleEqual(c(1, 4), c("magenta", "lightblue"))) 

Coloring cells of dataframe based on the condition in R

In your question, tt is not clear if you are looking to change the color of the text or of the cell

For the color of the text, using formattable, you can do:

library(formattable)
formattable(df, list(
  prev_score = formatter("span", 
                         style = ~style(font.weight = "bold", color = 
                                          ifelse(change > 0,"darkblue",
                                                 ifelse(change == 0,"blue",
                                                        ifelse(change <0, "lightblue",NA)))))
))

For coloring the box and not the text, you can do the following:

formattable(scores, list(
  prev_score = formatter("span", 
                         style = ~style(display = "block",
                                        font.weight = "bold", 
                                        color = "white",
                                        "border-radius" = "4px",
                                        "padding-right" = "4px",
                                        "background-color" =  
                                          ifelse(change > 0,"darkblue",
                                                 ifelse(change == 0,"blue",
                                                        ifelse(change <0, "lightblue",NA)))))
))

Does it answer your question ?

Reproducible example

df <- data.frame(id = 1:5,
                     prev_score = c(10, 8, 6, 8, 8),
                     cur_score = c(8, 9, 7, 8, 9),
                     change = c(-2, 1, 1, 0, 1))

Coloring Cells of a Data.Frame R

How about adding a new column to dfm indicating if a particular variable/value combination is in data?

dfm$ismatch<-ifelse(
    with(dfm,interaction(variable, value)) %in% 
      with(data, interaction(position,type)),
    "match","nomatch")

Then we can color based on this value

ggplot(dfm, aes(x=variable, y=gene, label=value, fill=ismatch)) + 
    geom_text(colour="black") +
    geom_tile(alpha=0.5)

and that gives

Change selected cell background color in a Shiny DT table based on rules?

The first part - highlighting colour by odd/even row - I've taken advantage of the "stripe" class and adding in some extra CSS to remove the stripes, but it does include an extra class to say whether a row is even or odd which helps choose the different colours.

For the if cell = "X" I've added some dummy columns to reference adding in a "no-highlight" class so that when clicked it doesn't change colour.

www/style.css

/* Removes background colour of stripes */
table.dataTable.stripe tbody tr.odd, table.dataTable.stripe tbody tr.even {
  background-color: #cccccc; 
}

table.dataTable tr.odd td.selected:not(.no-highlight) {
  background-color: #ffffff !important;
}

table.dataTable tr.even td.selected:not(.no-highlight) {
  background-color: blue !important;
}

table.dataTable tbody tr td.selected.no-highlight {
  background-color: #cccccc !important;
}

app.R

library(shiny)
library(DT)

ui <- fluidPage(
  titlePanel("Sample app"),
  tags$link(href = "style.css", rel = "stylesheet"),
  
  fluidRow(
    column(
      width = 10,
      DTOutput("maintable")
    ) 
  ) 
)      

server <- function(input, output, session) {
  
  mydf <- reactive(
    data.frame(
      matrix(
        sample(c("X", " "), 100, TRUE), 
        nrow = 10, 
        ncol = 10, 
        dimnames = list(
          seq.int(1, 10, 1),
          seq.int(1, 10, 1)
        )
      )
    )
  )
  
  trans_df <- reactive(
    cbind(
      mydf(), 
      rbind(" ", mydf()[seq(1, nrow(mydf()) - 1), ])
    )
  )
  
  output$maintable <- renderDT(
    DT::datatable(
      trans_df(), 
      selection = list(target = "cell"), 
      class = "table-bordered compact stripe", 
      options = list(
        dom = "t",
        ordering = FALSE, 
        pageLength = nrow(mydf()),
        columnDefs = list(
          list(
            targets = seq(ncol(mydf())) + ncol(mydf()),
            visible = FALSE
          ),
          list(
            targets = seq(ncol(mydf())),
            createdCell = JS(paste0(
              "function (td, cellData, rowData, row, col) {",
                "if (rowData[col + ", ncol(mydf()), "] === 'X') {",
                  "$(td).addClass('no-highlight');",
                "}",
              "}"
            ))
          )
        )
      )
    )
  )
}

shinyApp(ui = ui, server = server)

---

Related Topics