R Shiny: условное форматирование таблицы в renderUI

Question

В другом посте на тот же вопрос был дан ответ, предполагая, что таблица не является частью функции renderUI.

В приведенном ниже примере я пытаюсь настроить то же решение (используя JQuery), где таблица, которую я хочу условно отформатировать, принадлежит функции renderUI.

    library(shiny)
    library(datasets)

    script <- "$('tbody tr td:nth-child(5)').each(function() {

              var cellValue = $(this).text();

              if (cellValue > 50) {
                $(this).css('background-color', '#0c0');
              }
              else if (cellValue <= 50) {
                $(this).css('background-color', '#f00');
              }
            })"

  shinyServer(function(input, output, session) {

    session$onFlushed(function() {
      session$sendCustomMessage(type='jsCode', list(value = script))
    })

    output$view <- renderTable({
      head(rock, n = 20)
    })

    output$Test1 <- renderUI({
      list(
        tags$head(tags$script(HTML('Shiny.addCustomMessageHandler("jsCode", function(message) { eval(message.value); });'))),
        tableOutput("view")
      )
    })
  })

  shinyUI(fluidPage(

    tabsetPanel(
      tabPanel("Test1",uiOutput("Test1")),
      tabPanel("Test2")
    )
  ))

В этом небольшом примере условное форматирование не применяется к таблице

Answer 1

Измените свой звонок на session$onFlushed каждый раз вызывать вашу функцию shiny очищает реактивную систему, добавляя аргумент once = FALSE:

  session$onFlushed(function() {
    session$sendCustomMessage(type='jsCode', list(value = script))
  }, once = FALSE)

в автономном примере:

library(shiny)
library(datasets)
script <- "$('tbody tr td:nth-child(5)').each(function() {
var cellValue = $(this).text();
if (cellValue > 50) {
$(this).css('background-color', '#0c0');
}
else if (cellValue <= 50) {
$(this).css('background-color', '#f00');
}
})"
runApp(list(server = function(input, output, session) {
  session$onFlushed(function() {
    session$sendCustomMessage(type='jsCode', list(value = script))
  }, FALSE)
  output$view <- renderTable({
    head(rock, n = 20)
  })
  output$Test1 <- renderUI({
    list(
      tags$head(tags$script(HTML('Shiny.addCustomMessageHandler("jsCode", function(message) { eval(message.value); });')))
      , tableOutput("view")
    )
  })
}
, ui = fluidPage(

  tabsetPanel(
    tabPanel("Test1",uiOutput("Test1")),
    tabPanel("Test2")
  )
))
)

Answer 2

Спасибо, jdharrison - это было прекрасно.

Я несколько расширил метод, заимствуя из этого потока jQuery, чтобы создать градиентную окраску ячеек (например, тепловую карту таблицы данных) на основе предварительно определенных минимальных и максимальных значений. Надеюсь, что эта модификация может быть полезна для кого-то.

Используя ваш автономный пример:

library(shiny)
library(datasets)
script <- "
// Set min and max for gradient

var min = 0;
var max = 100;
var n = max-min

// Define the min colour, which is white
    xr = 255; // Red value
    xg = 255; // Green value
    xb = 255; // Blue value

// Define the max colour #2ca25f
    yr = 44; // Red value
    yg = 162; // Green value
    yb = 95; // Blue value


$('tbody tr td:nth-child(5)').each(function() {
var val = parseInt($(this).text());

// Catch exceptions outside of range
if (val > max) {
  var val = max;
}

else if (val < min) {
  var val = min;
}

// Find value's position relative to range

var pos = ((val-min) / (n-1));

// Generate RGB code
red = parseInt((xr + (( pos * (yr - xr)))).toFixed(0));
green = parseInt((xg + (( pos * (yg - xg)))).toFixed(0));
blue = parseInt((xb + (( pos * (yb - xb)))).toFixed(0));

clr = 'rgb('+red+','+green+','+blue+')';

// Apply to cell

$(this).css('background-color', clr);

})"

runApp(list(server = function(input, output, session) {
  session$onFlushed(function() {
    session$sendCustomMessage(type='jsCode', list(value = script))
  }, FALSE)
  output$view <- renderTable({
    head(rock, n = 20)
  })
  output$Test1 <- renderUI({
    list(
      tags$head(tags$script(HTML('Shiny.addCustomMessageHandler("jsCode", function(message) { eval(message.value); });')))
      , tableOutput("view")
    )
  })
  }
  , ui = fluidPage(

    tabsetPanel(
      tabPanel("Test1",uiOutput("Test1")),
      tabPanel("Test2")
    )
  ))
  )

Выход