Shiny：将 styleColorBar 与来自两个数据帧的数据一起使用

Question

我正在尝试在 Shiny 中显示一个表格，其中数字将从一个 data.frame（或 data.table）显示，但条形的大小将从另一个 data.frame 获取。例如，将显示绝对值，但来自另一个表（排列相同）的 -log(p-values) 将确定彩条的宽度。

这是我的模拟代码：

  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_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

我的桌子现在是这样的：

相反，我希望条形与 pval_data 成正比，就像这样（但用一个而不是表中的 pval_data 数字）：

谢谢！

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

Answer 1

这里的问题是styleColorBar 函数创建了一些Javascript 代码来根据range(pval_data) 创建背景，但是该代码应用于绘制的数据表的值，在本例中为a。

一个技巧可以是cbinda 和pval_data，然后将其传递给输出，以便将执行操作所需的所有数据传递给浏览器。

然后，您可以根据最后五列 (pval_data) 中的值为前五列的背景着色（在本例中为 a），如果不希望显示最后 5 列，则隐藏它们.

这是一个例子：

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)

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