RShiny中表格的条件格式答案

【问题标题】：Conditional formatting of a table in RShinyRShiny中表格的条件格式
【发布时间】：2015-10-31 13:17:41
【问题描述】：

我正在尝试可视化同期群分析，并希望在闪亮中使用 RenderDataTable 来获得这种可视化效果，在该可视化效果中，我可以基于具有值 1/0 的单独列突出显示所有单元格， 1 被着色，0 不被着色。

我尝试了几件事，包括尝试在ggplot2 中使用geom_tile，但无济于事。我还尝试查看rpivotTable，但我无法弄清楚如何为某些单元格设置阴影。

示例数据：

df <- "
cohort  wk  value   flag
1   1   24  0
1   2   12  0
1   3   10  0
1   4   5   0
1   5   2   0
2   1   75  0
2   2   43  1
2   3   11  0
2   4   14  0
3   1   97  0
3   2   35  0
3   3   12  1
4   1   9   0
4   2   4   0
5   1   5   0"

df <- read.table(text = df, header = TRUE)

【问题讨论】：

你能提供最低限度的reproducible example吗？您的示例图像没有 0/1 列，它有阴影的单元格，而不是行。它真的代表您的预期输出吗？
感谢@Molx，根据您的 cmets 进行了编辑
@Karthikg 最好是使用 DT（使用 datatables JS 库）。它允许使用条件格式。

标签： r shiny knitr r-markdown

【解决方案1】：

用DT-package：

#global.R

library(shiny)
library(DT)

sketch = htmltools::withTags(table(
  class = 'display',
    thead(
       tr(
         th(rowspan = 2, ''),
         th(rowspan = 2, 'Cohort'),
         th(colspan = 10, 'Wk')
       ),
       tr(lapply(paste(c('', 'f'), rep(1:5, each=2), sep=''), th))
    )
))

#ui.R

shinyUI( fluidPage( DT::dataTableOutput(outputId="table") ) )

#server.R

shinyServer(function(input, output, session) {
    output$table <- DT::renderDataTable({
        df$flag <- as.factor(df$flag)
        x <-  reshape(df, timevar = 'wk', sep = '_', direction = 'wide',idvar ='cohort')
        row.names(x) <- NULL
        colnames(x)[-1] <- paste(c('', 'f'), rep(1:5, each = 2), sep = '')
        datatable(x, rownames = T, container = sketch,
          options = list(dom = 'C<"clear">rti', pageLength = -1,
                         columnDefs = list(list(visible = F, targets = c(3,5,7,9,11))))
    )%>%
       formatStyle('1', 'f1', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('2', 'f2', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('3', 'f3', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('4', 'f4', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) %>%
       formatStyle('5', 'f5', backgroundColor = styleEqual(c(0, 1), c('white','lightblue'))) 
    })  
})

【讨论】：

没有不尊重某些用户似乎很喜欢的答案，并且也得到了很多，但是一些额外的解释或 cmets 会很好，我在过去的 5 到 10 分钟里一直在盯着这个我不知道这里发生了什么。
@Moody_Mudskipper 嗨，已经有一段时间了，但我很确定我没有解释太多，因为我在DT 中使用的所有内容都在其website 中得到了很好的解释。但是，如果您有任何特别的疑问，我可以尝试回答。
感谢您的快速反应，我确实同时在这个网站上找到了我需要的东西！非常值得检查更多说明包的帮助文件！

【解决方案2】：

如果你想为 DataTable 着色，你可以这样做：

require(plyr)

# Create matrix
m.val <- max(unlist(lapply(unique(df$cohort),function(ch){ length(which(df$cohort==ch)) })))
cohort.df <-  do.call(rbind, lapply(unique(df$cohort),function(ch){ 
  v <- df$value[which(df$cohort==ch)]
  c(v,rep(NA,m.val-length(v))) 
  }))

ui <- fluidPage(
  tags$head(
    tags$script(
      HTML("
        Shiny.addCustomMessageHandler ('colorTbl',function (message) {
          console.log(message.row);
          var row = parseInt(message.row); var col = parseInt(message.col);
          $('#tbl').find('tbody').find('tr').eq(row).find('td').eq(col).css('background',message.color);
        });
           ")
    )
  ),
  dataTableOutput("tbl")
)

color <- "#6CAEC4"
server <- function(input, output, session) {
  colorTbl <- function(){
    # Get rows we want to color
    sel.d <- df[df$flag==1,]
    for(i in 1:nrow(sel.d)){
      row <- as.numeric(sel.d[i,sel.d$cohort]) -1
      col <- as.numeric(sel.d[i,sel.d$wk]) - 1
      session$sendCustomMessage(type = 'colorTbl', message = list(row=row,col=col,color=color))
    }
  }

  output$tbl <- renderDataTable({
    # Wait until table is rendered, then color
    reactiveTimer(200,{colorTbl()})
    as.data.frame(cohort.df)
  })
}

runApp(shinyApp(ui,server))

这里我使用 jQuery 根据您的标准为行着色。

【讨论】：

【解决方案3】：

这应该让您开始使用ggplot2 创建情节：

library(ggplot2)

ggplot(df, aes(x = wk, y = cohort, fill = factor(flag))) + 
  geom_tile(color = "white") +
  geom_text(aes(label = value), color = "white") +
  scale_y_reverse()

以闪亮的方式渲染图应该是微不足道的，因为您没有提供任何闪亮的代码（例如服务器或 ui），所以很难说您可能在哪里遇到问题。

【讨论】：