代码
library(reactable)
library(htmltools)
library(reactablefmtr)
library(tidyverse)
data <- iris %>%
mutate(ID = row_number()) %>%
sample_n(30) %>%
select(Species, everything())
reactable(data)reactable
R语言
可视化
表格
R语言reactable包生成交互式表格
R语言的reactable包是一个用于创建交互式表格的强大工具。它提供了丰富的功能和灵活的选项，使用户可以轻松地定制和展示数据表格
基本用法
修改语言配置
options修改全局reactable.language的配置
代码
options(reactable.language = reactableLang(
sortLabel = "按{名称}排序",
filterPlaceholder = "",
filterLabel = "筛选{名称}",
searchPlaceholder = "搜索",
searchLabel = "搜索",
noData = "未找到行",
pageNext = "下一页",
pagePrevious = "上一页",
pageNumbers = "{page}/{pages}",
pageInfo = "{rowStart}\u2013{rowEnd}，共{rows}行",
pageSizeOptions = "显示{rows}行",
pageNextLabel = "下一页",
pagePreviousLabel = "上一页",
pageNumberLabel = "第{page}页",
pageJumpLabel = "跳转到页",
pageSizeOptionsLabel = "每页行数",
groupExpandLabel = "展开/收起分组",
detailsExpandLabel = "展开/收起详情",
selectAllRowsLabel = "选择所有行",
selectAllSubRowsLabel = "选择所有分组行",
selectRowLabel = "选择行",
defaultGroupHeader = NULL,
detailsCollapseLabel = NULL,
deselectAllRowsLabel = NULL,
deselectAllSubRowsLabel = NULL,
deselectRowLabel = NULL
))
reactable(data)常用基本操作
代码
reactable(
data,
defaultColDef = colDef(
header = function(value) gsub(".", " ", value, fixed = TRUE), # 设置列标题，将点替换为空格
cell = function(value) format(value, nsmall = 1), # 格式化单元格值，保留一位小数
align = "center", # 居中对齐
minWidth = 150, # 最小列宽
sortNALast = TRUE, # 将缺失值放在排序结果的最后
# headerStyle = list(background = "#f7f7f8"), # 设置表头样式（注释掉的部分）
footerStyle = list(fontWeight = "bold") # 设置表尾样式，加粗字体
), # 对所有列的操作
columns = list(
Sepal.Length = colDef(name = "花萼长度", footer = function(values) sprintf("$%.2f", sum(values))), # 设置花萼长度列
Sepal.Width = colDef(name = "花萼宽度", footer = function(values) sprintf("$%.2f", sum(values))), # 设置花萼宽度列
Species = colDef(align = "center", defaultSortOrder = "asc", footer = "合计", sticky = "left", cell = function(value, index) {
sampleid <- data$ID[index]
div(
div(style = list(fontWeight = 600), value),
div(style = list(fontSize = "0.75rem"), paste("id=", sampleid))
)
}, name = "Species/Id"), # 设置物种列
ID = colDef(show = FALSE)
),
bordered = TRUE, # 显示边框
borderless = FALSE, # 显示值边框
striped = TRUE, # 交替突出行
fullWidth = TRUE, # 自适应100%页面宽度
resizable = TRUE, # 允许调整列宽
wrap = TRUE, # 自动换行
defaultSortOrder = "desc", # 默认降序排序
filterable = TRUE, # 允许筛选
minRows = 5, # 最小行数，避免在分页的时候最后一页行数不够表格缩短
defaultPageSize = 5, # 默认每页显示行数
pageSizeOptions = c(5, 10, 15), # 可选的每页行数
paginationType = "jump", # 分页类型为跳转
showPageInfo = TRUE, # 显示页码信息
showPageSizeOptions = TRUE, # 显示每页行数选项
pagination = TRUE, # 显示分页
highlight = TRUE, # 悬浮高亮显示
defaultSorted = c("Species", "Petal.Length"), # 默认排序列
searchable = TRUE, # 允许搜索
class = "myclass" # 添加类，通过css控制类的格式
)进阶功能
列格式
代码
library(timetk)
library(lubridate)
datetimes <- tk_make_timeseries(
start_date = today(),
end_date = today() + 1, by = "hour"
)
Tdata <- data.frame(
datetime = datetimes,
date = datetimes,
time = datetimes,
time_24h = datetimes
) %>%
mutate(
CNY = as.integer(runif(25, 100, 10000)),
URL = "https://notjustbi.rbind.io/",
Boolen = sample(c("TRUE", "FALSE"), length(datetimes), replace = TRUE),
ValueColor = rnorm(length(datetimes)),
BgColor = rnorm(length(datetimes)),
ColorTile = rnorm(length(datetimes)),
Bar1 = runif(n = length(datetimes), min = -1, max = 1),
Bar2 = runif(n = length(datetimes), min = 0, max = 1),
Icon1 = as.integer(runif(n = length(datetimes), min = 0, max = 100)),
Icon2 = runif(n = length(datetimes), min = -1, max = 1)
)
Tdata %>%
reactable(theme = hoverdark(), defaultColDef = colDef(format = colFormat(digits = 2), align = "center"), columns = list(
datetime = colDef(format = colFormat(datetime = TRUE)),
date = colDef(format = colFormat(date = TRUE)),
time = colDef(format = colFormat(time = TRUE), show = FALSE),
time_24h = colDef(format = colFormat(time = TRUE, hour12 = FALSE)),
CNY = colDef(
format = colFormat(currency = "CNY", separators = TRUE, locales = "zh-CN")
),
URL = colDef(cell = function(value) {
htmltools::tags$a(href = value, target = "_blank", "不止BI")
}),
Boolen = colDef(cell = function(value) {
if (value == "FALSE") "\u274c FALSE" else "\u2714\ufe0f TRUE"
}),
ValueColor = colDef(style = function(value) {
if (value > 0) {
color <- "#008000"
} else if (value < 0) {
color <- "#e00000"
} else {
color <- "#777"
}
list(color = color, fontWeight = "bold")
}, format = colFormat(digits = 2)),
BgColor = colDef(style = color_scales(Tdata, colors = RColorBrewer::brewer.pal(4, name = "Accent"))),
ColorTile = colDef(style = color_tiles(Tdata, colors = RColorBrewer::brewer.pal(4, name = "Accent"))),
Bar1 = colDef(cell = data_bars(.,
fill_color = c("#e00000", "#008000"), number_fmt = scales::percent
), width = 250),
Bar2 = colDef(cell = data_bars(.,
text_position = "outside-base", number_fmt = scales::percent
), width = 250),
Icon1 = colDef(cell = icon_assign(., icon = "circle", fill_color = "#67a9cf", buckets = 5, show_values = "right")),
Icon2 = colDef(cell = icon_sets(., c("arrow-down", "minus", "arrow-up"), number_fmt = scales::percent))
)) %>%
add_legend(Tdata,
col_name = "BgColor",
colors = RColorBrewer::brewer.pal(4, name = "Accent"),
title = "BgColor图例", footer = "Use RColorBrewer"
) %>%
add_legend(Tdata,
col_name = "Bar1",
colors = c("#e00000", "#008000"),
title = "Bar1图例", align = "left"
)BgColor图例
- 1.91
- 1
- 0.2
- -0.67
- -1.81
Use RColorBrewer
Bar1图例
- -0.94
- -0.57
- -0.19
- 0.43
- 0.69
工具提示
代码
sitedata <- data.frame(
Address = c("https://google.com", "https://yahoo.com", "https://duckduckgo.com"),
Site = c("Google", "Yahoo", "DuckDuckGo")
)
sitedata2 <- data.frame(value = round(runif(3, 1000, 10000)))
library(tippy)
reactable(
sitedata,
columns = list(
Address = colDef(cell = function(value) {
htmltools::tags$a(href = value, target = "_blank", value)
}),
# Or using raw HTML
Site = colDef(html = TRUE, cell = function(value, index) {
div(
style = "text-decoration: underline; text-decoration-style: dotted; cursor: help",
tippy(sitedata$Site[index],
tooltip =
div(
style = "display: grid; grid-template-columns: 60fr 20fr; gap: 10px;",
span(paste(sitedata$Site[index], ":", sitedata$Address[index]), style = "color: white"),
span(paste("value:", sitedata2$value[index]), style = "color: red")
)
)
)
})
)
)行背景色
代码
dimnames <- list(start(nottem)[1]:end(nottem)[1], month.abb)
temps <- matrix(nottem, ncol = 12, byrow = TRUE, dimnames = dimnames)
temps <- as_tibble(temps, rownames = "Year")
temppal <- c("#36a1d6", "#76b8de", "#a0bfd9", "#ffffff", "#d88359", "#d65440", "#c62c34")
reactable(
temps,
defaultColDef = colDef(
style = color_scales(temps, span = TRUE, colors = temppal),
minWidth = 50
)
)分组及行内嵌入
分组汇总函数
sum（求和）：将给定列中的所有数值相加，得到总和。mean（平均值）：计算给定列中数值的平均值。它是所有数值之和除以数值的数量。max（最大值）：找到给定列中的最大数值。min（最小值）：找到给定列中的最小数值。median（中位数）：将给定列中的数值按升序排列，然后找到中间位置的数值。如果数值的数量是奇数，中位数就是中间的那个数；如果是偶数，中位数是中间两个数的平均值。count（计数）：计算给定列中非空数值的数量。unique（唯一值）：列出给定列中的所有唯一数值，用逗号分隔。frequency（频率）：列出给定列中每个唯一数值的出现次数，用逗号分隔。
代码
data %>% reactable(
groupBy = "Species",
columns = list(
Sepal.Length = colDef(aggregate = "max"),
Sepal.Width = colDef(aggregate = "mean", format = colFormat(digits = 1)),
Petal.Length = colDef(aggregate = "unique"),
Petal.Width = colDef(aggregate = "frequency")
)
)代码
data %>%
reactable(
columns = list(
Sepal.Length = colDef(name = "Length"),
Sepal.Width = colDef(name = "Width"),
Petal.Length = colDef(name = "Length"),
Petal.Width = colDef(name = "Width")
),
columnGroups = list(
colGroup(name = "Sepal", columns = c("Sepal.Length", "Sepal.Width")),
colGroup(name = "Petal", columns = c("Petal.Length", "Petal.Width"))
)
)details参数：在reactable中，details参数是一个函数，用于定义在用户点击某一行时显示的详细信息。当用户点击表格中的某一行时，details函数会被调用，并传递该行的索引作为参数，可以在这里自定义希望显示的详细信息，例如该行的其他属性或其他相关数据，支持html及JS。index参数：这是传递给details函数的参数，表示用户点击的行的索引。可以使用这个索引来获取该行的数据，然后将其格式化为想要的详细信息的形式。
代码
library(sparkline)
library(RColorBrewer)
library(htmltools)
data %>%
reactable(details = function(index) {
htmltools::div(
"Details for row: ", index,
htmltools::tags$pre(
paste(capture.output(data[index, ]), collapse = "\n"),
tags$div(
sparkline(data[index, 2:length(data)],
type = "pie",
sliceColors = brewer.pal(5, "Set2"), # 指定饼图中各个扇形的颜色。
offset = 90, # 指定饼图的旋转角度
width = 50, # 指定迷你图的宽度
height = 50 # 指定迷你图的高度
),
sparkline(data[index, 2:length(data)],
type = "box", width = 100, height = 50
)
)
)
)
})sparkline
代码
library(sparkline)
data %>%
reactable(
defaultPageSize = 5,
bordered = TRUE,
defaultColDef = colDef(footer = function(values) {
if (!is.numeric(values)) {
return()
}
sparkline(values, type = "box", width = 100, height = 30)
})
)代码
library(dplyr)
library(sparkline)
data_list <- data %>%
group_by(Species) %>%
summarise(Sepal.Length = list(Sepal.Length)) %>%
mutate(boxplot = NA, sparkline1 = NA, sparkline2 = Sepal.Length, sparkline3 = Sepal.Length, sparkline4 = Sepal.Length) %>%
mutate(cols = case_when(
Species == "setosa" ~ "#f5a24b",
Species == "versicolor" ~ "#af52d5",
Species == "virginica" ~ "#4c9b9b",
TRUE ~ "grey"
))
data_list %>%
reactable(columns = list(
cols = colDef(show = FALSE),
Sepal.Length = colDef(cell = function(values) {
sparkline(values,
type = "bar", chartRangeMin = 0,
chartRangeMax = max(data$Sepal.Length)
)
}),
boxplot = colDef(cell = function(value, index) {
sparkline(data_list$Sepal.Length[[index]], type = "box")
}),
sparkline1 = colDef(cell = function(value, index) {
sparkline(data_list$Sepal.Length[[index]])
}),
sparkline2 = colDef(
cell = react_sparkline(
data_list,
height = 80,
line_color_ref = "cols",
highlight_points = highlight_points(min = "red", max = "blue"),
labels = c("min", "max"),
statline = "mean",
bandline = "innerquartiles",
tooltip_type = 2
)
),
sparkline3 = colDef(
cell = react_sparkline(
data_list,
height = 80,
show_area = TRUE,
line_width = 2,
area_color_ref = "cols",
tooltip_type = 2
)
),
sparkline4 = colDef(
cell = react_sparkbar(
data_list,
height = 80,
fill_color_ref = "cols",
bandline = "innerquartiles",
statline = "mean",
tooltip_type = 2
)
)
))组件通信
代码
library(crosstalk)
library(leaflet)
library(leafletCN)
df_home_location <- tribble(
~Name, ~WGS84Longitude, ~WGS84Latitude, ~value,
"地点1", 121.33739, 31.13533, 10,
"地点2", 121.33539, 31.15533, 20,
"地点3", 121.33939, 31.13533, 30,
"地点4", 121.33239, 31.15533, 40
)
Sdata <- SharedData$new(df_home_location)
shiny::column(
4,
filter_slider("v", "值", Sdata, ~value, width = "100%"),
filter_select("ln", "地点名称", Sdata, ~Name)
)
shiny::column(
8,
reactable(Sdata,
selection = "multiple",
onClick = "select",
rowStyle = list(cursor = "pointer")
)
)
m <- leaflet(Sdata) %>%
# 添加高德地图底图
amap(group = "高德") %>%
# 设置地图中心和缩放级别
setView(
lng = 121.33739,
lat = 31.13533,
zoom = 12
) %>% addAwesomeMarkers(
lng = ~WGS84Longitude,
lat = ~WGS84Latitude,
label = ~Name,
popup = ~Name,
icon = awesomeIcons(icon = "home")
)
mJS及html引入
导出数据
browsable用于渲染html文本
代码
library(htmltools)
library(fontawesome)
htmltools::browsable(
tagList(
tags$button(
tagList(fontawesome::fa("download"), "导出csv"),
onclick = "Reactable.downloadDataCSV('iris-download-table', 'iris.csv')"
),
reactable(
data,
searchable = TRUE,
defaultPageSize = 5,
elementId = "iris-download-table"
)
)
)自定义筛选
代码
library(htmltools)
data$Species [1] virginica versicolor versicolor virginica virginica virginica
[7] virginica setosa virginica setosa setosa setosa
[13] versicolor virginica setosa setosa versicolor virginica
[19] versicolor virginica versicolor virginica setosa versicolor
[25] versicolor virginica setosa virginica virginica setosa
Levels: setosa versicolor virginica代码
htmltools::browsable(
tagList(
div(
div(tags$label("筛选Species", `for` = "iris-species-filter")),
tags$select(
id = "iris-species-filter",
onchange = "Reactable.setFilter('iris-species-table', 'Species', this.value)",
tags$option("全选", value = ""),
lapply(unique(data$Species), tags$option)
)
),
tags$hr("aria-hidden" = "true"),
reactable(data, defaultPageSize = 5, elementId = "iris-species-table")
)
)