R блестящий: цветной фон ячейки на основе цветового пространства Lab

Question

У меня есть dataframe, который содержит значения цветового пространства Lab. Вот пример:

L*  a*  b*  color 
80  25  -30  NA 
75  55  55  NA 
30  0  25  NA 
10  -20 30  NA 
55  15  20  NA 
60  43  18  NA 
... ... 

Здесь более 1000 записей. Я хотел бы покрасить ячейки в цвет колонок на основе значения цветового пространства Lab в столбцах L *, a *, b *. У меня нет фона JQuery. Я нашел пример здесь: R Shiny: table conditional formatting within renderUI, но я не знаю, как изменить сценарий Jquery. Кто-нибудь может мне помочь? Спасибо!

Answer 1

Вы могли бы сделать что-то вроде этого, если вы были цвета по RGB цветового пространства вместо:

library(shiny) 

color.min <- 0 
color.max <- 250 
n <- 100 

# Simulate data 
random.data <- data.frame("l"=runif(n,min=color.min,max=color.max), 
          "a"=runif(n,min=color.min,max=color.max), 
          "b"=runif(n,min=color.min,max=color.max), 
          "color"=rep(NA,n)) 

server <- shinyServer(function(input, output, session) { 

    observe({ 
    output$table <- renderTable({ 
     random.data 
    }) 
    }) 
}) 


ui <- shinyUI(fluidPage(
    # Add jQuery script 
    tags$head(
    tags$script(
     HTML(" 
      function color(){ 
      if(document.querySelector('#table')!=null){ 
       // Select each table row in an array and loop over that with jQuery each 
       $('#table > table > tbody').find('tr').each(function(index, value) { 
       // Get values for rgb and round to integers 
       var vals = []; 
       $(this).children('td').slice(1, 4).each(function(index, value) { 
        vals[index] = parseInt($(this).html()); 
       }); 
       // Color 5:th child the selected rgb color 
       $(':nth-child(5)',this).css('background','rgb('+String(vals[0])+','+String(vals[1])+','+String(vals[2])+')'); 
       }) 
      } 
      else{ 
       setTimeout(function() { color(); }, 100); 
      } 
      } 
      color(); 
      ") 
    ) 
), 
    fluidRow(
    column(10, uiOutput("table")), 
    column(2,actionButton("color","color")) 
) 
)) 

shinyApp(ui = ui, server = server)