r - Shiny: use styleColorBar with data from two data frames

Question

I am trying to display a table in Shiny, where numbers will be displayed from one data.frame (or data.table), but the size of bars will be taken from another data.frame. For instance, absolute values will be displayed, but -log(p-values) from another table (identically arranged) will determine the width of color bars.

This is my mock code:

  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')
  )

printed pval_data:

            X1          X2          X3           X4          X5
1   0.968418606 -1.87152557  0.61937740 -0.143097511  0.65508855
2  -0.007557229  0.08118509  0.15390863  1.375011375  0.52879595
3  -0.310230367  0.24825819 -0.61521934  0.994227019  0.99756573
4  -0.347770895 -0.91282709  0.79575280  0.234287011 -1.24957553
5   1.699646126 -0.22895201  0.15979995  0.223626312 -1.61600316
6  -0.490930813  0.32298741 -0.81244643  0.474731264  0.09482891
7  -1.118480311  0.42816708 -1.60837688  0.923083220 -0.18504939
8  -0.613107600  0.85641186  0.50027453 -0.682282617  0.78146768
9  -1.191377934 -0.65435824  1.18932459 -0.698629523 -0.06541897
10 -1.149737780  2.47072440 -0.06468906 -0.150334405  1.23995530
11  0.877889198 -0.58012128  0.69443433  2.180587121 -1.32090173
12 -0.323477829 -1.46837648  1.38017226 -1.223060038  1.92034573
13 -1.016861096 -0.62798484  0.22159954 -1.601450990 -0.25184806
14  0.392432490 -0.42233004 -0.64490950 -1.491724171 -0.71931626
15 -1.270341425  0.79922671  0.82034852 -0.109127778 -0.73276775
16  0.713192323  1.01199542  1.08499699  0.328685928  0.98869534
17 -1.491903472 -0.40431848  0.47478220 -1.856996096  1.67946815
18 -0.089676087 -1.16068035 -0.69258182 -0.002303751 -1.39804362
19  0.504820216  0.88694633 -0.52855791  0.330452562 -1.57425961
20  0.899474044 -0.41477379 -0.34950206 -0.062604686  2.26622730

My table looks like this now:

Instead, I want it the bars to be proportional to pval_data, like this (but with ones instead of the pval_data numbers in the table):

Thanks!

P.S. The other question is: if I wanted the colors to be conditional, e.g., if I wanted the color to turn red if the corresponding pval is below N, how would I do that?

Answer 1

这里的问题是该styleColorBar函数创建了一些 Javascript 代码来基于 制作背景range(pval_data)，但该代码应用于绘制的数据表的值，在这种情况下a。

一个技巧可能是 tocbind a和pval_data，并将其传递给输出，以便执行您所做操作所需的所有数据都传递给浏览器。

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

这是一个例子：

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)

在 的options部分中datatable，columnDefs用于隐藏最后 5 列，并rowCallback为背景着色。使用此代码，如果值小于 0，背景将为浅蓝色，如果值大于 0，则背景为红色。