Блестящий: используйте 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_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

Моя таблица теперь выглядит так:

one

Вместо этого я хочу, чтобы столбцы были пропорциональны pval_data, как это (но с единицами вместо чисел pval_data в таблице):

rands

Спасибо!

P.S. Другой вопрос: если бы я хотел, чтобы цвета были условными, например, если бы я хотел, чтобы цвет стал красным, если соответствующий pval ниже N, как бы я это сделал?


person Anarcho-Chossid    schedule 14.08.2015    source источник


Ответы (1)


Проблема здесь в том, что функция styleColorBar создает некоторый код Javascript для создания фона на основе range(pval_data), но этот код применяется к значениям отображаемой таблицы данных, в данном случае a.

Один из приемов может заключаться в cbind a и pval_data и передавать это в вывод, чтобы все данные, необходимые для того, что вы сделали, передавались браузеру.

Затем вы можете раскрасить фон первых пяти столбцов (в данном случае a) в соответствии со значениями в пяти последних столбцах (pval_data) и скрыть последние 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)

В options части datatable columnDefs используется, чтобы скрыть последние 5 столбцов, а rowCallback - для окраски фона. С помощью этого кода фон будет светло-голубым, если значения меньше 0, и красным, если они больше 0.

person NicE    schedule 17.08.2015
comment
Выглядит идеально. Дай мне попробовать в офисе, и если все заработает, я приму. - person Anarcho-Chossid; 17.08.2015
comment
Простите, быстрый вопрос. Я получаю Error in styleColorBar(range(pval_data), "lightblue") : object 'pval_data' not found. Должен ли pval_data быть глобальным? - person Anarcho-Chossid; 17.08.2015
comment
Кроме того, если вместо value < 0 я хочу, чтобы пользователь вводил значение отсечки и переходил к JS, есть ли способ сделать это? Спасибо! - person Anarcho-Chossid; 17.08.2015
comment
Я опубликовал блестящий пример и добавил все остальные параметры фона в функцию обратного вызова. - person NicE; 17.08.2015
comment
Спасибо, выглядит хорошо! Я принял ответ и скоро назначу награду (там написано, что я могу это сделать за семь часов). - person Anarcho-Chossid; 17.08.2015
comment
Рад, что он работает, вы всегда можете оставить его и наградить через несколько дней, чтобы посмотреть, не придумает ли кто-нибудь что-то более умное. - person NicE; 17.08.2015
comment
Привет, я реализовал вашу функцию, но по какой-то причине сводная таблица «пропускает» некоторые значения (действительно большие необработанные значения с низкими значениями p не окрашиваются). Вот мой код: git.io/vsvHH Буду признателен за любых потенциальных клиентов. - person Anarcho-Chossid; 18.08.2015
comment
Собственно, я понял! Увеличение диапазона с небольшим шагом (0,001) гарантирует, что включены верхние значения. - person Anarcho-Chossid; 18.08.2015
comment
Насколько я понимаю, это можно упростить и писать JavaScript не обязательно: rstudio .github.io / DT / 010-style.html Однако не уверен на 100%. - person Yihui Xie; 19.08.2015
comment
@Yihui, я определенно пробовал поработать с разными вариантами / подходами из примеров по этой ссылке раньше. Один из подходов, который у меня был, - найти индексы отсечения p-значений ‹из таблицы pval_data, а затем использовать styleEqual для присвоения color = red тем ячейкам в pivot_table, которые имеют значения, соответствующие этим индексам. Это хуже, потому что а) в нем не используются полосы, как в подходе @ NicE, б) два распределения могут иметь одинаковое среднее, но разную дисперсию и, как результат, разные значения p на противоположных сторонах отсечки (маловероятно с точностью до десятичной, но теоретически возможно). - person Anarcho-Chossid; 19.08.2015
comment
Но я определенно буду признателен за любые дальнейшие предложения. Также было бы полезно, если бы styleEqual функцию можно было изменить так, чтобы можно было назначать значения цвета по индексу, а не по значению. - person Anarcho-Chossid; 19.08.2015
comment
Обратите внимание: чем ближе отрицательное значение к 0, тем длиннее красная полоса! Я не уверен, что это задумано. Обычно можно ожидать, что красная полоса будет расти, когда значения станут более отрицательными. Мое предложение, как решить эту проблему, содержится в ответе здесь stackoverflow.com/questions/32830382/, который во многом полагается на ответ выше. - person Pekka; 12.12.2015
comment
Если кто-то хочет, чтобы планка была просто пропорцией / процентным соотношением, достаточно использовать styleColorBar(c(0,1), 'lightblue')[1] - person Valentas; 21.03.2017