我有以下数据框:
col1 <- rep(c("A","B","C","D"),10)
col2 <- rep(c(1,0),10)
col3 <- rep(c(0,1),10)
col4 <- rep(c(1,0),10)
col5 <- rep(c(0,1),10)
test_df <- data.frame(col1, col2, col3, col4, col5, stringsAsFactors = F)
我想根据 col1 中的值对多列中的特定行单元格进行着色,并在表中的两列之间添加一条垂直线(指示限制)(基于 col1 中的相同值)
例如,如果 col1 == "A",那么我想将 col2 和 col5 中的单元格着色为灰色,与 col1 == A 位于同一行。
在虚拟代码中:
if col1 == A: color columns(col2, col5), vert.line between col3 and col4
if col1 == B: color columns(col2, col3, col5), vert.line between col4 and col5
if col1 == C: color columns(col2, col4, col5), vert.line between col3 and col4
if col1 == D: color columns(col2, col5), vert.line between col2 and col3
我想指定这些规则,以便在必要时可以轻松更改它们。
我想最终得到这样的结果(星号表示单元格颜色):
col1 col2 col3 col4 col5
A *1* 0 | 1 *0*
B *0* *1* 0 | *1*
C *1* *0* | 1 *0*
D *0* | 1 0 *1*
A *1* 0 | 1 *0*
B *0* *1* 0 | *1*
C *1* *0* | 1 *0*
D *0* | 1 0 *1*
我将在一个闪亮的应用程序和 Markdown 文档中的表格中呈现此内容。有什么办法可以用 f 来做到这一点吗?前 xtable 或 dplyr?
有一个解决方案,使用
tableHTML
结合 2 个函数来复制逻辑。
首先,您需要为每列创建 css,以提供应应用于表格的样式信息。我将其分成 2 个函数,一个用于背景,一个用于列之间的线。
library(tableHTML)
第一个函数根据
col1
中的值更改单元格的颜色。您可以通过在函数的参数中提供不同的颜色来更改它们。
get_background_column_css <- function(col1,
a_col = "lightgray",
b_col = "steelblue",
c_col = "lightgreen",
d_col = "indianred",
default = "white") {
# create css for col2
background_color_col2 <- ifelse(col1 == "A", a_col,
ifelse(col1 == "B", b_col,
ifelse(col1 == "C", c_col,
ifelse(col1 == "D", d_col, default
))))
css_col2 <- setNames(list(list(c("background-color"),
list(background_color_col2))), "col2")
# create css for col3
background_color_col3 <- ifelse(col1 == "B", b_col,
ifelse(col1 == "C", c_col, default))
css_col3 <- setNames(list(list(c("background-color"),
list(background_color_col3))), "col3")
# create css for col4
background_color_col4 <- rep("", length(col1))
css_col4 <- setNames(list(list(c("background-color"),
list(background_color_col4))), "col4")
# create css for col5
background_color_col5 <- ifelse(col1 == "A", a_col,
ifelse(col1 == "B", b_col,
ifelse(col1 == "C", c_col,
ifelse(col1 == "D", d_col, default
))))
css_col5 <- setNames(list(list(c("background-color"),
list(background_color_col5))), "col5")
list(css_col2, css_col3, css_col4, css_col5)
}
第二个函数在列之间添加边框。
get_border_column_css <- function(col1) {
# create css for col2
border_col2 <- ifelse(col1 == "D", "1px solid black", "0px")
css_col2 <- setNames(list(list(c("border-right"),
list(border_col2))), "col2")
# create css for col3
border_col3 <- ifelse(col1 == "C", "1px solid black", "0px")
css_col3 <- setNames(list(list(c("border-right"),
list(border_col3))), "col3")
# create css for col4
border_col4 <- ifelse(col1 == "B", "1px solid black", "0px")
css_col4 <- setNames(list(list(c("border-right"),
list(border_col4))), "col4")
# create css for col5
border_col5 <- rep("0px", length(col1))
css_col5 <- setNames(list(list(c("border-right"),
list(border_col5))), "col5")
list(css_col2, css_col3, css_col4, css_col5)
}
为了测试该功能,我只使用前 4 行(因为它们具有所有可能性的组合):
test_df <- head(test_df, 4)
接下来,我为
background-color
创建 1 个 css 列表,为 border
创建 1 个 css 列表,可以提供给 add_css_conditional_column()
css_background = get_background_column_css(test_df$col1)
css_border = get_border_column_css(test_df$col1)
接下来,我创建一个
tableHTML
对象。
tableHTML <- tableHTML(test_df,
rownames = FALSE,
border = 0)
接下来,我将循环中的背景 CSS 添加到每列:
for (i in 1:4) {
tableHTML <- tableHTML %>%
add_css_conditional_column(conditional = "colour_rank",
colour_rank_css = css_background[[i]],
columns = names(test_df)[i + 1])
}
还有边框CSS:
for (i in 1:4) {
tableHTML <- tableHTML %>%
add_css_conditional_column(conditional = "colour_rank",
colour_rank_css = css_border[[i]],
columns = names(test_df)[i + 1])
}
这是结果:
tableHTML
这是一个部分(不进行列之间的自定义行分隔)解决方案。
formattable
。
使用的数据框是您问题中定义的
df
。
library(formattable)
library(dplyr)
## Function that create the formula for the coloring of each row
## You could also personalize the color
color_row <- function(r,
c,
color = 'gray') {
return(area(row = r, col = c) ~ color_tile(color, color))
}
## Create database that containes info on coloring pattern
df_color <- data_frame(col1 = c('A', 'B', 'C', 'D'),
limits = list(c(2,5), c(2,3,5), c(2,4,5), c(2,5)))
## Join it to original data.frame
df_join <- df %>% left_join(df_color)
## Create list with all the appropriate formulas to color data frame
format_list <- mapply(color_row, r = 1:nrow(df), c = df_join$limits, color = 'gray')
## Pass it to formattable
df_final <- formattable(df,format_list)
这可以很容易地在 RNotebook 和 Shiny 中使用。以下是每个代码的示例代码(为了使下面的代码正常工作,您需要将前面代码的结果
df_final
放入您的环境中):
---
title: "R Notebook"
output: html_notebook
---
```{r}
library(dplyr)
library(formattable)
format_table(df_final)
```
闪亮:
library(shiny)
library(formattable)
# table example
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
formattableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderFormattable(df_final)
}
)
DT 包有一个巧妙的方法来做到这一点。您使用一列为另一列着色,然后隐藏前一列。 https://rstudio.github.io/DT/010-style.html