如何用expss创建两个headers table
How to create two headers table with expss
我已经阅读了两个带有 expss 包的 headers table here and here，但是在线代码对我不起作用。我的想法是创建一个与此图像非常相似的 table：
数据框是：
df <- data.frame(Categoria = c("gender", "gender" , "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"),
Opcoes_da_categoria = c("Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"),
Resposta = c("A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5))
我创建两个 headers table 的代码如下，但由于以下问题而无法正常工作：
- table应该有两个headers
- 列名不应出现在 table
- 该值不应有小数形式
library(expss)
my_table <- df %>%
tab_cells(Resposta) %>%
tab_weight(value_perc) %>%
tab_cols(Opcoes_da_categoria, Categoria) %>%
tab_stat_cpct(total_label = NULL) %>%
tab_pivot()
library(gridExtra)
png("my_table.png", height = 50*nrow(my_table), width = 200*ncol(my_table))
grid.table(my_table)
dev.off()
我不知道 expss 但最近用过 flextable 并且觉得它不错。由于远非这方面的专家，我设法做出了一个漂亮的 table，它接近你想要的。
从您的 DF 开始，必须进行一些更改，以使 DF 具有您 table 所需的格式。通过提取 _ 之前的名称部分，重命名 col-names。构建了描述 col 和 header-names 依赖关系的 DF typology。 （可以在上面的link中找到）。
然后 flextable 部分来了，它首先构建一个 flextable 然后应用 typology 和其他格式化命令。
结果如图所示。
library(tidyverse)
library(flextable)
#>
#> Attache Paket: 'flextable'
#> The following object is masked from 'package:purrr':
#>
#> compose
df <- data.frame(
Categoria = c(
"gender", "gender", "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"
),
Opcoes_da_categoria = c(
"Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"
),
Resposta = c(
"A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"
),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5)
)
# adjust your df to match cols and names with tidyvers
dfa <- df %>%
pivot_wider(names_from =c('Opcoes_da_categoria', 'Categoria'), values_from = 'value_perc')
nam <- str_extract(colnames(dfa),'^[^_]+')
colnames(dfa) <- nam
typology <- data.frame(
col_keys = c( "Resposta",
"Mulher", "Homem",
"Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico"),
what = c("", "Genero", "Genero", "Religio",
"Religio", "Religio", 'Religio'),
measure = c( "Resposta",
"Mulher", "Homem",
"Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico"),
stringsAsFactors = FALSE )
library(officer) # needed for making border
dftab <- flextable::flextable(dfa)
border_v = fp_border(color="gray")
dftab <- dftab %>%
set_header_df(mapping = typology, key = "col_keys" ) %>%
merge_h(part = "header") %>%
merge_v(part = "header") %>%
theme_booktabs() %>%
vline(border = border_v, j =3, part = 'body') %>%
vline(border = border_v, j =3, part = 'header')
print(dftab)
#> a flextable object.
#> col_keys: `Resposta`, `Mulher`, `Homem`, `Outra religião`, `Católico`, `Agnóstico ou ateu`, `Evangélico`
#> header has 2 row(s)
#> body has 3 row(s)
#> original dataset sample:
#> Resposta Mulher Homem Outra religião Católico Agnóstico ou ateu Evangélico
#> 1 A Favor 65 50 67 64 56 28
#> 2 Contra 33 43 31 34 35 66
#> 3 Não sei 2 7 2 2 10 5
这里有一个灵活的kable解决方案，只要你能把数据变成宽格式，应该能适应不同的表。希望对您有所帮助——如果您有任何问题，请告诉我！
library(dplyr)
library(tidyr)
library(knitr)
library(kableExtra)
df_wide <- df %>% # transform data to wide format, "drop" name for Resposta
pivot_wider(names_from = c(Categoria, Opcoes_da_categoria),
values_from = value_perc, names_sep = "_") %>%
rename(" " = Resposta)
cols <- sub("(.*?)_(.*)", "\2", names(df_wide)) # grab everything after the _
grps <- sub("(.*?)_(.*)", "\1", names(df_wide)) # grab everything before the _
df_wide %>%
kable(col.names = cols) %>%
kable_styling(c("striped"), full_width = FALSE) %>% # check out ?kable_styling for other options
add_header_above(table(grps)[unique(grps)]) # unique makes sure it is the correct order
您尝试在 RStudio Data 查看器中查看 table。它像往常一样显示 expss tables data.frames.
您可以通过设置 expss_output_viewer():
在 RStudio 查看器（不是数据查看器）中查看 expss table
df <- data.frame(Categoria = c("gender", "gender" , "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"),
Opcoes_da_categoria = c("Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"),
Resposta = c("A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5))
library(expss)
my_table <- df %>%
tab_cells(Resposta) %>%
tab_weight(value_perc) %>%
tab_cols(Opcoes_da_categoria, Categoria) %>%
tab_stat_cpct(total_label = NULL) %>%
tab_pivot()
expss_digits(0) # turn off decimal digits
expss_output_viewer() # turn on displaying tables in the viewer
my_table
expss_output_default() # turn off displaying tables in the viewer
此代码给出以下结果：
如果您真的想在数据查看器中显示 table，您可以将 table 转换为通常的 data.frame。有一个特殊的命令 - split_table_to_df:
View(split_table_to_df(my_table))
结果：
更新:
df <- data.frame(Categoria = c("gender", "gender" , "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"),
Opcoes_da_categoria = c("Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"),
Resposta = c("A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5))
library(expss)
my_table <- df %>%
apply_labels(
Resposta = "",
Opcoes_da_categoria = "",
Categoria = ""
) %>%
tab_cells(Resposta) %>%
tab_weight(value_perc) %>%
tab_cols(Categoria, Opcoes_da_categoria) %>%
tab_stat_cpct(total_row_position = "none") %>%
tab_pivot()
expss_digits(0) # turn off decimal digits
View(my_table)
我已经阅读了两个带有 expss 包的 headers table here and here，但是在线代码对我不起作用。我的想法是创建一个与此图像非常相似的 table：
数据框是：
df <- data.frame(Categoria = c("gender", "gender" , "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"),
Opcoes_da_categoria = c("Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"),
Resposta = c("A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5))
我创建两个 headers table 的代码如下，但由于以下问题而无法正常工作：
- table应该有两个headers
- 列名不应出现在 table
- 该值不应有小数形式
library(expss)
my_table <- df %>%
tab_cells(Resposta) %>%
tab_weight(value_perc) %>%
tab_cols(Opcoes_da_categoria, Categoria) %>%
tab_stat_cpct(total_label = NULL) %>%
tab_pivot()
library(gridExtra)
png("my_table.png", height = 50*nrow(my_table), width = 200*ncol(my_table))
grid.table(my_table)
dev.off()
我不知道 expss 但最近用过 flextable 并且觉得它不错。由于远非这方面的专家，我设法做出了一个漂亮的 table，它接近你想要的。
从您的 DF 开始，必须进行一些更改，以使 DF 具有您 table 所需的格式。通过提取 _ 之前的名称部分，重命名 col-names。构建了描述 col 和 header-names 依赖关系的 DF typology。 （可以在上面的link中找到）。
然后 flextable 部分来了，它首先构建一个 flextable 然后应用 typology 和其他格式化命令。
结果如图所示。
library(tidyverse)
library(flextable)
#>
#> Attache Paket: 'flextable'
#> The following object is masked from 'package:purrr':
#>
#> compose
df <- data.frame(
Categoria = c(
"gender", "gender", "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"
),
Opcoes_da_categoria = c(
"Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"
),
Resposta = c(
"A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"
),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5)
)
# adjust your df to match cols and names with tidyvers
dfa <- df %>%
pivot_wider(names_from =c('Opcoes_da_categoria', 'Categoria'), values_from = 'value_perc')
nam <- str_extract(colnames(dfa),'^[^_]+')
colnames(dfa) <- nam
typology <- data.frame(
col_keys = c( "Resposta",
"Mulher", "Homem",
"Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico"),
what = c("", "Genero", "Genero", "Religio",
"Religio", "Religio", 'Religio'),
measure = c( "Resposta",
"Mulher", "Homem",
"Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico"),
stringsAsFactors = FALSE )
library(officer) # needed for making border
dftab <- flextable::flextable(dfa)
border_v = fp_border(color="gray")
dftab <- dftab %>%
set_header_df(mapping = typology, key = "col_keys" ) %>%
merge_h(part = "header") %>%
merge_v(part = "header") %>%
theme_booktabs() %>%
vline(border = border_v, j =3, part = 'body') %>%
vline(border = border_v, j =3, part = 'header')
print(dftab)
#> a flextable object.
#> col_keys: `Resposta`, `Mulher`, `Homem`, `Outra religião`, `Católico`, `Agnóstico ou ateu`, `Evangélico`
#> header has 2 row(s)
#> body has 3 row(s)
#> original dataset sample:
#> Resposta Mulher Homem Outra religião Católico Agnóstico ou ateu Evangélico
#> 1 A Favor 65 50 67 64 56 28
#> 2 Contra 33 43 31 34 35 66
#> 3 Não sei 2 7 2 2 10 5
这里有一个灵活的kable解决方案，只要你能把数据变成宽格式，应该能适应不同的表。希望对您有所帮助——如果您有任何问题，请告诉我！
library(dplyr)
library(tidyr)
library(knitr)
library(kableExtra)
df_wide <- df %>% # transform data to wide format, "drop" name for Resposta
pivot_wider(names_from = c(Categoria, Opcoes_da_categoria),
values_from = value_perc, names_sep = "_") %>%
rename(" " = Resposta)
cols <- sub("(.*?)_(.*)", "\2", names(df_wide)) # grab everything after the _
grps <- sub("(.*?)_(.*)", "\1", names(df_wide)) # grab everything before the _
df_wide %>%
kable(col.names = cols) %>%
kable_styling(c("striped"), full_width = FALSE) %>% # check out ?kable_styling for other options
add_header_above(table(grps)[unique(grps)]) # unique makes sure it is the correct order
您尝试在 RStudio Data 查看器中查看 table。它像往常一样显示 expss tables data.frames.
您可以通过设置 expss_output_viewer():
expss table
df <- data.frame(Categoria = c("gender", "gender" , "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"),
Opcoes_da_categoria = c("Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"),
Resposta = c("A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5))
library(expss)
my_table <- df %>%
tab_cells(Resposta) %>%
tab_weight(value_perc) %>%
tab_cols(Opcoes_da_categoria, Categoria) %>%
tab_stat_cpct(total_label = NULL) %>%
tab_pivot()
expss_digits(0) # turn off decimal digits
expss_output_viewer() # turn on displaying tables in the viewer
my_table
expss_output_default() # turn off displaying tables in the viewer
此代码给出以下结果：
如果您真的想在数据查看器中显示 table，您可以将 table 转换为通常的 data.frame。有一个特殊的命令 - split_table_to_df:
View(split_table_to_df(my_table))
结果：
更新:
df <- data.frame(Categoria = c("gender", "gender" , "gender", "gender", "gender", "gender",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion", "religion", "religion", "religion",
"religion", "religion"),
Opcoes_da_categoria = c("Mulher", "Homem", "Mulher", "Homem", "Mulher",
"Homem", "Outra religião", "Católico", "Agnóstico ou ateu",
"Evangélico", "Outra religião", "Católico",
"Agnóstico ou ateu", "Evangélico", "Outra religião",
"Católico", "Agnóstico ou ateu", "Evangélico"),
Resposta = c("A Favor", "A Favor", "Contra", "Contra", "Não sei", "Não sei",
"A Favor", "A Favor", "A Favor", "A Favor", "Contra", "Contra",
"Contra", "Contra", "Não sei", "Não sei", "Não sei", "Não sei"),
value_perc = c(65, 50, 33, 43, 2, 7, 67, 64, 56, 28, 31, 34, 35, 66, 2, 2, 10, 5))
library(expss)
my_table <- df %>%
apply_labels(
Resposta = "",
Opcoes_da_categoria = "",
Categoria = ""
) %>%
tab_cells(Resposta) %>%
tab_weight(value_perc) %>%
tab_cols(Categoria, Opcoes_da_categoria) %>%
tab_stat_cpct(total_row_position = "none") %>%
tab_pivot()
expss_digits(0) # turn off decimal digits
View(my_table)