216 Rmarkdownでレポートを作成してみる―課題2

library(tidyverse)

── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
✔ dplyr     1.1.2     ✔ readr     2.1.4
✔ forcats   1.0.0     ✔ stringr   1.5.0
✔ ggplot2   3.4.2     ✔ tibble    3.2.1
✔ lubridate 1.9.2     ✔ tidyr     1.3.0
✔ purrr     1.0.1     
── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
✖ dplyr::filter() masks stats::filter()
✖ dplyr::lag()    masks stats::lag()
ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors

library(gtsummary)

Warning: package 'gtsummary' was built under R version 4.3.2

make_hyou <- function(.data){
  .data %>% 
    tbl_summary(
      data = .,
      by="yr",
      include = c("bmi","sbp","dbp"),
      label = list(bmi ~ "BMI", 
                   sbp ~ "収縮期血圧",
                   dbp ~ "拡張期血圧") 
    ) %>% 
    modify_header(list(label~"**検査値**")) %>%  
    # 検査値を足しています
    
    modify_spanning_header( #この関数で「年度」を足しています
      list(
        stat_1 ~ "**年度**",
        stat_2 ~ "**年度**",
        stat_3 ~ "**年度**"
      )
    ) %>% 
    
    modify_footnote( # この関数でフットノートを日本語にしています
      list(
        stat_1 ~ "中央値(IQR)",
        stat_2 ~ "中央値(IQR)",
        stat_3 ~ "中央値(IQR)"
      )
    )
}

dat <- read_csv("kadai/data/data.csv")

Rows: 2460 Columns: 6
── Column specification ────────────────────────────────────────────────────────
Delimiter: ","
dbl (6): wpid, id, yr, bmi, sbp, dbp

ℹ Use `spec()` to retrieve the full column specification for this data.
ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.

tbl2 <- tbl_summary(
  data = dat,
  by="yr",
  include = c("bmi","sbp","dbp"),
  label = list(bmi ~ "BMI", 
               sbp ~ "収縮期血圧",
               dbp ~ "拡張期血圧") 
) %>% 
  modify_header(list(label~"**検査値**")) %>%  
  　　　# 検査値を足しています
  
  modify_spanning_header( #この関数で「年度」を足しています
    list(
      stat_1 ~ "**年度**",
      stat_2 ~ "**年度**",
      stat_3 ~ "**年度**"
    )
  ) %>% 
  
  modify_footnote( # この関数でフットノートを日本語にしています
    list(
      stat_1 ~ "中央値(IQR)",
      stat_2 ~ "中央値(IQR)",
      stat_3 ~ "中央値(IQR)"
    )
  )

課題2： 　　 次に、職場別に集計して上司にプレゼンした結果、ここの職場の担当者にも結果を送ってほしいと上司からいわれました。会社は伝統的にデータのやりとりはエクセルファイルで行われています。 　　 課題１の集計結果を、それなりに見栄えのする表を作って各職場の担当者に送信するためのエクセルファイルを職場の数だけ作成してみてください。 　　 この課題、xlsxに、gtsummary::tbl_summaryの結果を入れることができれば解決します。tbl_summaryの結果を取り出して、表に入れられるように加工します。

tbody <- tbl2$table_body
tby   <- tbl2$df_by

tbodyは、

tbody2 <- tbody %>% 
  select(label, starts_with("stat_"))

tbody2

# A tibble: 3 × 4
  label      stat_1               stat_2               stat_3              
  <chr>      <chr>                <chr>                <chr>               
1 BMI        22.34 (21.33, 23.52) 22.35 (21.29, 23.51) 22.42 (21.28, 23.40)
2 収縮期血圧 92 (82, 140)         92 (82, 140)         92 (82, 140)        
3 拡張期血圧 34 (24, 82)          34 (24, 82)          33 (24, 82)         

を、そのまま入れてあげるとよさそうです。

後は、列名を何とかしてあげたいですが結果で、人数行を作りつつ名前を置き換えるとすると、

ninzu <- tby$n %>% as.character()
nendo <- tby$by_chr

writeall <- tbody2 %>% 
  add_row(tibble(label = "人数",
                 stat_1 = ninzu[1],
                 stat_2 = ninzu[2],
                 stat_3 = ninzu[3]), .before = 1) %>% 
  setNames(c(" ", nendo))

こんな処理をすることで、表ができあがりました。

ここで、これまで紹介していない関数としてadd_rowがあります。これは、tibbleに対して、好きな内容の行を追加するという関数で、位置も指定可能です。

あと、setNamesで名前を変換してあげると出来上がりです。

繰り返しですが、この課題、「Rでこんなこともできる」ということを例示するためのものなので、この回答が思いつかなくてもこのコースを１度みただけの方であれば問題ないと思います。気楽に見てください。

wpid1-5も関数を利用して作成しておきます

make_table_for_excel <- function(gttbl){
  tbody <- gttbl$table_body
  tby   <- gttbl$df_by
  
  tbody2 <- tbody %>% 
    select(label, starts_with("stat_"))
  
  ninzu <- tby$n %>% as.character()
  nendo <- tby$by_chr
  
  res <- tbody2 %>% 
    add_row(tibble(label = "人数",
                   stat_1 = ninzu[1],
                   stat_2 = ninzu[2],
                   stat_3 = ninzu[3]), .before = 1) %>% 
    setNames(c(" ", nendo))
  
  return(res)
}

tblall <- dat %>% make_hyou() %>% make_table_for_excel()
tblp1 <- dat %>% filter(wpid==1) %>% make_hyou() %>% make_table_for_excel()
tblp2 <- dat %>% filter(wpid==2) %>% make_hyou() %>% make_table_for_excel()
tblp3 <- dat %>% filter(wpid==3) %>% make_hyou() %>% make_table_for_excel()
tblp4 <- dat %>% filter(wpid==4) %>% make_hyou() %>% make_table_for_excel()
tblp5 <- dat %>% filter(wpid==5) %>% make_hyou() %>% make_table_for_excel()

この結果を、次にxlsxファイルに書き込んでみましょう。

ここではopenxlsxを利用します。

wpid1へのエクセルファイル

style <- openxlsx::createStyle(
  border = c("top", "bottom", "left", "right")
)

wb <- openxlsx::createWorkbook()
openxlsx::addWorksheet(wb,"wpid1")
openxlsx::writeData(wb,sheet="wpid1",x="全体" ,startCol=1,startRow=1)
openxlsx::writeData(wb,sheet="wpid1",x=tblall ,startCol=2,startRow=2)
openxlsx::writeData(wb,sheet="wpid1",x="WPID1",startCol=1,startRow=7)
openxlsx::writeData(wb,sheet="wpid1",x=tblp1  ,startCol=2,startRow=8)
openxlsx::addStyle(wb,"wpid1",rows=c(2:6),cols=c(2:5), style=style, gridExpand = TRUE)
openxlsx::addStyle(wb,"wpid1",rows=c(8:12),cols=c(2:5), style=style, gridExpand = TRUE)
openxlsx::setColWidths(wb,"wpid1",cols=c(2:5),widths="auto")
openxlsx::saveWorkbook(wb,"kadai/forwpid1.xlsx",overwrite = TRUE)

うまくいきましたね？

あとはこれを関数化しましょう。

make_excel_file <- function(excel_data, wpid=1){
  style <- openxlsx::createStyle(
    border = c("top", "bottom", "left", "right")
  )
  
  wptext <- str_c("wpid",wpid)
  
  wb <- openxlsx::createWorkbook()
  openxlsx::addWorksheet(wb,wptext)
  openxlsx::writeData(wb,sheet=wptext,x="全体" ,startCol=1,startRow=1)
  openxlsx::writeData(wb,sheet=wptext,x=tblall ,startCol=2,startRow=2)
  openxlsx::writeData(wb,sheet=wptext,x=wptext,startCol=1,startRow=7)
  openxlsx::writeData(wb,sheet=wptext,x=tblp1  ,startCol=2,startRow=8)
  openxlsx::addStyle(wb,wptext,rows=c(2:6),cols=c(2:5), style=style, gridExpand = TRUE)
  openxlsx::addStyle(wb,wptext,rows=c(8:12),cols=c(2:5), style=style, gridExpand = TRUE)
  openxlsx::setColWidths(wb,wptext,cols=c(2:5),widths="auto")
  openxlsx::saveWorkbook(wb, str_glue("kadai/for{wptext}.xlsx"),overwrite = TRUE)
}

この関数を利用して、エクセルファイルを事業場毎（wpid毎）に、作成します。

dat %>% filter(wpid==1) %>% make_hyou() %>% make_table_for_excel() %>% make_excel_file(wpid=1)
dat %>% filter(wpid==2) %>% make_hyou() %>% make_table_for_excel() %>% make_excel_file(wpid=2)
dat %>% filter(wpid==3) %>% make_hyou() %>% make_table_for_excel() %>% make_excel_file(wpid=3)
dat %>% filter(wpid==4) %>% make_hyou() %>% make_table_for_excel() %>% make_excel_file(wpid=4)
dat %>% filter(wpid==5) %>% make_hyou() %>% make_table_for_excel() %>% make_excel_file(wpid=5)

できましたね？今回、作成するファイルは５こですが、これが２０個とか１００個とかになると、R（プログラム）を介してファイル作成するメリットが感じられるようになるはずです。