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參數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")
    )
  ))
  )

產量