2014-03-27 79 views
13

我有一個數據幀:ř光澤顏色數據幀

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

是否有可能喜歡的顏色數據幀:

enter image description here

例如,當我有contidion1我需要的顏色數據帶有紅色的框架單元,條件2 - 帶有綠色。

任何幫助將非常感激。

+0

我不知道這是否可以結合shinyapp輸出,但你可以嘗試HTML轉換器包。在另一方面,我與hwriter的經歷非常積極。 – rdatasculptor

回答

9

這是一個解決方案。要使用它,你有一個載體來定義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) 
     }) 
    }) 
) 

enter image description here

+0

太棒了!非常感謝你的回答和你的工作! – Marta

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: