как покрасить отдельные ячейки таблицы данных в блестящей таблице данных - PullRequest
Новая
       9

как покрасить отдельные ячейки таблицы данных в блестящей таблице данных

0 голосов
/ 27 ноября 2018

У меня есть таблица данных, созданная из фрейма данных, подобного этому: 

output$main_temp <- renderDataTable(df[,-1:-1], width = "auto")

Я хотел бы раскрасить со значениями и без.Ячейки со значениями с зеленым и без значений для красного.

Я пробовал: 

output$main_temp <- renderDataTable({
datatable(df[,-1:-1], options = list(
    columnDefs = list(list(targets = 6, visible = FALSE))
)) %>% formatStyle(
  names(df[,-1:-1]),
  backgroundColor = styleEqual(c(0, 1), c('gray', 'yellow'))
)
})

Пример данных:

Sample data

Требуемый выход:

output

1 Ответ

0 голосов
/ 27 ноября 2018

styleEqual отображает свои аргументы один-к-одному :

значения: вектор значений CSS

уровни: символьный вектор данныхзначения, которые должны быть сопоставлены (один к одному) со значениями CSS

Поэтому вы можете 

df <- data.frame(cat = letters[1:5], 
                 t1 = c(33, NA, 89, 45, NA),
                 t2 = c(NA, NA, 4, NA, 23),
                 t3 = c(56, NA, NA, 67, NA),
                 t4 = c(NA, NA, 12, 66, NA))

uval <- unique(df[!is.na(df)])
datatable(df) %>% 
    formatStyle(names(df)[-1], 
    backgroundColor = styleEqual(c(NA, uval), 
    c('red', rep('lightgreen', length(uval)))))

сопоставить каждое значение одному и тому же цвету.

enter image description here

Другой вариант - реализовать его вручную с помощью JavaScript: 

library(shiny)
library(htmlwidgets)

js <- 'function(settings, json) {
    // For every row, select all table cells starting at cell #3
    $("#DataTables_Table_0 td:nth-child(3+1n)").each(function(key, val) {
        if( $(this).html() == "") {
            $(this).css("background-color", "#f00");
        } else {
            $(this).css("background-color", "#0f0");
        };
    });
}'

ui <- fluidPage(fluidRow(dataTableOutput("main_temp")))

server <- function(input, output) {
    df <- data.frame(cat = letters[1:5], 
                     t1 = c(33, NA, 89, 45, NA),
                     t2 = c(NA, NA, 4, NA, 23),
                     t3 = c(56, NA, NA, 67, NA),
                     t4 = c(NA, NA, 12, 66, NA))
    // when the table has finished loading, execute the JS code
    output$main_temp <- renderDataTable(df, options = list(initComplete = JS(js)))
}

shinyApp(ui = ui, server = server)
...