Search code examples
rdataframeknitrkablekableextra

Kable highlighting the largest value in each row (R - Knitr)

Let's use this dataframe:

x <- structure(list(`A. afarensis` = c(NaN, 41.624448481617, NaN, 
44.3444026007235, 45.637877314444), `A. africanus` = c(NaN, 40.8108406931158, 
NaN, 17.6702611050343, 28.8624817479424), `A. anamensis` = c(NaN, 
3.96543899879134, NaN, 13.4563973882188, 7.02306143133709), `Ar. ramidus` = c(NaN, 
3.31720723035651e-05, NaN, 0.00154294031842416, 7.49122553868537e-05
), Australopithecus = c(NaN, 6.97874566506872, NaN, 4.99347711237018, 
6.04930517572641), tooth = c("M1", "M1", "M1", "M1", "M1")), row.names = c("1", 
"2", "3", "4", "5"), class = "data.frame")

I would like to highlight in bold and with red background color the highest value per row, from the column A. afarensis to Australopithecus

I created this function:

fun_kable <- function(data){
  kable(data, digits = 2) %>%
    kable_classic(full_width = T, 
                  html_font = "Cambria", 
                  font_size = 10) %>%
    column_spec(ncol(data), bold = T, italic = T, color = "red")
}

When I run fun_kable(x) I would like to see also the highest value per row. How could I do this by using the previous function?

Solution

  • Here is a way using cell_spec(). Note that the rounding has to be done before hand, since using cell_spec transforms the variable to character. You can increase the number of digits, if the three 0's in column Ar.ramidus are problematic for you.

    Row Maximum:

    library(dplyr)
library(kableExtra)

  max_values <- x |>
  mutate(across(where(is.numeric), round, 2)) |>
  select(-tooth) |>
  purrr::pmap(pmax, na.rm = TRUE) |>
  as.numeric() |>
  na.omit()

x |>
  mutate(across(where(is.numeric), round, 2)) |>
  mutate(across(-tooth, ~ if_else(row_number() %in% which(.x %in% max_values),
    cell_spec(.x,
      format = "html",
      color = "red", bold = TRUE
    ), as.character(.x)
  ))) |>
  mutate(across(everything(), ~ ifelse(.x == "NaN", "", .))) |>
  kable(escape = FALSE) |>
  kable_classic(
    full_width = T,
    html_font = "Cambria",
    font_size = 10
  )

    enter image description here

    Column Maximum:

    library(dplyr)
library(kableExtra)
                                                                                                                                                                                                                                                          "2", "3", "4", "5"), class = "data.frame")
max_values <- x |> 
  mutate(across(where(is.numeric), round, 2)) |> 
  summarise(across(-tooth, max, na.rm = TRUE)) |> as.vector() |> unname()

x |> 
  mutate(across(where(is.numeric), round, 2)) |> 
  mutate(across(-tooth, ~if_else(row_number() %in% which(.x %in% max_values),
                               cell_spec(.x,format =  "html",
                                         color = "red", bold = TRUE), as.character(.x)))) |> 
  kable(escape = FALSE) |> 
  kable_classic(full_width = T, 
                html_font = "Cambria", 
                font_size = 10)

    enter image description here

    test.qmd

    ---
title: "test"
format: html
---

```{r}
#| echo: false
#| warning: false
#| message: false
library(dplyr)
library(kableExtra)
...