reactable

R语言
可视化
表格
R语言reactable包生成交互式表格
作者

不止BI

发布于

2024年4月10日

R语言的reactable包是一个用于创建交互式表格的强大工具。它提供了丰富的功能和灵活的选项，使用户可以轻松地定制和展示数据表格

代码 
library(reactable)
library(htmltools)
library(reactablefmtr)
library(tidyverse)

data <- iris %>%
  mutate(ID = row_number()) %>%
  sample_n(30) %>%
  select(Species, everything())
reactable(data)

基本用法

修改语言配置

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图例
  • 2
  • 0.75
  • 0.41
  • -0.13
  • -2.72
Use RColorBrewer
Bar1图例
  • -0.9294
  • -0.4055
  • 0.0048
  • 0.6544
  • 0.8893

工具提示

代码 
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
  )
)

分组及行内嵌入

  1. sum（求和）：将给定列中的所有数值相加，得到总和。

  2. mean（平均值）：计算给定列中数值的平均值。它是所有数值之和除以数值的数量。

  3. max（最大值）：找到给定列中的最大数值。

  4. min（最小值）：找到给定列中的最小数值。

  5. median（中位数）：将给定列中的数值按升序排列，然后找到中间位置的数值。如果数值的数量是奇数，中位数就是中间的那个数；如果是偶数，中位数是中间两个数的平均值。

  6. count（计数）：计算给定列中非空数值的数量。

  7. unique（唯一值）：列出给定列中的所有唯一数值，用逗号分隔。

  8. 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"))
    )
  )

  1. details 参数：在 reactable 中，details 参数是一个函数，用于定义在用户点击某一行时显示的详细信息。当用户点击表格中的某一行时，details 函数会被调用，并传递该行的索引作为参数，可以在这里自定义希望显示的详细信息，例如该行的其他属性或其他相关数据，支持html及JS。

  2. 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")
  )

m

 

JS及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 virginica  virginica  setosa     setosa    
 [7] virginica  setosa     versicolor virginica  setosa     versicolor
[13] setosa     virginica  virginica  setosa     virginica  setosa    
[19] versicolor virginica  versicolor setosa     virginica  versicolor
[25] versicolor virginica  versicolor versicolor setosa     versicolor
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")
  )
)
回到顶部