R有光泽:基于Lab色彩空间的彩色单元格背景

时间:2015-10-16 18:17:07

标签: jquery css r shiny lab-color-space

我有一个包含Lab颜色空间值的数据框。这是一个例子:

message.Body = sting.Join(",", Directory.GetFiles(path))

这里有1000多条记录。我想根据L *,a *,b *列中的Lab颜色空间值为列颜色中的单元格着色。我没有Jquery的背景。我在这里找到了一个例子:R Shiny: table conditional formatting within renderUI但我不知道如何修改Jquery脚本。有人可以帮帮我吗?谢谢!

1 个答案:

答案 0 :(得分: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)