[R] Rで綺麗なクロス集計表を作る

Rでクロス集計表を作るときに，細かい装飾の指定ができなくてイライラしたことはありませんか？

knitr::kable()のような綺麗な見た目の表のまま表頭・表側のラベル部分をうまく作る方法がなかなか見当たらなかったり，実数・比率の併記（「547 (61.2%)」みたいな書き方）の方法がわからなかったり…

サッと確認するだけならtable()やxtabs()でいいのですが，あれはセルの概念がなくてしっかりとレポートに載せるには不向きです。

そこで，{kableExtra}を使って無理やりクロス集計表の見た目をいじる方法を思いついたのでご紹介します。

コード

Titanicデータを使います

library(epitools) # Titanicデータの変換用
library(knitr)
library(kableExtra)
library(dplyr)
library(tidyr)
library(stringr)

# データの用意 -------------------------------------------------------------------------------------
## Titanicデータを分割表形式からデータフレーム形式に変換
Titanic_df = expand.table(Titanic)

表側ラベル・表頭ラベルつきのクロス表（実数のみ）

# 表側ラベル・表頭ラベルつきのクロス表（実数のみ） -------------------------------------------------
## データフレーム（tibble）型としてクロス集計表を作成
table_df = Titanic_df %>% 
  group_by(Survived, Age) %>% 
  count() %>% 
  spread(Survived, n) 

## 0がNA扱いになるので，NAを0で埋める
table_df[is.na(table_df)] = 0

## 表側ラベル部分作成のための処理
table_df['label'] = 'Age'
table_df = table_df %>% select(label, colnames(table_df[-ncol(table_df)])) %>% rename(` `=Age, ` `=label)

## {kableExtra}の表としてクロス集計表を作成（出力はHTMLやLaTeXのみ，RstudioならViewerから画像として保存可能）
kable(table_df, align = "c") %>%
  kable_styling(full_width = F) %>%
  column_spec(1, bold = T) %>%
  collapse_rows(columns = 1, valign = "middle") %>% # セルの縦方向結合を指定
  add_header_above(c(" " = 2, "Survived" = ncol(table_df)-2)) # セルの横方向結合・表頭ラベルを指定

表側ラベル・表頭ラベルつきのクロス表（実数・比率の併記）

# 表側ラベル・表頭ラベルつきのクロス表（実数・比率の併記） ---------------------------------------
## データフレーム（tibble）型としてクロス集計表を作成
### 実数のデータフレーム
table_df_n = Titanic_df %>% 
  group_by(Survived, Age) %>% 
  count() %>% 
  spread(Survived, n) 
### 比率のデータフレーム
table_df_p = Titanic_df %>% 
  group_by(Survived, Age) %>% 
  count() %>% mutate(p = paste0(round(n/nrow(Titanic_df),3)*100,'%')) %>% select(-n) %>%
  spread(Survived, p) 

## 実数・比率のデータフレーム達を結合
### 実数と比率の文字列ベクトルを連結させ，「〇〇(〇〇%)」の形にする
table_df = data.frame(table_df_n[1], # 1列目（表側）
                      str_c(table_df_n[[2]], " (",table_df_p[[2]], ")"), # 2列目
                      str_c(table_df_n[[3]], " (",table_df_p[[3]], ")")) # 3列目
colnames(table_df) = colnames(table_df_n)

## 0がNA扱いになるので，NAを0で埋める
table_df[is.na(table_df)] = 0

## 表側ラベル部分作成のための処理
table_df['label'] = 'Age'
table_df = table_df %>% select(label, colnames(table_df[-ncol(table_df)])) %>% rename(` `=Age, ` `=label)

## {kableExtra}の表としてクロス集計表を作成（出力はHTMLやLaTeXのみ，RstudioならViewerから画像として保存可能）
kable(table_df, align = "c") %>%
  kable_styling(full_width = F) %>%
  column_spec(1, bold = T) %>%
  collapse_rows(columns = 1, valign = "middle") %>% # セルの縦方向結合を指定
  add_header_above(c(" " = 2, "Survived" = ncol(table_df)-2)) # セルの横方向結合・表頭ラベルを指定

留意点

通常のKnitrはMarkdownで出力することも可能ですが，{kableExtra}はHTMLかLaTexしか出力できません（一般的なMarkdownはセルの結合が自由にできないため？）

RStudioのViewerにはプレビューが表示されるので，ここからExportすることで一応画像での出力も可能です。

追記：関数化と「合計」の行・列

「合計」の列や行をつけたバージョンを作ってみました。ついでに自作関数の形にしてみました。

データによっては動かないかもしれませんが，ご自由に改変してお使いください。

crosstable <- function(data, xname, yname, format = "html", xlabel = xname, ylabel = yname, caption = NULL){
  library(stringr)
  library(tidyr)
  library(knitr)
  library(kableExtra)
  
  # 0. もし入力されたデータが数値型なら文字列型にしてから扱う
  if(is.numeric(data[[xname]])) data[[xname]] <- as.character(data[[xname]])
  if(is.numeric(data[[yname]])) data[[yname]] <- as.character(data[[yname]])
  
  # 1. クロス集計表をdataframeとして作る
  ## 度数のクロス集計表
  table_df_n <- data %>% group_by_(xname, yname) %>% count() %>% spread_(xname, "n")
  ## 比率（セル比率）のクロス集計表
  table_df_p <- data %>% group_by_(xname, yname) %>% count() %>%
    mutate(p = round(n/nrow(data),3)*100) %>%
    select(-n) %>% spread_(xname, "p")
  
  ## NAを0で埋める
  table_df_n[is.na(table_df_n)] <- 0
  table_df_p[is.na(table_df_p)] <- 0
  
  ## 比率のクロス集計表に"%"記号をつける
  for(i in 1:nrow(table_df_p)){
    table_df_p[i,-1] <- paste0(table_df_p[i,-1],'%')
  }
  
  ## 実数と比率の文字列ベクトルを連結させ，「〇〇(〇〇%)」の形にする
  table_df = table_df_n
  for(i in 1:ncol(table_df_n)) {
    if(i == 1) table_df[i] = table_df_n[i]
    if(i != 1) table_df[i] = str_c(table_df_n[[i]], " (",table_df_p[[i]], ")")
  }
  
  ## 「合計」列を追加する
  sum_col_n <- apply(table_df_n[-1], 1, sum)
  sum_col_p <- paste0(round(sum_col_n / sum(sum_col_n),3)*100,'%')
  table_df['合計'] = str_c(sum_col_n, " (",sum_col_p, ")")
  
  ## 「合計」行を追加する
  sum_row_n <- apply(table_df_n[-1], 2, sum)
  sum_row_p <- paste0(round(sum_row_n / sum(sum_row_n),3)*100,'%')
  sum_row <- str_c(sum_row_n, " (",sum_row_p, ")")
  sum_col_sum <- str_c(sum(sum_col_n), " (100%)")
  sum_row <- data.frame(' ', matrix(as.character(sum_row), nrow = 1), sum_col_sum, stringsAsFactors = F)
  names(sum_row) <- colnames(table_df)
  table_df <- bind_rows(table_df, sum_row) # 最下行に追加
  
  # 2. kableExtraでの出力に備えて情報を付与
  ## y軸ラベルの作成
  table_df['label'] <- ylabel
  table_df[nrow(table_df),'label'] <- '合計'
  table_df <- table_df %>% select(label, colnames(table_df[-ncol(table_df)])) %>% rename_(` ` = yname, ` ` = "label")
  
  ## add_header_above()の引数である"header"のためのベクトルを作成
  header_vec <- c(" " = 2, ncol(table_df)-3, " ")
  names(header_vec)[2] <- xlabel
  
  ## kableとkableExtraで表を作る
  k <- kable(table_df, format = format, align = "c", caption = caption) %>%
    kable_styling(full_width = F) %>%
    column_spec(c(1,2), bold = T) %>%
    collapse_rows(columns = 1, valign = "middle") %>% # セルの縦方向結合
    add_header_above(header = header_vec) # セルの横方向結合
  return(k)
}

実行例

crosstable(data = Titanic_df, xname = "Survived", yname = "Class")

参考

• Create Awesome HTML Table with knitr::kable and kableExtra
  • {kableExtra}はkable()の表現力を高めてくれるのでなかなか面白いパッケージです。おすすめです。

よく考えるとRで苦労してクロス集計表を作るよりpythonのpandasとか使ったほうが早い気もします