闪亮：对来自两个数据帧的数据使用styleColorBar

我试图用Shiny显示一个表，其中数字将从一个data.frame（或data.table）显示，但条形图的大小将从另一个data.frame获取。例如，将显示绝对值，但来自另一个表（相同排列）的-log（p值）将确定颜色栏的宽度

这是我的模拟代码：

  output$pivot_table = DT::renderDataTable(
    dt <- datatable(

      {
        a <- data.frame(matrix(1, 20, 5))
        pval_data <- data.frame(matrix(rnorm(n = 100), 20, byrow = T))
        print(pval_data)
        a
      }

    ) %>% formatStyle(names(a),
                      background = styleColorBar(range(pval_data), 'lightblue'),
                      backgroundSize = '98% 88%',
                      backgroundRepeat = 'no-repeat',
                      backgroundPosition = 'center')
  )

我的桌子现在看起来像这样：

相反，我希望条形图与pval_数据成比例，如下所示（但使用条形图而不是表中的pval_数据编号）：

谢谢

---

另一个问题是：如果我希望颜色是有条件的，例如，如果我希望颜色在相应的pval低于N时变为红色，我该怎么做？

这里的问题是，

styleColorBar

函数创建一些Javascript代码，以基于

范围（pval\u数据）

生成背景，但该代码应用于绘制的数据表的值，在本例中为

a

一个技巧是

cbind

a

和

pval_data

，并将其传递到输出，以便将执行所需操作的所有数据传递到浏览器

然后，您可以根据最后五列（

pval_data

）中的值为前五列（

a

）的背景上色，如果不想显示，则隐藏最后五列

下面是一个例子：

library(DT)
library(shiny)
    server <- function(input, output) {

  a<-reactive({
    data.frame(matrix(1, nrow=input$obs, ncol=5))
  })

  pval_data <- reactive({
    data.frame(matrix(rnorm(n = input$obs*5), ncol=5))
  })

  output$pivot_table = DT::renderDataTable(
    datatable(cbind(a(),pval_data()), options = list(columnDefs = list(list(targets = 6:10, visible = FALSE)),rowCallback = JS(
  paste0("function(row, data) {

        for (i = 1; i < 6; i++) {
           value = data[i+5]
           if (value < ",input$cutoff,") backgroundValue =",styleColorBar(range(pval_data()), 'lightblue')[1],"
           else backgroundValue =",styleColorBar(range(pval_data()), 'red')[1],"
           $('td', row).eq(i).css('background',backgroundValue);
           $('td', row).eq(i).css('background-repeat','no-repeat');
           $('td', row).eq(i).css('background-position','center');
           $('td', row).eq(i).css('background-size','98% 88%')
         }
         }"))
)))

}

ui <- shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("obs", "Number of observations:", min = 5, max = 20, value = 10),
      sliderInput("cutoff", "Cutoff:", min = -5, max = 5, value = 0,step=0.5)
    ),
    mainPanel(dataTableOutput('pivot_table')
  )
)))

shinyApp(ui = ui, server = server)

库（DT）
图书馆（闪亮）
看起来很完美的服务器。让我在办公室试一下，如果一切正常，我会接受的。对不起，我要问个问题。我在styleColorBar（范围（pval_数据），“浅蓝色”）中发现
错误：未找到对象“pval_数据”
。pval_数据必须是全局的吗？另外，如果我希望用户输入截止值并传递给JS，而不是
值<0
，是否有办法做到这一点？谢谢我发布了一个模拟闪亮的示例，并向回调函数添加了所有其他背景选项。谢谢，看起来不错！我接受了答案，并将很快颁发奖金（上面说我可以在七小时内完成）。
library(DT)
library(shiny)
    server <- function(input, output) {

  a<-reactive({
    data.frame(matrix(1, nrow=input$obs, ncol=5))
  })

  pval_data <- reactive({
    data.frame(matrix(rnorm(n = input$obs*5), ncol=5))
  })

  output$pivot_table = DT::renderDataTable(
    datatable(cbind(a(),pval_data()), options = list(columnDefs = list(list(targets = 6:10, visible = FALSE)),rowCallback = JS(
  paste0("function(row, data) {

        for (i = 1; i < 6; i++) {
           value = data[i+5]
           if (value < ",input$cutoff,") backgroundValue =",styleColorBar(range(pval_data()), 'lightblue')[1],"
           else backgroundValue =",styleColorBar(range(pval_data()), 'red')[1],"
           $('td', row).eq(i).css('background',backgroundValue);
           $('td', row).eq(i).css('background-repeat','no-repeat');
           $('td', row).eq(i).css('background-position','center');
           $('td', row).eq(i).css('background-size','98% 88%')
         }
         }"))
)))

}

ui <- shinyUI(fluidPage(
  sidebarLayout(
    sidebarPanel(
      sliderInput("obs", "Number of observations:", min = 5, max = 20, value = 10),
      sliderInput("cutoff", "Cutoff:", min = -5, max = 5, value = 0,step=0.5)
    ),
    mainPanel(dataTableOutput('pivot_table')
  )
)))

shinyApp(ui = ui, server = server)