Условное оформление ячеек в таблице на основе диапазона значений, который отличается для каждой строки (R) - PullRequest
0 голосов
/ 27 февраля 2019

Я хотел бы создать несколько таблиц, в которых значения из нескольких столбцов получают условное оформление на основе диапазонов, которые различаются для каждой строки (и указаны в столбцах 'min' и 'max').В качестве примера я создал следующее:

a <- c('A', 'B', 'C', 'D', 'E')
b <- c(20, 25, 40, 55, 60)
c <- c(60, 30, 80, 50, 60)
min <- c(15, 20, 40, 55, 55)
max <- c(25, 30, 50, 65, 65)

df <- data.frame(a, b, c, min, max)

a  b  c min max
A 20 60  15  25
B 25 30  20  30
C 40 80  40  50
D 55 50  55  65
E 60 60  55  65

table.df <- df[,1:3]%>%
      select(a, everything())%>%
      kable("html", escape = F) %>%
      kable_styling(bootstrap_options = "striped", full_width = F, position = "left")

Это дает мне таблицу, в которой столбцы для min и max не представлены (как мне нравится).Но я хотел бы добавить условный оператор, в котором значения в столбцах «b» и «c», выходящие за пределы диапазона, определенного в столбцах «min» и «max», становятся красными (или же фон этих ячеек).Не слишком знаком со стилями таблиц, поэтому любая помощь будет высоко ценится!

1 Ответ

0 голосов
/ 27 февраля 2019

Пакет tableHTML предлагает множество опций для стилизации таблиц, особенно если вы используете некоторые приемы с HTML-кодом, например, один из способов решения вашей проблемы будет следующим:

на основе ответа здесь Подсветка предопределенных слов в таблице Shiny DT [Не с помощью Подсветки поиска]

Вы изменяете данные, удовлетворяющие условиям, для включения форматирования текста (или любого другого html-форматирования, цвета шрифта, цвета фона .....) и затем передайте его tableHTML() с escape=FALSE

library(tableHTML)
library(dplyr)

a <- c('A', 'B', 'C', 'D', 'E')
b <- c(20, 25, 40, 55, 60)
c <- c(60, 30, 80, 50, 60)
min <- c(15, 20, 40, 55, 55)
max <- c(25, 30, 50, 65, 65)

df <- data.frame(a, b, c, min, max)

df %>% 
  mutate(b = ifelse(b < min | b > max, paste0('<font color="red">', b, '</font>'), b),
         c = ifelse(c < min | c > max, paste0('<font color="red">', c, '</font>'), c)) %>% 
 `[`(1:3) %>%
  tableHTML(escape = FALSE, rownames = FALSE, 
            widths = rep(50, 3), theme = 'scientific')

, это будет результат

enter image description here

или, может быть, с двумя условиями и двумя цветами:

df %>% 
  mutate(b = ifelse(b < min ,
                    paste0('<span style="background-color:#ccccff">', b, '</span>'), 
                    ifelse( b > max, paste0('<span style="background-color:#ff9999">', b, '</span>'), 
                            b)),
         c = ifelse(c < min , 
                    paste0('<span style="background-color:#ccccff">', c, '</span>'), 
                    ifelse( c > max,  paste0('<span style="background-color:#ff9999">', c, '</span>'), 
                            c))) %>% 
  `[`(1:3) %>%
  tableHTML(escape = FALSE, rownames = FALSE, 
            widths = rep(50, 3), theme = 'scientific')

Вы получаете:

enter image description here

Пакет предлагает множество вариантов форматированияи даже условное форматирование (хотя и не для этого случая), посмотрите здесь, чтобы узнать, что еще можно сделать с пакетом:

Основы tableHTML

условное форматирование

Обновление

Существует много вариантов изменения неизвестного числа столбцов в кадре данных, я предпочитаю работать с функциями apply, например, например:

Определить функцию для изменения столбцов:

(в этой функции col - любой вектор, min_col - вектор, содержащий нижние границы, а max_col - вектор, содержащий верхние границы)

add_format <- function(col, min_col, max_col){
  if(!is.numeric(col)){
    return(as.character(col))
  }else{
    new_col <- ifelse(col < min_col | col > max_col, 
                      paste0('<font color="red">', col, '</font>'), col)
    return(new_col)
  }
}

и теперь примените эту функциюдля всех столбцов в df установите его на data.frame, а затем все остальное будет одинаковым

df %>% 
  sapply(add_format, df$min, df$max)  %>% 
  as.data.frame() %>% 
  `[`(1:3) %>%
  tableHTML(escape = FALSE, rownames = FALSE, 
            widths = rep(50, 3), theme = 'scientific')

Вы также можете проверить функции mutate_if и mutate_all, они будут работать какхорошо с некоторыми играющими

...