2014-03-27 18 views
13

Ich habe einen Datenrahmen:R glänzende Farbe Datenrahmen

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

Ist es möglich, Farbe Datenrahmen wie:

enter image description here

Zum Beispiel, wenn ich contidion1 habe ich zu Farbdaten benötigen Rahmenzelle mit rot, auf condition2 - mit grün.

Jede Hilfe würde wirklich geschätzt werden.

+0

Ich bin nicht sicher, ob es sein kann, Kombiniert mit shinyapp-Ausgaben, aber Sie könnten HTML-Konverter-Pakete ausprobieren. In einem anderen Kontext sind meine Erfahrungen mit hwriter sehr positiv. – rdatasculptor

Antwort

9

Hier ist eine Lösung. Um es zu nutzen, müssen Sie CSS in einem Vektor definieren:

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

und schreiben #... innerhalb der Zelle:

> 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 

Dann meine colortable() Funktion vor allem aus dem highlightHTML Paket inspiriert und aus meinem persönlichen glänzend Erfahrung. Hier ein Beispiel:

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

Das ist großartig! Vielen Dank für die Antwort und Ihre Arbeit daran !!! – Marta

2

Heutzutage gibt es elegantere Lösung unter Verwendung 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")) 

-Code in Github: Example: