R中类似Tableau的分组表，用于降价

Question

我经常发现自己使用 dplyr 在 R 中计算汇总统计数据，然后将结果写入 csv 并将其加载到 Tableau 中以生成表格，因为 Tableau 的表格非常简单易行。我宁愿直接在 R 中生成表格。

R 中的分组表有简单的解决方案吗？

生成我想要的数据非常容易：

library(tidyr)
library(dplyr)

summary_table <- iris %>% 
  gather(measure, value, -Species) %>% 
  separate(measure, into=c("attribute", "dimension")) %>% 
  group_by(Species, attribute, dimension) %>% 
  summarise(mean=mean(value))

summary_table

Source: local data frame [12 x 4]
Groups: Species, attribute [?]

      Species attribute dimension  mean
       <fctr>     <chr>     <chr> <dbl>
1      setosa     Petal    Length 1.462
2      setosa     Petal     Width 0.246
3      setosa     Sepal    Length 5.006
4      setosa     Sepal     Width 3.428
5  versicolor     Petal    Length 4.260
6  versicolor     Petal     Width 1.326
7  versicolor     Sepal    Length 5.936
8  versicolor     Sepal     Width 2.770
9   virginica     Petal    Length 5.552
10  virginica     Petal     Width 2.026
11  virginica     Sepal    Length 6.588
12  virginica     Sepal     Width 2.974

现在我想将其呈现为：

我想尝试几种不同的组织方式，所以我希望能够轻松地按行而不是按列进行分组

分组行版本的主要特点是：

• 分组变量位于左侧，在一个单独的列中，而不是在一个单独的行中，在一个跨越所有行的单元格中
• 组级别的水平单元格边框

我是 rmarkdown 的新手，但最终目标是将其包含在 html 文档中。

这可能吗？

Answer 1

以下是使用htmlTable 包创建每个表的方法。我不确定如何在物种之间添加水平线，但我确实添加了斑马阴影。

这是rmarkdown 文档：

---
title: "<h3>Untitled</h3>"
author: "Author"
date: "September 3, 2016"
output: html_document
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message=FALSE, warning=FALSE)
```

```{r}
library(tidyr)
library(dplyr)
library(reshape2)
library(htmlTable)
```

```{r}
st = iris %>% 
  gather(measure, value, -Species) %>% 
  separate(measure, into=c("attribute", "dimension")) %>% 
  group_by(Species, attribute, dimension) %>% 
  summarise(mean=mean(value)) %>%
  spread(dimension, mean) 

# Keep only first value of outer grouping column
st = st %>%
  group_by(Species) %>%
  mutate(count=1:n()) %>%
  ungroup %>%
  mutate(Species = ifelse(count==1, as.character(Species), NA)) %>%
  select(-count)

# Remove names of grouping columns
names(st)[1:2] = ""

# Round numeric columns to two decimal places
st[,sapply(st,is.numeric)] = sapply(st[,sapply(st,is.numeric)], function(x) sprintf("%1.2f",x))

htmlTable(st, rnames=FALSE, align="llrr", align.header="llrr",
          col.rgroup = rep(c("none", "gray93"), each=2),
          css.cell = c("padding-left: 0em","padding-left: 1em",rep("padding-left: 2em",2)))
```  
```{r}
# Another option
htmlTable(st[,-1], rnames=FALSE, align="llrr", align.header="lrr",
          n.rgroup=rep(2,3),
          rgroup=rep(unique(iris$Species),2), 
          #col.rgroup = c("none","gray93"),   # If you want to add alternating shading
          css.cell=c("padding-left: 0.5em","padding-left: 4em","padding-left: 1.5em"))
```

```{r}
st = iris %>% 
  melt(id.var="Species") %>% 
  group_by(Species, variable) %>%
  summarise(mean=mean(value)) %>%
  dcast(Species ~ variable)
names(st)[1] = ""

# Round numeric columns to two decimal places
st[,sapply(st,is.numeric)] = sapply(st[,sapply(st,is.numeric)], function(x) sprintf("%1.2f",x))

# Set up grouping columns and column names
group_col = gsub("(.*)\\..*", "\\1", names(st))
group_col = factor(group_col, levels=unique(group_col))
names(st) = gsub(".*\\.", "", names(st))

htmlTable(st, rnames=FALSE, align="lrrrr",
          align.header="lrrrr",
          cgroup=unique(group_col), n.cgroup=unclass(table(group_col)),
          css.cell = c("padding-left: 0em","padding-left: 1.5em", rep("padding-left: 2em",3)))
```

这是输出：

Answer 2

你可以在kableExtra包上使用collapse_rows函数

summary_table %>% 
  kableExtra::kable() %>% 
  kableExtra::collapse_rows(1)

这是输出：

您还可以修改表格，使其更漂亮。更多详情here.

Answer 3

我会查看xtable 包中xtableFtable 函数的选项。您可以在本文档的第 2.8 节中查看示例： https://cran.r-project.org/web/packages/xtable/vignettes/xtableGallery.pdf