よく使うR小技集(随時更新)

データラングリングや可視化、分析をするためにRを操作していると、以前書いたコードを忘れて、調べるたびに同じ頁に行き着くことがあります。一定回数以上「あれ、どうだったっけな?」と思って調べた小技について、随時掲載していきます。

データラングリング

フォルダ内の.csvファイルを読み込んで一気に結合する

csv_list <- fs::dir_ls(path = "../data/", 
                    glob = "*.csv", # .csvを検索
                    recurse = TRUE # サブディレクトリも検索したい場合はTRUE
                    )

dat <- map(csv_list, ~ readr::read_csv(.x)) |> bind_rows()Code language: PHP (php)

readr 2.0.0 の説明 https://t.co/4KEXiHSNsZ にあるように、list.files() ではなく fs::dir_ls() でもOK。この場合、str_c()でpathを付ける必要はない。
csv_list <- fs::dir_ls(path = "../data/",
glob = "*.csv",
recurse = TRUE
) https://t.co/jdn8fFAR29

— Shoei (@shoei05) July 22, 2021

漢数字をアラビア数字に変換する

pacman::p_load(zipangu)
dat$x <- dat$x %>% kansuji2arabic()Code language: PHP (php)

全角を半角にする

pacman::p_load(stringi)
dat$x <- dat$x %>% stri_trans_nfkc()Code language: PHP (php)

漢数字をアラビア数字に変換 → zipangu::kansuji2arabic() https://t.co/Dv0IMMqVdh 全角英数字を半角に変換 → stringi::stri_trans_nfkc() https://t.co/rn0kVzPBN5

— Shoei (@shoei05) September 26, 2020

数字を指定した桁数でパディングする(9 → 09)

dat %>% mutate(x_pad = str_pad(x, 2, pad=0))

{string} の str_pad() が一番覚えやすそう。例:str_pad(9, 2, pad=0) → "09" 「R で 9 を "09" みたいにパディングする」https://t.co/WoFSLh8564

— Shoei (@shoei05) November 17, 2020

数字列のNAを0に置換する

dat <- dat %>% 
  mutate_if(is.numeric, ~ replace_na(.x, 0))Code language: CSS (css)
dat <- dat %>%
  mutate(across(where(is.numeric), ~ replace_na(.x, 0))) Code language: CSS (css)

mutate(across())の場合は、across()の中に関数も入れることに注意。

mutate(across(where(is.numeric)), ~ replace_na(.x, 0))とすると、

Error: Problem with `mutate()` input `..2`. x Input `..2` must be a vector, not a `formula` object. ℹ Input `..2` is `~replace_na(.x, 0)`.Code language: JavaScript (javascript)

というエラーになる。

mutate_if(is.numeric, ~ replace_na(.x, 0)) と、mutate(across(where(is.numeric), ~ replace_na(.x, 0))) は同じ列操作。across()を使う場合は、across()の中に関数( ~ … )も入れることに注意。 https://t.co/CbrTiS5ijR

— Shoei (@shoei05) January 3, 2021

NA以外の行を選択

dat %>% filter(!(is.na(x)))Code language: CSS (css)

dplyr::if_else で 0 を NA に置換

dat %>% mutate(x = if_else(x == 0, NA_real_, x))

dplyr::if_else はデータ型 を揃える必要があることに注意。NAとすると、

`false` must be a logical vector, not a double vector.Code language: JavaScript (javascript)

といったエラーが返ってくる。double型の NA_real_ を使用する。

NAのある列をふくめたデータで文字結合(str_c())する

NAのある列を含めてstr_c()したい場合は、該当列(例ではY列)をstr_replace_na()で囲む。NAは”NA”のように生成されるため、その後、sep で指定した “:” とあわせて生成された”:NA”を文字置換する。

dat <- dat %>%
  mutate( Z = str_c(X,str_replace_na(Y),sep = ":")) %>% 
  mutate(across(Z, ~ gsub(":NA","",.x))) Code language: JavaScript (javascript)

NAのある列を含めてstr_c()したい場合は、該当列(例ではY列)をstr_replace_na()で囲む。その後、生成された":NA"を文字置換すればOK。例:dat <- dat %>% mutate( Z = str_c(X,str_replace_na(Y),sep = ":")) %>% mutate(across(Z, ~ gsub(":NA","",.x))) https://t.co/fmvi6j15mA pic.twitter.com/Xzt9037mfx

— Shoei (@shoei05) January 31, 2021

データ型の一括変換

factor_list <- c("x","y","z")
dat <- dat %>% mutate_at(vars(all_of(factor_list)),as.factor)Code language: JavaScript (javascript)

across()を使うと下記の通り

factor_list <- c("x","y","z")
dat <- dat %>% mutate(across(all_of(factor_list),as.factor))Code language: JavaScript (javascript)

もしくは明示的に ~ と .x で関数を定義する

dat <- dat %>% mutate(across(all_of(factor_list), ~ as.factor(.x)))Code language: CSS (css)

列名の一括変更

name_vector <- c("apple(変更前)"="1(変更後)", 
                 "banana"="2",
                 "orange"="3")

dat %>% 
  mutate(across(label, ~ str_replace_all(.x, name_vector)))Code language: JavaScript (javascript)

要素名の変更

pacman::p_load(forcats)
fct_list <- c("全くそう思う(変更後)" = "1(変更前)","少しそう思う" = "2",
              "あまりそう思わない" = "3", "全くそう思わない" = "4")
dat <- dat %>% mutate(x = fct_recode(x, !!!fct_list))Code language: PHP (php)

下記の方法でも要素名を変更することができるが、順番を変更する訳ではないので注意。上記の方法で明示的に数字と対応させたほうがミスは少ない。

levels(dat$x) <- c("全くそう思う","少しそう思う","あまりそう思わない","そう思わない")Code language: PHP (php)

"{forcats} 要素名を変更するためにベクトルを渡す場合は「!!!」を使用する"
x <- factor(c("apple", "bear", "banana", "dear"))
levels <- c(fruit = "apple", fruit = "banana")
fct_recode(x, !!!levels)https://t.co/aiW1P81SY8 pic.twitter.com/4PJqyBjSpr

— Shoei (@shoei05) December 27, 2020

要素名をまとめて再グループする

dat <- dat %>%  mutate(
  x2 = fct_recode(x,
    "fruits" = "apple",
    "fruits" = "banana",
    "fruits" = "orange",
    "vehicle" = "car",
    "vehicle" = "bike"))Code language: JavaScript (javascript)

要素名の順序の変更

fct_levels <- c("a","b","c")
dat$x <- dat$x %>% factor(levels = fct_levels) Code language: PHP (php)

mutate() でも across を使って以下のように書くことができる

dat <- dat %>% mutate(across(x, ~ factor(.x, levels = fct_levels)))Code language: HTML, XML (xml)

{forcats} の fct_relevel() を使うと以下の通り。ただし、こちらは存在しない値を指定すると警告が出る。

pacman::p_load(forcats)
fct_levels <- c("a","b","c")
dat <- dat %>% mutate(across(x, ~ fct_relevel(.x, levels = fct_levels)))Code language: PHP (php)

順序を反転するのであれば、 {forcats} のfct_rev() が有用。

pacman::p_load(forcats)
dat <- dat %>% mutate(across(x, ~ fct_rev(.x)))Code language: CSS (css)

dplyr::rename で 文字ベクトルを使って一括変更

列名を一括で変更したい場合は rename(!!! named_vector) が便利。もしくは dput() を活用する(後述)。

named_vector <- c("id" = "x",
                  "fruits" = "y")

dat <- dat %>% rename(!!! named_vector)Code language: JavaScript (javascript)

文字ベクトルを作ってから dplyr::rename を一括でしたい場合は、dat %>% rename(!!! named_vector) もしくは、dat %>% rename_mp(named_vector) を使う。https://t.co/iys69m6XT8 pic.twitter.com/2AB1AOL2hm

— Shoei (@shoei05) February 16, 2021

namelist は、 setNames() を使って
namelist <- dat2$post %>% setNames(dat2$pre)
としてもOK
もしくは、パターンベクトルを作成する方法もあり
参考:https://t.co/mHq6e0ZioJ

— Shoei (@shoei05) July 27, 2021

ベクトルで列名を取得

例えば列名を一括で変更したい場合は、

dat %>% names() %>% dput()

とすると、

c("ID", "果物", "個数")Code language: JavaScript (javascript)

といったような文字ベクトルが取得できるため、コピーして書き換える。

# c("ID", "果物", "個数") コピペした後に書き換えて setNames()を利用して一括で列名を変更

dat  <- dat %>% setNames(c("ID", "fruits", "n"))Code language: PHP (php)

列名の確認は今まで colnames(x) を使ってたけど、dput(names(x)) で c() で取得しておいた方が、その後 setNames() で列名変更するときなどにそのままコピペして使えるから便利 pic.twitter.com/xUywNUbda2

— Shoei (@shoei05) September 18, 2020

ベクトル内の特定の値(X)の個数を取得

sum(dat$x == X)Code language: PHP (php)

文字列を別に指定して関数に使用する

cat <- "x"
dat %>% filter(!is.na(.data[[cat]]))Code language: CSS (css)

is.na(cat)とするとエラーになる。このときは .data[[ 列名 ]] を使用する。

ggplot のaes()でも同様の手法を使うことができる(aes_string()を使う方法もある)。

dplyr::filter で列指定を文字列ではなく列番号で指定する

df %>% dplyr::filter(.[1] == 1)Code language: PHP (php)

ただし、後述の理由で、.[[列番号]] と [[ で閉じるほうが混乱が少なくて良いと思われる。

df %>% dplyr::filter(.[[1]] == 1)Code language: PHP (php)

filter_も使わず .[列番号]で指定可能(例:df %>% dplyr::filter(.[1] == 1) 、コメント欄参照)「filterで指定する列名を文字列でいちいち書かずに、列番号で指定」https://t.co/JvjIMvSNpD

— Shoei (@shoei05) January 30, 2021

dplyr::filter で 文字の部分一致 を使う( + 列番号で指定)

dat %>% filter(str_detect(.[[1]], "文字"))Code language: JavaScript (javascript)

もしくは

dat %>% filter(grep("文字", .[[1]]))Code language: JavaScript (javascript)

.[列番号] ではだめで .[[列番号]] とすると動作する。そのため、最初から [[ で使うほうがエラーが少ない。

filterで部分一致(grepl、str_detect)を使いたい場合は、.[列番号] では動作せず .[[列番号]] とすると大丈夫。前のツイートでも .[[列番号]] でも動作するため、最初から [[ で使うほうがエラーが少ない。例:dat %>% filter(str_detect(.[[1]], "郡$")) https://t.co/UkwZg0zkbM

— Shoei (@shoei05) January 31, 2021

数字と文字が結合した列を分離する

例「0100札幌市保健所」といったデータの場合

dat <- dat %>% 
  mutate(code = str_extract(code_area,"^(\\d)+")) %>%
  mutate(area = str_extract(code_area, "(\\D)+$"))Code language: JavaScript (javascript)
  • \\d :数字
  • \\D:数字以外
  • + 文字の連続
  • ^:文頭
  • $:文末

という正規表現。(参考:基本的な正規表現一覧 )

2つの Date型 の日付データから年齢を計算

pacman::p_load(lubridate)
dat <- dat %>% mutate_at(vars(d_birth, d_x), as.Date) 
dat <- dat %>% mutate( age = as.duration(d_x - d_birth)) 
dat <- dat %>% mutate( age = as.double(str_extract(age, "(?<=~).+(?=\s)"))) Code language: PHP (php)

(?<=~).+(?=\s) は「~とスペースの間の文字」という正規表現

  • ?<=~ : 直前に ~ がある
  • .+ :すべての文字の連続
  • ?=\s :直後に スペース(\s) がある

"検索ワードの前後にも条件をつけるときに使う。基本系が(?=regex)で、否定なら ! にして、直前なら < を追加する" https://t.co/KikmyRHxOd "数字にマッチする正規表現を書こうとして d とすると怒られる。 バックスラッシュそのものを表すには二重にしておく必要がある" https://t.co/LGfdNfHFH0 pic.twitter.com/qhnXyoR3NG

— Shoei (@shoei05) November 27, 2020

日付データから特定の期間のデータを抜き出す

日付の列(date)から2020年1月1日から2020年12月31日までのデータを抜き出したい場合

dat %>% 
  filter(date >= as.Date("2020-01-01") & date <= as.Date("2020-12-31"))Code language: JavaScript (javascript)

{lubridate} as.duration() で計算した値を日数単位に計算する

pacman::p_load(lubridate)
dat <- dat %>%
    mutate(day = as.duration(x_2 - x_1 + ddays(1))/dseconds(86400))Code language: PHP (php)

list 型のデータを data.frame に展開する

dat_list <- dat_list %>% reduce(rbind)Code language: HTML, XML (xml)

重複行の削除

dat %>% distinct(x, y, .keep_all = TRUE)Code language: PHP (php)

【メモ】”R言語dplyr::distinctで簡単に重複行を削除できる。キー項目以外の項目も簡単に抽出。” https://t.co/gKnQw2hbkm

— Shoei (@shoei05) March 22, 2020

重複行の確認

重複の数も知りたい場合は table()を使用する。

dat %>% 
    pull(col_name) %>% 
    table() %>% 
    data.frame() %>% 
    filter(Freq >= 2) %>% 
    arrange(desc(Freq))

列の中身を重複せずに取得したい場合は dat %>% pull(x) %>% unique() でもいいけど、重複数も知りたい場合は table()。例えば、2回以上重複している値を知りたい場合は dat %>% pull(adress) %>% table() %>% data.frame() %>% filter(Freq >= 2) https://t.co/5dhZND5M7M

— Shoei (@shoei05) March 15, 2021

特定の列の NA を置き換える

dat <- dat %>%
   replace_na(list(x = 0,
                   y = 0,
                   z = 0))Code language: HTML, XML (xml)

行列 の 上三角 を 下三角 にコピー

M <- dat
for(i in 1:nrow(M)) {for(j in 1:i) {M[j,i]=M[i,j]}}Code language: HTML, XML (xml)

例えば、{polycor} の hetcor() で順序相関係数(ポリコリック相関係数やポリシリアル相関係数)を求めたときは、算出された値が下三角のみのため、{corrplot} などで相関行列を作成したい場合は下記のように対応する。

pacman::p_load(polycor)
ans <- dat %>% hetcor()
M <- ans$tests
for(i in 1:nrow(M)) {for(j in 1:i) {M[j,i]=M[i,j] }}Code language: HTML, XML (xml)

「行列 (M) の上三角 uppertriangle を下三角 lowertriangle にコピー」for(i in 1:nrow(M)) {for(j in 1:i) {M[i,j]=M[j,i] }} 逆にしたい場合は、 M[j,i] = M[i,j] のように i と j を入れ替える https://t.co/cNuO3HrEPe

— Shoei (@shoei05) January 1, 2021

mutate() で複数列を選択して合計したい場合

rowSumsやreduceを活用する。

dat %>%
  mutate(sum = rowSums(across(c(●, ●))))

もしくは

dat %>%
  mutate(sum = reduce(across(c(●, ●)), `+`))Code language: JavaScript (javascript)

備忘録。とりあえず覚えておくなら、
① rowSums
dat %>%
mutate(sum = rowSums(across(c(●, ●))))

② reduce(もしくはbase::Reduce)
dat %>%
mutate(sum = reduce(across(c(●, ●)), `+`))

他にも色々あります。ツリーを参照してください(皆様改めてありがとうございました)。 https://t.co/NeaFfUFZmZ

— Shoei (@shoei05) March 21, 2022

wide データのまま、列毎に一括して計算したい場合

dat |> group_by(group) |> summarise(across(where(is.double), ~ first(.x) – last(.x)))

サブディレクトリ内のデータも取得する

複数のサブディレクトリ内のデータのパスも取得したい場合は、 list.files() の中に recursive=TRUE を入力する。

read_xlsx_list <- list.files(
  "../materials/folder",          # 検索するフォルダパスを指定
  "*.xlsx",                       # .xlsx ファイルを抽出
  recursive=TRUE) %>%             # サブフォルダ内も検索できるようになる
  str_c("../materials/folder/",.) # パスを結合しておけば後でread_excel()しやすいCode language: PHP (php)

複数のサブディレクトリ内のデータのパスも取得したい場合は、 list.files() の中に recursive=TRUE を入力する。 例: list.files("test/folder", "*.csv", recursive=T) で、testディレクトリにある複数のサブディレクトリ内の .csv もすべて取得できる。 参考: https://t.co/JyZzuTItz2

— Shoei (@shoei05) July 1, 2021

可視化

{ggplot2} theme_set() の活用

ファイルの最初で定義すれば以後のggplotで反映されます

theme_set(
  theme_classic() + 
    theme(
      strip.background = element_blank(),
      text = element_text(size = 10),
      axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1),
      axis.ticks.length.x = unit(0.1, "cm"),
      legend.position = 'none')
)Code language: JavaScript (javascript)

最近の ggplot の theme は、theme_set() を使って、このあたりで微調整(ファイルの最初で定義すれば以後のggplotで反映される)。 pic.twitter.com/PFMSra2hau

— Shoei (@shoei05) September 26, 2021

最近はtheme_set()も含めて以下をデフォルトで.mdファイルに設定しています

---
title: "yyyymmdd_xxxxx"
output: html_document
date: "2024-xx-xx"
author: "xxxxxx"
output: 
  html_document:
    theme: cerulean
    toc: yes
    toc_depth: 3
    toc_float: yes
    df_print: "kable"
  powerpoint_presentation:
    reference_doc: template.pptx
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
knitr::opts_chunk$set(eval = TRUE)
knitr::opts_chunk$set(tidy = FALSE)
knitr::opts_chunk$set(warning = FALSE)
knitr::opts_chunk$set(error = FALSE)
knitr::opts_chunk$set(message = FALSE)
knitr::opts_chunk$set(dpi = 300,  fig.width = 10, fig.height = 10*0.618)
```

```{r}
theme_set(
  theme_classic() + 
    theme(
      strip.background = element_blank(),
      text = element_text(size = 10, family = "HiraginoSans-W3"),
      axis.text.x = element_text(angle = 0, vjust = 1, hjust = 1),
      axis.ticks.length.x = unit(0.1, "cm"),
      legend.position = 'none')
)
```

```{r}
pacman::p_load(tidyverse)
```Code language: PHP (php)

{ggplot2} の aes() に 文字列でカラム名を渡す

dat %>% ggplot(aes_string(x=x, y=y))

aes() ではなく aes_string() を使用する。もしくは下記の方法でも良い。

dat %>% ggplot(aes(x=.data[["x"]], y=.data[["y"]]))Code language: JavaScript (javascript)

.data[[“x”]] を覚えておくと、関数作成の際にうまく引数を渡せないときに役に立つことがある。(is.na(), arrange(), pull() など)

もしくは aes(x=.data[["x"]], y=.data[["y"]]) でもOK → "文字列としてカラム名を渡してもエラーになる。通常は、 aes(x=x, y=y) であるところを、ggplot2::aes_string で wrap してあげることで、引数として与えたカラム名をよしなにやってくれる。" https://t.co/lRR7MD92hU pic.twitter.com/VSYfx6mVz4

— Shoei (@shoei05) January 5, 2021

{ggplot2} の x 軸のラベルを少しだけ傾ける

dat %>% ggplot(aes(x)) +
    geom_count() +
    theme(axis.text.x = element_text(angle=30, hjust=1))

{ggplot2} 凡例の位置調整:bottomに置いて右寄せ

g <- ggplot() + ...

g + theme(legend.position = "bottom",
          legend.justification = c("right"))Code language: HTML, XML (xml)

"(ggplot2の)凡例はどこにでも配置できます。legend.position オプションを使い、上、右、下、左のいずれかを指定します。(bottomに置いて、右寄せにしたい場合はtheme(legend.position = "bottom", legend.justification = c("right"))" https://t.co/IK9tus45Ml pic.twitter.com/lzLaH6QPsl

— Shoei (@shoei05) February 11, 2021

{ggforce}geom_sina で geom_jitter()の幅を密度分布で制御する

violin plot() も見やすいですが、geom_sina()を使うと、ドットのまま violin plot() のように図示できるため、視覚的に分かりやすい図を描くことができます。

pacman::p_load(ggforce)

dat %>% ggplot(aes(X,Y)) +
  geom_sina(aes(coular = Z))Code language: PHP (php)

個人的には、geom_jitter()よりもViolin plotのように膨らんでくれるggforce::geom_sina()の方が好み。「Sina plotは、jitter plotの拡張で、幅は各データの密度分布によって制御されます」 https://t.co/4PghYE0ZHV 「geom_sina()を使って箱ひげ図とドットを重ねて表示」 https://t.co/wJU6YyXRg1 pic.twitter.com/X3piiPdAZY

— Shoei (@shoei05) January 26, 2021

100%積み上げ棒グラフのラベル位置調整

ddat %>% 
  group_by(x,y) %>% 
  summarize(count=n()) %>% 
  arrange(x,desc(y)) %>% 
  ddply(x,transform,label_y=cumsum(count)) %>% 
  ggplot(aes(x = x, y = count, fill = y)) +
  geom_col()+
  geom_text ( aes ( y = label_y ,
                    label = count ), colour = "black", vjust = "inward") +
  scale_fill_brewer(palette = "Blues",
                    name="Y",
                    breaks=c("a", "b", "c"),
                    labels=c("A", "B", "C") ) +
  scale_x_continuous(breaks=c(1,2,3)) +
  xlab("X")+
  ylab("Count")+
  theme_minimal() Code language: JavaScript (javascript)

100%積み上げ棒グラフの場合は、この記事の記載方法に加えて、 geom_text() 内に vjust = "inward" を入れておくと、数字が枠外にでないので安心https://t.co/LR4eUYLQWO

— Shoei (@shoei05) September 29, 2020

「Colorbrewer」で配色の決定

図やグラフの色使いを考えるときに便利。【メモ】「Colorbrewer: Color Advice for Maps 」 https://t.co/gWM9gHkQf4 pic.twitter.com/OHk0S3lVlc

— Shoei (@shoei05) September 16, 2019

「Color Palette Cinema」で配色の決定

"Color Palette Cinema" という便利な検索語を発見。配色に困ったときに使ってみる(逆に多くて困るかも)。個人的には更に"Wes"を検索語に追加(Wes andersonのWes)。 https://t.co/5lrGJDSA8r pic.twitter.com/kNRgrfZPuL

— Shoei (@shoei05) December 6, 2020

配色バリアフリー(safe color)

palette("Okabe-Ito")Code language: JavaScript (javascript)

#RJpUsers "R-4.0.0以降では,palette("Okabe-Ito")とやると普通の色番号がsafe colorsになる"、とのこと。参考:①「A New palette() for R
」https://t.co/Ti2plswp55 ②"カラーユニバーサルデザイン(CUD)の推奨事項(岡部・伊藤、2002, https://t.co/DSDvIQJhkH ) " https://t.co/LPC5fe4ueS

— Shoei (@shoei05) December 19, 2020

分析

tidydata から Steel-Dwass の多重比較

ノンパラメトリックの多重比較法であるスティール・ドゥワス(Steel-Dwass)については、群馬大学 青木先生 の記事 が参考になりますが、tidydata からそのまま Steel-Dwass を行えるように関数を自作してみました。

pacman::p_load(tidyverse)

source("http://aoki2.si.gunma-u.ac.jp/R/src/Steel-Dwass.R", encoding="euc-jp")

steel_dwass <- function(df, data, group){
  data_vector <- df %>% pull(data)
  group_vector <- df %>% pull(group)
  result <- Steel.Dwass(data_vector, group_vector)
  result_tibble <- result %>% as_tibble()
  result_tibble <- cbind(steel_dwass = rownames(result),result_tibble)
  result_tibble <- result_tibble %>%
    mutate(star = if_else( p < 0.001, "**", if_else(p < 0.05, "*", "NS"))) %>%
    mutate(note = if_else(p < 0.001, "p<0.001", if_else(p < 0.05, "p<0.05", "NS"))) %>% 
    mutate(across(p, ~ round(.x, digits = 3))) 
  result_tibble
}Code language: PHP (php)

data列、group列の順に指定してください。

dat %>% steel_dwass("data", "group")Code language: JavaScript (javascript)

{rstan} 実行速度の高速化

rstan_options(auto_write = TRUE)
options(mc.cores = parallel::detectCores())Code language: PHP (php)

"「rstan_options(auto_write = TRUE)」と指定したうえでMCMCを実行すると、拡張子が「.rds」であるRDSファイルが作成されます。C++コードを…再度のコンパイルをしなくても済むようにRDSファイルを保存しておきます。2回目以降はコンパイルが不要なので、実行が早くなります" https://t.co/2zJnZabvI8

— Shoei (@shoei05) January 10, 2021

"「rstan_options(auto_write = TRUE)」と指定した上でMCMCを実行すると…2回目以降は(C++の)コンパイルが不要なので、実行速度が早くなります。「options(mc.cores = parallel::detectCores())」を指定すると、計算を並列化するので実行速度が上がります。" https://t.co/2zJnZabvI8

— Shoei (@shoei05) January 10, 2021

{gtsummary} 個人的雛形 (対応ある検定)

dat |> 
  tbl_summary(
    by = case_control, # 比較したいもの
    include = -ID, # 省きたいもの。でも対応ある検定で使いたい。
        type = list(all_continuous() ~ "continuous2",
                    c("count") ~ "continuous2"), # 列名を明示してもOK
    statistic = all_continuous() ~ c(
       "{mean} ({sd})",
       "{median} ({p25}, {p75})",
       "{min}, {max}"),
     digits = list(where(is.numeric) ~ c(1,1,1,1,1)) # 有効数字
  ) |> 
  add_p(
    # test = list(
    # all_continuous() ~ "t.test"), # t.testを行いたい場合はこちら
    group = ID, # 対応ある検定をする際はIDを明示
    test = list(
    all_continuous() ~ "wilcox.test",
    all_categorical() ~ "mcnemar.test"),
    pvalue_fun = function(x) style_pvalue(x, digits = 2)) |> # 有効数字
  bold_p() |> 
  bold_labels() |> 
  add_overall() Code language: PHP (php)

備忘録 pic.twitter.com/JdebV0atoW

— Shoei (@shoei05) December 10, 2023

{gtsummary} で連続値、カテゴリ値を一括で指定

pacman::p_load(gtsummary)

table_list <- c("x_1", "x_2", "y_1", "y_2", "z")
table_label_list <- c("X1", "X2", "Y1", "Y2", "Z")
cnt_list <- c("x_1", "x_2")
ctg_list <- c("y_1", "y_2")
dct_list <- c("z")

table_one <- dat %>% 
   select(all_of(table_list)) %>% 
   setNames(all_of(table_label_list)) %>% 
   tbl_summary(
       type = list(cnt_list ~ "continuous",
                   ctg_list ~ "categorical",
                   dct_list ~ "dichotomous"))Code language: PHP (php)

{gtsummary} 複数行で連続値 の summary を記載する

pacman::p_load(gtsummary)

table_one <- dat %>%
  select("x","y","z") %>%
   tbl_summary(
     type = all_continuous() ~ "continuous2",
     statistic = all_continuous() ~ c(
       "{N_nonmiss}",
       "{mean} ({sd})",
       "{median} ({p25}, {p75})",
       "{min}, {max}"),
     digits = list(where(is.numeric) ~ c(0,1,1,1,1,1,1,1)),
     missing = "no")Code language: PHP (php)

type を “continuous2” とすることに注意。有効数字は出現順に c() にまとめる。この場合は N を整数、その他を小数点以下1桁とした。

{gtsummary} で 複数行で連続値の summary を記載したい場合は、tbl_summary() 内に statistic = all_continuous() ~ c("{N_nonmiss}", "{median} ({p25}, {p75})", "{min}, {max}") というように「 , 」で区切って記載。 https://t.co/bgWKMDtNrp pic.twitter.com/SRbVAJLtbW

— Shoei (@shoei05) January 5, 2021

{gtsummary} 行列名や注釈を日本語表記にする

theme_gtsummary_language("ja")
Code language: JavaScript (javascript)

もとに戻したい場合は、下記のコードを実行する。

reset_gtsummary_theme()

{gtsummary} {snakecase} snake_case にしている変数名を camelCase に変更して表示する

pacman::p_load(gtsummary, snakecase)

table_one <- dat %>% 
  select("x","y","z") %>%
  set_variable_labels(
    .labels = to_title_case(names(.))) %>% 
  tbl_summary()Code language: PHP (php)

{gtsummary} で作成した列の順序を頻度順に並び替える

pacman::p_load(gtsummary)

table_one <- dat %>% 
  select("x","y","z") %>%
  tbl_summary(
     sort = all_categorical() ~ "frequency")Code language: PHP (php)

特定の列(AとB列)のみの場合は、

tbl_summary(sort = c("A","B") ~ "frequency")Code language: JavaScript (javascript)

とする。

{gtsummary} のtbl_summary() で、列の順序を頻度順に並び替えたい場合は、tbl_summary(sort = …)を設定。例:tbl_summary(by = trt, sort = all_categorical() ~ "frequency") 特定の列(AとB)のみの場合は sort = c("A","B") ~ "frequency" とする。https://t.co/9ixslB8VCd pic.twitter.com/NibVxkwF1H

— Shoei (@shoei05) May 3, 2021

{gtsummary} で作成した table を縦横変換する

pacman::p_load(gtsummary)
table_one <- dat %>%
    select("x","y","z") %>%
    tbl_summary() %>%
    bold_labels() %>%
    add_n() %>%
    as_tibble() %>%
    t() %>%
    as.data.frame()Code language: PHP (php)

"{gtsummary}ここで一つポイントなのは、このTableをなんとtibbleにすることができます。つまり、CSVファイルとして書き出すことができるほか、Rmarkdownと組み合わせることも可能です。" https://t.co/6mkBx74lJ1

— Shoei (@shoei05) September 14, 2020

{modelsummary} で star をつけたい場合

help に記載されている、estimate = “{estimate} ({std.error})stars” ではなく、”{estimate} ({std.error}){stars}” とすると表示されます

{modelsummary}で estimate をカスタマイズした上で stars を付けたい場合は、help に記載されている、estimate = "{estimate} ({std.error})stars" ではなく、"{estimate} ({std.error}){stars}" とすると表示される。 https://t.co/o46qp1hH8y pic.twitter.com/0qnNNxqHHY

— Shoei (@shoei05) February 2, 2021

{gtsummary} で2変数以上で by = したい

そんなときはtbl_strata()を使用します。

d |>
  tbl_strata(
    strata = group1, 
    ~.x %>% 
      tbl_summary(by = group2))

"tbl_strata()関数の中でtbl_summary()関数を使用し、strata引数を指定して層別表を作成することができます。
# minimalist example
d %>%
tbl_strata(
strata = grade,
~.x %>%
tbl_summary(by = trt))
"https://t.co/YU8a5XE8QC pic.twitter.com/WA1Z5tsCYA

— Shoei (@shoei05) May 26, 2023

{corrplot} 相関行列をカスタマイズ

pacman::p_load(corrplot)

col_list <- c("x","y","z")
labelname_list <- c("X","Y","Z")

dat_cor <- dat %>% 
   select(all_of(col_list)) %>% 
   setNames(all_of(labelname_list)) %>% 
   na.omit()

 p <- dat_cor %>% 
   cor.mtest(method = "spearman")

 corrplot(cor(dat_cor, method = "spearman"),
          method="number",
          tl.col="black",
          tl.cex=1,
          tl.srt=45,
          diag=FALSE)

 corrplot(cor(dat_cor, method = "spearman"),
          p.mat = p$p,
          sig.level=0,
          insig = "p-value",
          method="ellipse",
          type="lower",
          tl.pos = "n",
          cl.pos="n",
          add=TRUE,
          diag=FALSE)Code language: PHP (php)

{corrplot} で add=TRUE する場合は、2つの corrplot() を一気に選択して実行する必要がある。参考:①画像 https://t.co/N3xiHN4UZU ② p値は p <- cor.mtest() で求めて p.mat = p$p とすればOK https://t.co/uwI2BIQ5o0 pic.twitter.com/zCeLbRZ5sZ

— Shoei (@shoei05) January 1, 2021

{polycor} カテゴリカル変数とカテゴリカル変数で相関行列(ポリコリック相関行列)

pacman::p_load(polycor)
ans <- dat %>% hetcor()
ans$correlation
M <- ans$tests
for(i in 1:nrow(M)) {for(j in 1:i) {M[j,i]=M[i,j] }}
p$p <- MCode language: PHP (php)

のように行い、上記 {corrplot} を一部書き換える。

corrplot(ans$correlation,
         method="number",
         tl.col="black",
         tl.cex=1,
         tl.srt=45,
         diag=FALSE)

corrplot(ans$correlation,
         p.mat = p$p,
         sig.level=0,
         insig = "p-value",
         method="ellipse",
         type="lower",
         tl.pos = "n",
         cl.pos="n",
         add=TRUE,
         diag=FALSE)Code language: PHP (php)

"①連続変数と連続変数の相関係数が「ピアソンの相関係数」である、②<順序変数>と<順序変数>の相関係数が「ポリコリック相関係数」である、③<順序変数>と連続変数の相関係数が「ポリシリアル相関係数」である" https://t.co/4pvPr5nThB

— Shoei (@shoei05) January 1, 2021

{ggplot} 表示範囲設定にxlim , ylim を使ってはいけない理由

" xlim , ylim は範囲外の値をNA(欠損)にします。一方、coord_cartesianは範囲外の値に対し何の処理もしません(ズームインするだけ)。xlim, ylimでは、範囲外の値は存在しないことになります。そのため、original とは異なる回帰直線になってしまいます。" https://t.co/svqflhxgWs pic.twitter.com/TJ8HGeCtmv

— Shoei (@shoei05) July 5, 2021

範囲を指定したい場合は、 coord_cartesian(xlim = c(xmin,xmax)) を使用する。

g + coord_cartesian(xlim = c(0, 1000))

{ggstatsplot} で作成した図に {ggsignif} で有意差のバーを付ける

pacman::p_load(ggsignif, ggstatsplot, wesanderson)
ggstatsplot::ggbetweenstats(
   data = dat,
   x = x,
   y = y,
   pairwise.comparisons = FALSE,
   k = 0, 
   xlab = "x",
   ylab = "y",
   ggstatsplot.layer = TRUE, 
   package = "wesanderson",
   palette = "GrandBudapest1"
 ) +
   geom_signif(comparisons = list(c("a", "b")),
               map_signif_level = c("<strong>* p<0.001"=0.001, "</strong> p<0.01"=0.01, "* p<0.05"=0.05)) Code language: PHP (php)

"{ggstatsplot} は、情報量の多いプロット自体に含まれる統計的検定の詳細を含むグラフィックを作成するためのggplot2パッケージの拡張機能です。" #Rstats https://t.co/ZzcZck1YNn pic.twitter.com/6h1mlCBggp

— Shoei (@shoei05) November 26, 2020

{ggsignif} 今は map_signif_level = c("***"=0.001, "**"=0.01, "*"=0.05) で * がつくようになってますね。 https://t.co/SFEzIDYlQ7

— Shoei (@shoei05) December 1, 2020

コミュニケーション・その他

library() のかわりに pacman::p_loadを使う

if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, magrittr, package_n)Code language: PHP (php)
https://plaza.umin.ac.jp/shoei05/wp/index.php/2020/10/24/145

{tomwenseleers/export} {eoffice} 図表を ppt 形式で出力

pacman::p_load(officer,rvg,openxlsx,ggplot2,flextable,xtable,rgl,stargazer,tikzDevice,xml2,broom,devtools)
pacman::p_load_gh("tomwenseleers/export")
graph2ppt(append=TRUE, upscale=TRUE) Code language: PHP (php)

エラーが出る場合は、一度リンク先のインストール方法を試してから graph2ppt() を実行してみてください。

install.packages("officer")
install.packages("rvg")
install.packages("openxlsx")
install.packages("ggplot2")
install.packages("flextable")
install.packages("xtable")
install.packages("rgl")
install.packages("stargazer")
install.packages("tikzDevice")
install.packages("xml2")
install.packages("broom")
install.packages("devtools")
devtools::install_github("tomwenseleers/export")Code language: PHP (php)

{export}でうまく行かない場合は、{eoffice} を使います。

pacman::p_load(eoffice)
topptx(file="filename.pptx", left = 0, top = 0, width = 8, height = 6, append = TRUE)Code language: PHP (php)

Rで作成した図表をpptにエクスポートするときは、{export}で graph2ppt(append=TRUE,upscale=TRUE) などとすると、ちょうど良い具合にベクター形式で出力されるので便利。現在CRANに登録されているものだと{eoffice}にも似た機能がある様子(https://t.co/cYrY5G2JiZ ) https://t.co/Xc9nVCLSQR

— Shoei (@shoei05) September 6, 2020

ggsave() の画像データサイズを小さくする

ggsave("figure1.tiff", 
    width = ..., 
    height = ..., 
    dpi=300, 
    compression = "lzw")Code language: JavaScript (javascript)

Rで作った画像のデータサイズが大きくて困るときは、ggsave( … , compression = "lzw") で、数十〜百MBのデータを、数百Bに圧縮できる。論文投稿でサイズに引っかかったり、Gmailで添付するときにサイズが大きすぎてGoogleDrive経由で共有することになっていたファイルも、この圧縮で解決。 https://t.co/zlRpmmhoXK

— Shoei (@shoei05) May 3, 2021

ggsave() で保存した図の背景が透明になってしまう場合の対処法

ggsave(…, bg = “white“) と bg で背景色を指定できる。

ggsave("figure.png", g, bg = "white")Code language: JavaScript (javascript)


逆に背景を透明にしたい場合は bg = “transparent” と指定する

ggsave("figure.png", g, bg = "transparent")Code language: JavaScript (javascript)

プロジェクトファイルを立ち上げた後に必要なフォルダを作成する

Console の隣の Terminal から下記を入力

mkdir {data,thesis,analysis,function,materials}Code language: JavaScript (javascript)
https://plaza.umin.ac.jp/shoei05/wp/index.php/2020/10/25/165

Rmarkdown のデフォルトパスをプロジェクトファイルからの相対パスに変更する

knitr::opts_knit$set(root.dir = rprojroot::find_rstudio_root_file())Code language: PHP (php)

"デフォルトでは、Rチャンク(chunk)の作業ディレクトリは、.Rmdファイルのあるディレクトリになります。つまり、チャンク内で外部ファイルを参照する場合、これらのパスが.Rmdファイルのディレクトリに対する相対パスであることを知る必要があります。" https://t.co/hYYWofTnlt

— Shoei (@shoei05) November 1, 2020
https://plaza.umin.ac.jp/shoei05/wp/index.php/2020/11/02/239

Rmarkdown でよく行う初期設定

上記のデフォルトパスとあわせて私自身がよく行う初期設定例です。出力する図表は デフォルトで 300 dpi に設定しています。

---
title: "…"
output:
  html_document:
    theme: cerulean
    toc: yes
    toc_depth: 3
    toc_float: yes
    df_print: "kable"
---Code language: JavaScript (javascript)
{r setup, include=FALSE}
knitr::opts_knit$set(root.dir = rprojroot::find_rstudio_root_file())
knitr::opts_chunk$set(echo = FALSE)
knitr::opts_chunk$set(eval = TRUE)
knitr::opts_chunk$set(tidy = FALSE)
knitr::opts_chunk$set(warning = FALSE)
knitr::opts_chunk$set(error = FALSE)
knitr::opts_chunk$set(message = FALSE)
knitr::opts_chunk$set(dpi = 300)Code language: PHP (php)
{r}
if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse,readxl,readr,magrittr,...)Code language: PHP (php)

Rmarkdownで文中と文末の引用文献をハイパーリンクで関連付ける

デフォルトだと、本文中の参考文献は、1 といった上付き数字になり、文末のリスト番号と対応しているがハイパーリンクがない状態である。yaml ヘッダ に “link-citations: true” というオプションを指定して knit すればハイパーリンクで関連付けすることができる。

link-citations: trueCode language: JavaScript (javascript)

R Markdown で、文中と文末の引用文献をハイパーリンクで関連付けるには、yaml ヘッダ に "link-citations: true" というオプションを指定すればOK(pandoc v1.16以降)。 参考:https://t.co/wR0lrr5q65 pic.twitter.com/GJMeboIsI7

— Shoei (@shoei05) February 1, 2021

入力途中の日本語も見えるようにする

Rstudio エディタの日本語入力に関して、入力途中の文字を表示するために編集したいエディタを2つ目以降に開くという解決方法がありますが、ポップアウトすると表示されなくなっていました。これについてポップアウト後も表示する方法を見つけたので記事にしました。 https://t.co/Pafi9AOGHm pic.twitter.com/TArUDiK0Jq

— Shoei (@shoei05) January 3, 2021
目次に戻る
この記事は旧サイト(UMIN)から移行したものです。内容は記載の公開・更新時点のものです。