R Shiny：renderUI中的表格条件格式

Question

在另一个post中，假设表格不是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 - this是完美的。

我在某种程度上扩展了该方法，借用this jQuery thread，以基于预定义的最小值和最大值创建单元格的梯度着色（例如数据表热图）。希望这种修改可能对某人有所帮助。使用

您的自足例如：

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

输出