Shiny: use styleColorBar with data from two data frames

后端 未结 1 1603
不知归路
不知归路 2020-12-30 15:51

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

相关标签:
1条回答
  • 2020-12-30 16:27

    The problem here is that the styleColorBar function creates some Javascript code to make the background based on the range(pval_data), but that code is applied to the values of the datatable that is drawn, in this case a.

    One trick could be to cbind a and pval_data, and pass that to the output so that all the data necessary to do what you went is passed to the browser.

    You could then color the background of the first five columns (a in this case) according to the values in the five last columns (pval_data) and hide the last 5 columns if you don't want them displayed.

    Here's an example:

    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)
    

    In the options part of the datatable, columnDefs is used to hide the last 5 columns, and rowCallback to color the background. With this code, the background will be lightblue if the values is less than 0 and red if it is above 0.

    0 讨论(0)
提交回复
热议问题