[英]R shiny color dataframe
I have a data frame: 我有一个数据框:
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"))
})
}
)
)
Is it possible to color data frame like: 是否可以为数据框着色,如:
For example, when I have contidion1 I need to color data frame cell with red, on condition2 - with green. 例如,当我有contidion1时,我需要在条件2上用红色为数据帧单元着色 - 用绿色。
Any help would be really appreciated. 任何帮助将非常感激。
Here is a solution. 这是一个解决方案。 To use it, you have to define css in a vector:
要使用它,您必须在向量中定义css:
css <- c("#bgred {background-color: #FF0000;}",
"#bgblue {background-color: #0000FF;}")
and write #...
inside the cell : 并在单元格内写
#...
> 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
Then use my colortable()
function mainly inspired from the highlightHTML
package and from my personal shiny experience. 然后使用我的
colortable()
函数,主要灵感来自highlightHTML
包和我个人的闪亮体验。 Here is an example: 这是一个例子:
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)
})
})
)
Nowadays there is more elegant solution by using shinyTables: 如今使用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"))
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.