R闪亮的颜色数据框答案

【问题标题】：R shiny color dataframeR闪亮的颜色数据框
【发布时间】：2014-05-06 05:20:34
【问题描述】：

我有一个数据框：

   runApp(
      list(ui = bootstrapPage(pageWithSidebar(
        headerPanel("Data frame with colors"),
        sidebarPanel(),
        mainPanel(
           tableOutput("my_dataframe")
        ) 
      )
     )
   ,
    server = function(input, output) {
       output$my_dataframe <- renderTable({ 
               data.frame("Brand ID"=1:4,"Client1"=c("red", "green", "green", "green"),
                                         "Client2"=c("green", "red", "green", "red")) 
       }) 
    }
)
)

是否可以像这样为数据框着色：

例如，当我有 contidion1 时，我需要用红色为数据框单元格着色，在 condition2 - 用绿色。

任何帮助将不胜感激。

【问题讨论】：

我不确定它是否可以与 shinyapp 输出结合使用，但您可以尝试 HTML 转换器包。在另一种情况下，我与 hwriter 的经历非常积极。

标签： r colors dataframe shiny

【解决方案1】：

这里有一个解决方案。要使用它，您必须在向量中定义 css：

css <- c("#bgred {background-color: #FF0000;}",
          "#bgblue {background-color: #0000FF;}")

并在单元格内写#...：

> data.frame(x=c("A","B"), y=c("red cell #bgred", "blue cell #bgblue"))
  x                 y
1 A   red cell #bgred
2 B blue cell #bgblue

然后使用我的colortable() 函数，主要灵感来自highlightHTML 包和我个人的闪亮经验。这是一个例子：

library(pander)
library(markdown)
library(stringr)
library(shiny)

# function derived from the highlightHTMLcells() function of the highlightHTML package
colortable <- function(htmltab, css, style="table-condensed table-bordered"){
  tmp <- str_split(htmltab, "\n")[[1]] 
  CSSid <- gsub("\\{.+", "", css)
  CSSid <- gsub("^[\\s+]|\\s+$", "", CSSid)
  CSSidPaste <- gsub("#", "", CSSid)
  CSSid2 <- paste(" ", CSSid, sep = "")
  ids <- paste0("<td id='", CSSidPaste, "'")
  for (i in 1:length(CSSid)) {
    locations <- grep(CSSid[i], tmp)
    tmp[locations] <- gsub("<td", ids[i], tmp[locations])
    tmp[locations] <- gsub(CSSid2[i], "", tmp[locations], 
                           fixed = TRUE)
  }
  htmltab <- paste(tmp, collapse="\n")
  Encoding(htmltab) <- "UTF-8"
  list(
    tags$style(type="text/css", paste(css, collapse="\n")),
    tags$script(sprintf( 
                  '$( "table" ).addClass( "table %s" );', style
                )),
    HTML(htmltab)
  )
}

##
runApp(
  list(
    ui=pageWithSidebar(
      headerPanel(""),
      sidebarPanel(
      ),
      mainPanel(
        uiOutput("htmltable")
      )
    ),
    server=function(input,output,session){
      output$htmltable <- renderUI({
        # define CSS tags
        css <- c("#bgred {background-color: #FF0000;}",
                 "#bgblue {background-color: #0000FF;}")
        # example data frame 
        # add the tag inside the cells
        tab <- data.frame(x=c("A","B"), y=c("red cell #bgred", "blue cell #bgblue"))
        # generate html table with pander package and markdown package
        htmltab <- markdownToHTML(
          text=pandoc.table.return(
            tab, 
            style="rmarkdown", split.tables=Inf
          ), 
          fragment.only=TRUE
        ) 
        colortable(htmltab, css)
      })
    })
)

【讨论】：

【解决方案2】：

现在使用 shinyTables 有更优雅的解决方案：

# Install devtools, if you haven't already.
install.packages("devtools")

library(devtools)
install_github("shinyTable", "trestletech")
library(shiny)
runApp(system.file("examples/01-simple", package="shinyTable"))

github中的代码：Example:

【讨论】：