精神科後期研修のおすすめ書籍アンケート で収集したデータについて、csvファイルの読み込み・データクリーニング・図示までをRで解析しました。この文章は R Notebookで作成しています。コードは右上の CODEからダウンロードすることができます。
このコード自体は複雑な操作も含まれています。どのような操作をしているか、なるべく読みやすいように補足をつけながらコード記載しています。初めてRのコードを見る方も「このような操作をしているのか」と興味を持っていただけたら嬉しいです。
まずRを勉強するには、2021年5月に改訂2版が出たこちらがおすすめです。 松村優哉, 湯谷啓明, 紀ノ定保礼, 前田和寛. 改訂2版 RユーザのためのRStudio[実践]入門〜tidyverseによるモダンな分析フローの世界. 技術評論社; 2021. https://www.amazon.co.jp/dp/B095W5G8KB
今回のアンケートはこちらから確認できます。年齢を選ぶ択一式質問、おすすめ書籍の複数選択式質問、その他おすすめ書類を選ぶ自由記載形式質問の3つについて分析していきます。
Rを始めるときは、その都度使用する道具(パッケージ)を選択する必要があります。今回は以下のパッケージを利用します。デフォルトでは install.pakeges()
や library()
というコードがありますが、 pacman::p_load()
を覚えておくと便利です。install.pakeges()
や library()
を羅列することなく、pacman::p_load()
の一行でスマートに記載することができます。
pacman
についてはこちらの記事をご参照ください。
コードの中に #
で記載するとコメントとして認識されます。コードの実行に影響することなく、コメントを残すことができます。
if (!require("pacman")) install.packages("pacman")
pacman::p_load(
tidyverse, #Rでデータ処理・解析をするための便利なパッケージ群
gt, #見栄えの良い表を作るためのパッケージ
gtsummary, #gtの拡張で、基礎統計などの集計を簡単に行うパッケージ
rvest #ウェブスクレイピングを可能にするパッケージ
)
read_csv()
で .csv ファイルを読み込みます。読みこんだ .csv ファイルを <- で dat と名前をつけます。今回分析に使用した.csvファイルははこちらからダウンロードしてください。
dat <- read_csv("../materials/list_210606.csv") # csvファイルの読み込み
─ Column specification ────────────────────────────
cols(
Timestamp = col_character(),
年齢をお選びください = col_character(),
`オススメ書籍はどれですか?(複数回答可)` = col_character(),
他のオススメ本 = col_character()
)
dat
と入力することで、読み込んだ csv ファイルを表示することができます。
dat # datを表示
列名だけを見たい場合は、 names()
を使います。 パイプ演算子 %>%
を使って dat
に続けて入力すると、その指定の処理を続けて行うことができます。 RStudioではShift + Ctrl(⌘) + M
で入力することができます。
dat %>% names() # 列名の表示
[1] "Timestamp"
[2] "年齢をお選びください"
[3] "オススメ書籍はどれですか?(複数回答可)"
[4] "他のオススメ本"
rename() を使って扱いやすい列名に変更しておきます。dat %>% rename()
の一連の処理の結果を dat <-
として、 dat
に結果を反映します。dat <-
の部分をdat1 <-
など別の名前にした場合は、dat1
にその結果が反映されます。
dat <- dat %>% # 以下の操作を datに渡す
rename(age = "年齢をお選びください",
book = "オススメ書籍はどれですか?(複数回答可)",
comment = "他のオススメ本") # 列名の変更
必要の無い列を select()
で選択して外します。外したい列名を -
で選択します。行の番号を rownames_to_column()
で追加します。これを dat1
とします。comment列
はあとの集計にとっておき、これからの操作に不要なので外しておきます。
dat1 <- dat %>% #以下の操作をdat1に渡す
select(-Timestamp, -comment) %>% # Timestamp, comment 列を除外
rownames_to_column() # 行番号を追加
dat1 #dat1を表示
最初に比べて必要な列が抽出でき、すっきりとしました。
gtsummary
パッケージをつかって、このデータの特徴をみていきます。select()
で age列を選択後に gtsummary
の一つの機能である tbl_summary()
(どのパッケージのコマンドであるかを明示した書き方で、 gtsummary::tbl_summary()
と表記する方法もあります) で集計してみます。
dat1 %>%
select(age) %>% # age列 を選択
tbl_summary() # 集計
Characteristic | N = 311 |
---|---|
age | |
20代 | 2 (6.5%) |
30代 | 21 (68%) |
40代 | 8 (26%) |
1
n (%)
|
全体で31人の回答者がいて、約3分の2が30代であることがわかりました。それぞれ一人あたりどのくらいの本を選んだのか計算してみます。book列に注目して、本を選んだ数を計算していきます。
dat1 %>% select(book) # book列を選択
それぞれの書籍名の間を セミコロン ;
で区切っていることがわかります。一つも選択していない場合(フリーコメントだけ書いている場合)はbook列は欠損値 NA
です。つまりは、 ;
の個数がわかれば、それに1を足せば選択した書籍数として計算ができそうです。str_count()
を使うと目的の処理が達成できます。mutate()
で 集計した count列を作成します。if_else()
で条件式を作ります。もし count 列が NAだったら、0 に書き換え、NAでなければ現在の数に1を足すように算出します。
age_count <- dat1 %>% #以下の操作の結果をage_countに渡す
mutate(count = str_count(book,";")) %>% # ;の数を数える
mutate(count = if_else(is.na(count), # もし count 列が NAだったら
0, # 0 にcountを書き換える
count+1)) %>% # NAでなければ現在の数に1を足す
select(age,count) # age, count 列について抽出
age_count #age_countを表示
これで一人当たり、複数選択肢の質問にどれだけ選択しているかがわかりました。これを gtsummary::tbl_summary
で表にします。tbl_summary()
の中で by = age
と指定することで、 age列のグループごとに集計するように設定できます。
age_count <- age_count %>% # 以下の操作の結果をage_countに渡す
tbl_summary(by = age) %>% # age列のグループごとに集計
as_gt() # gt オブジェクトにする(表の保存のため)
age_count # age_countを表示
Characteristic | 20代, N = 21 | 30代, N = 211 | 40代, N = 81 |
---|---|---|---|
count | 14 (14, 14) | 14 (7, 19) | 14 (10, 23) |
1
Median (IQR)
|
gtsave(data = age_count, "age_count.html") # age_countの表をhtmlで保存する(推奨)
gtsave(data = age_count, "age_count.png") # age_countの表を png で保存する
先程もお示ししたように、book列は複数選択したものが セミコロン(;)でつながっています。
dat1 %>% select(book) # book列を選択
これを、 separate()
で ; を区切りに別の列に展開していきます。今回、選択肢が 117あるため、最大120選択しても大丈夫なように空のリストを準備します。str_c()
で文字を結合することができます。例えば str_c("a", "b")
の結果は "ab"
です。今回、1:120
という1から120の連続する数字のベクトルを用意し、パイプ演算子 %>%
でstr_c("f", .)
渡すことで、f1 から f120という120個の文字を作ることができます。 このように %>%
以前の結果を .
の位置に代入することができます。
col_list <- 1:120 %>% # col_listの作成、1から120の連続する数字の文字ベクトルを用意
str_c("f", .) # f1 から f120という120個の文字ベクトルを作成する。
col_list # col_listの表示
[1] "f1" "f2" "f3" "f4" "f5" "f6" "f7" "f8" "f9" "f10"
[11] "f11" "f12" "f13" "f14" "f15" "f16" "f17" "f18" "f19" "f20"
[21] "f21" "f22" "f23" "f24" "f25" "f26" "f27" "f28" "f29" "f30"
[31] "f31" "f32" "f33" "f34" "f35" "f36" "f37" "f38" "f39" "f40"
[41] "f41" "f42" "f43" "f44" "f45" "f46" "f47" "f48" "f49" "f50"
[51] "f51" "f52" "f53" "f54" "f55" "f56" "f57" "f58" "f59" "f60"
[61] "f61" "f62" "f63" "f64" "f65" "f66" "f67" "f68" "f69" "f70"
[71] "f71" "f72" "f73" "f74" "f75" "f76" "f77" "f78" "f79" "f80"
[81] "f81" "f82" "f83" "f84" "f85" "f86" "f87" "f88" "f89" "f90"
[91] "f91" "f92" "f93" "f94" "f95" "f96" "f97" "f98" "f99" "f100"
[101] "f101" "f102" "f103" "f104" "f105" "f106" "f107" "f108" "f109" "f110"
[111] "f111" "f112" "f113" "f114" "f115" "f116" "f117" "f118" "f119" "f120"
separate()
をつかって、特定の文字列でつながった文字を分けていくことができます。bookという列に対して、col_list (f1からf120) の120個の列を用意して、; で区切られた文字を分割していきます。
dat1 <- dat1 %>% # 以下の結果を dat1 に渡す
separate(book, # bookという列を
into = col_list, # col_list (f1からf120) の120個の列を用意して
sep =";", # ; で区切られた文字を分割していく
extra ="merge") # ; 120個以上の結果が出た場合は、最後の列に処理しきれなかった文字を残す
Expected 120 pieces. Missing pieces filled with `NA` in 29 rows [1, 2, 3, 4, 5, 6, 7, 8, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, ...].
dat1 # dat1 の表示
前回までの作業で横長の列ができました。これを、データで扱いやすいように、pivot_longer()
で、縦長のデータセットに変形します。f1からf120の列に対して、もともとの列名を “f” という列の中に格納し、セルの値を “book” という列の中に格納していきます。
dat1 <- dat1 %>% # 以下の結果を da1 に渡す
pivot_longer( # 縦長のデータセットに変形する
f1:f120, # f1からf120の列に対して
names_to = "f", # もともとの列名を "f" という列の中に格納する
values_to = "book") %>% # セルの値を "book" という列の中に格納する
filter(!is.na(book)) # book 列の値が欠損値 NA であった場合、その行を取り除く
dat1 # dat1 の表示
縦長のデータができました。このような縦長のデータのほうがデータ分析の観点からはまとまった扱いやすく、この形式を 整然データ(tidy data) と呼びます。
データを集計していきます。group_by()
を使って、本の種類毎に集計していきます。group_by(book)
とすることで、book列について集計すると宣言し、summarise(count = n())
でbook列の要素の個数を count列に挿入していきます。
その後に、arrange()を使って、1. count の大きい順、2. bookの文字数が多い順、に並べて、行番号を rowname_to_column() で挿入し、mutate()で整数にデータ型を指定します。 - この行番号は、図の作成のときに使用します。
dat2 <- dat1 %>% # 以下の計算データをdat2に渡す
group_by(book) %>% # book列について集計する(グループ化)
summarise(count = n(), # book列の要素の個数を count列に挿入する
.groups="drop") # グループ化 の解除
dat2 # dat2 の表示
後の図示の際に扱いやすいように、データを並び替えます。countの多い順に並べ、countが同じ場合、bookの文字数の多い順に並べていきます。並べた順に行番号を振り直し、行番号の列を整数値(integr型)に変更します。mutate() の中のacross()
で操作する列名を指定し、~ 以降の .x にその指定した列を代入します。
dat2 <- dat2 %>% # 以下の結果をdat2に渡す
arrange(desc(count), # countの多い順に並べる
desc(str_length(book))) %>% #countが同じ場合、bookの文字数の多い順に並べる
rownames_to_column() %>% # 並べた順に行番号を振り直す
mutate( #列操作
across(rowname, # rowname の列について
~ as.integer(.x)) # rowname(.x)を整数値にする
)
dat2 # dat2の表示
この表自体もとても有用なのですが、このデータを図示してみたいと思います。ただ、図示する際に文字数が長すぎると支障がでます。文字数は nchar()
でカウントすることができます。
dat2 %>% # dat2について以下の操作を実行
pull(book) %>% # book列をベクトルとして抽出
nchar() # 文字数の計算
[1] 5 23 17 25 35 31 27 19 17 14 30 19 12 15 10 32 29 27
[19] 8 35 21 17 15 32 26 23 21 19 16 39 30 26 18 17 17 16
[37] 13 13 11 31 30 25 23 21 21 20 18 15 15 15 12 8 37 35
[55] 32 28 26 25 23 23 22 19 17 17 14 14 10 10 10 9 7 108
[73] 41 27 21 17 16 15 10 8 58 51 49 48 39 29 23 23 21 20
[91] 19 18 18 18 13 10 5
108文字は可視化の際に支障が出そうです。今回、可視化して全体を把握することが目標なので、本が認識できる最初の20文字のみ抽出します。 str_sub()
で指定したの文字を抽出することができます。
titlename <- dat2 %>% # 以下の結果を titlenameに渡す
pull(book) %>% # book列をベクトルとして抽出
str_sub(start = 1, end = 20) # 最初の文字から20文字まで抽出
titlename # titlenameの表示
[1] "精神症候学"
[2] "モーズレイ処方ガイドライン 第13版 日"
[3] "精神科における予診・初診・初期治療"
[4] "脳波判読step by step 入門編"
[5] "カプラン臨床精神医学テキスト DSM-5"
[6] "ストール精神薬理学エセンシャルズ 神経科"
[7] "西丸四方、西丸甫夫『精神医学入門』(改訂"
[8] "DSM-5 精神疾患の分類と診断の手引"
[9] "精神診療プラチナマニュアル 第2版"
[10] "看護のための精神医学 第2版"
[11] "原田憲一『精神症状の把握と理解(精神医学"
[12] "改訂版予診・初診・初期治療笠原診療新社"
[13] "精神病理学臨床講義第2版"
[14] "統合失調症薬物治療ガイドライン"
[15] "精神科の薬がわかる本"
[16] "精神科診療に必要な書式マニュアル 第四版"
[17] "四訂精神保健福祉法詳解(精神保健福祉研究"
[18] "クラウス・コンラート『分裂病のはじまり』"
[19] "現代臨床精神医学"
[20] "宮岡等、内山登紀夫『大人の発達障害ってそ"
[21] "DSM-5 精神疾患の診断・統計マニュア"
[22] "認知症疾患診療ガイドライン2017"
[23] "うつ病治療ガイドライン 第2版"
[24] "古茶大樹『臨床精神病理学 精神医学におけ"
[25] "脳波判読step by step 症例編"
[26] "カール・ヤスパース『精神病理学原論』みす"
[27] "精神療法の基本: 支持から認知行動療法ま"
[28] "改訂版精神療法の第一歩成田善弘診療新社"
[29] "失踪日記2アル中病棟/吾妻ひでお"
[30] "内村祐之『精神医学の基本問題 精神病と神"
[31] "クルト・シュナイダー『臨床精神病理学』("
[32] "摂食障害―食べない、食べられない、食べた"
[33] "こころの治療薬ハンドブック 第13版"
[34] "今日の治療薬2021: 解説と便覧"
[35] "精神科身体合併症マニュアル 第2版"
[36] "てんかん診療ガイドライン2018"
[37] "こころの病を診るということ"
[38] "精神科レジデントマニュアル"
[39] "症例でわかる精神病理学"
[40] "認知行動療法トレーニングブック[DVD/"
[41] "山下格『誤診のおこるとき 精神科診断の宿"
[42] "脳波判読オープンキャンパス 誰でも学べる"
[43] "尾久守侑『精神症状から身体疾患を見抜く』"
[44] "大うつ病性障害・双極性障害治療ガイドライ"
[45] "中井久夫『最終講義 分裂病私見』みすず書"
[46] "医学論文のための統計手法の選び方・使い方"
[47] "精神科リハビリテーションワークブック"
[48] "誤りやすい異常脳波. 第3版."
[49] "今日の精神疾患治療指針 第2版"
[50] "精神・心理機能評価ハンドブック"
[51] "改訂版意識障害を診わける"
[52] "ポケット臨床脳波"
[53] "Beckの娘のジュディスの認知行動療法実"
[54] "中安信夫『精神科臨床を始める人のために "
[55] "不安とうつの統一プロトコル―診断を越えた"
[56] "西丸四方、西丸甫夫『やさしい精神医学』("
[57] "クルト・シュナイダー『臨床精神病理学序説"
[58] "エルンスト・クレッチマー『医学的心理学』"
[59] "中井久夫『精神科治療の覚書』(新版)日本"
[60] "濱田秀伯『精神医学エッセンス』(第2版)"
[61] "成人期の自閉症スペクトラム診療実践マニュ"
[62] "カプラン精神科薬物ハンドブック 第5版"
[63] "ICD-10精神科診断ガイドブック"
[64] "科学的認知症診療 5Lessons"
[65] "精神科臨床144のQ & A"
[66] "精神症状から身体疾患を見抜く"
[67] "失踪日記/吾妻ひでお"
[68] "人間仮免中/卯月妙子"
[69] "精神科診断面接のコツ"
[70] "支持的精神療法入門"
[71] "精神病 笠原嘉"
[72] "精神科臨床ニューアプローチ (1 症候か"
[73] "ケースでわかる! 精神科治療ガイドライン"
[74] "中安信夫『体験を聴く・症候を読む・病態を"
[75] "原田誠一『精神療法の工夫と楽しみ』金剛出"
[76] "尾久守侑『器質か心因か』中外医学社"
[77] "メモリークリニック診療マニュアル"
[78] "軽症うつ病笠原嘉開談社現代新書"
[79] "縮刷版 精神医学事典"
[80] "TEXT精神医学"
[81] "ホスピタリストのための内科診療フローチャ"
[82] "近藤伸介監訳『神経精神医学ケースブック "
[83] "広沢正孝『成人の高機能広汎性発達障害とア"
[84] "心の健康問題により休業した労働者の職場復"
[85] "八木剛平、田辺英『精神病治療の開発思想史"
[86] "安永浩『精神科医のものの考え方 私の臨床"
[87] "新版精神保健福祉法講義第3版(大谷實、成"
[88] "村松太郎『統合失調症当事者の症状論』中外"
[89] "精神医学ハンドブック医学・保健・福析の基"
[90] "急性中毒診療レジデントマニュアル 第2版"
[91] "精神・心理症状学ハンドブック[第2版]"
[92] "DSM-5診断面接ポケットマニュアル"
[93] "新版 精神療法家の仕事―面接と面接者"
[94] "精神科臨床Q&A for ビギナーズ"
[95] "援助者必携はじめての精神科"
[96] "もったいない患者対応"
[97] "ガダラの豚"
これをdat2 に結合していきます。cbind()
を使います。
dat2 <- cbind(dat2, titlename) # dat2 に titlename のベクトルを列として結合
dat2 # dat2 の表示
これから図示をしていきます。ggplot()
できれいなオブジェクトを作成することができます。今回は、棒グラフを作成していきます。aes()
で x軸を、book列、 y軸を count列で指定します。x軸の順番を reorder()
の X で先程作成した rowname の降順 desc()
として指定します。
g1 <- dat2 %>% # 以下の操作を g1 に渡す
ggplot() + # ggplot() の宣言
aes(x = reorder(x = titlename, # x 軸に titlenameを選択
X = desc(rowname)), # titlenameをrownameの降順で表示
y = count, # y軸は count を選択
fill = count) + # 色塗りを count に合わせて行う
geom_col() # 棒グラフの作成
g1 # g1 を表示
x軸の文字が潰れて見えなくなっています。x軸の傾きを調整することもできますが、今回は coord_flip()
を使って、縦と横を変形します。 先程作成したオブジェクト g1 に + で続きを入力することで、図の設定を書き足していくことができます。
g2 <- g1 + # 以下の操作を g2に渡す
coord_flip() # x軸とy軸を入れ替える
g2 # g2の表示
x軸とy軸の位置を scale_x_discrete()
, scale_y_continuous()
で調整します。 scale_fill_continuous()
を使って、任意の色でグラデーションを付けてみます。labs()
を使って x軸とy軸を非表示にします。scale_fill_continuous()
で色塗りをグラデーションで指定します。
g3 <- g2 + # 以下の操作をg3に渡す
scale_x_discrete(position = "top") + #x軸の位置調整
scale_y_continuous(position = "right") + #y軸の位置調整
scale_fill_continuous( # 色塗りをグラデーションで指定
low = "#DD8A90", # 小さい値を#DD8A90
high = "#BD4670") + # 大きい値を#DD8A90
labs(x = "", y = "") + #x軸とy軸の表示をなくす
theme_minimal() + # すっきりしたテーマに変更
theme(legend.position = "none") # 凡例の削除
g3 # g3の表示
これまでの dat2 以降の一連の流れを関数にしてみます。function()
で関数を軸することができます。データの集計を、make_aggregate()
、グラフの作成を、make_graph()
とします。
make_aggregate <- # make_aggregateという関数を作成
function(df) { # df という引数を指定する
df <- df %>% # dfに対して以下の操作を行う
group_by(book) %>% # book列について集計する(グループ化)
summarise(count = n(),# book列の要素の個数を count列に挿入する
.groups="drop") %>% # グループ化 の解除
arrange(desc(count), # countの多い順に並べる
desc(str_length(book))) %>% #countが同じ場合、bookの文字数の多い順に並べる
rownames_to_column() %>% # 並べた順に行番号を振り直す
mutate( #列操作
across(rowname, # rowname の列について
~ as.integer(.x)) # rowname(.x)を整数値にする
)
titlename <-df %>% # 以下の結果を titlenameに渡す
pull(book) %>% # book列をベクトルとして抽出
str_sub(start = 1, end = 20) # 最初の文字から20文字まで抽出
df <- cbind(df, titlename) # df に titlename のベクトルを列として結合
return(df) # 最終的にできたdfを make_aggregateに渡す
}
make_graph <- # make_graph という関数を作成
function(df) { # df という引数を指定する
df %>%
ggplot() + # ggplot() の宣言
aes(x = reorder( x = titlename, # x 軸に titlenameを選択
X = desc(rowname)), # titlenameをrownameの降順で表示
y = count, # y軸は count を選択
fill = count) + # 色塗りを count に合わせて行う
geom_col() + # 棒グラフの作成
coord_flip() + # x軸とy軸を入れ替える
scale_x_discrete(position = "top") + #x軸の位置調整
scale_y_continuous(position = "right") + #y軸の位置調整
scale_fill_continuous( # 色塗りをグラデーションで指定
low = "#DD8A90", # 小さい値を#DD8A90
high = "#BD4670") + # 大きい値を#DD8A90
labs(x = "", y = "") + #x軸とy軸の表示をなくす
theme_minimal() + # すっきりしたテーマに変更
theme(legend.position = "none") # 凡例の削除
}
こうして、作成した関数にデータを渡すだけで同様の作業が繰り返すことができます。今回はデータが多いため、5票以上と、1票以上5票未満に分けて図示してみます。
g4 <- dat1 %>% # 以下の操作の結果をg4に渡す
make_aggregate() %>% # dat1 に対して 関数 make_aggregate()を行う
filter(count >= 5) %>% # データのcountが5以上を抽出
make_graph() + # 関数 make_graph() を行う
ylim(0,17) #スケールの幅を合わせるために0-17の範囲で固定する
Scale for 'y' is already present. Adding another scale for 'y', which will
replace the existing scale.
g4 # g4 の表示
g5 <- dat1 %>% # 以下の操作の結果をg4に渡す
make_aggregate() %>% # dat1 に対して 関数 make_aggregate()を行う
filter(count < 5) %>% # データのcountが5未満を抽出
make_graph() + # 関数 make_graph() を行う
ylim(0,17) #スケールの幅を合わせるために0-17の範囲で固定する
Scale for 'y' is already present. Adding another scale for 'y', which will
replace the existing scale.
g5 # g5 の表示
先程作った集計表でもいいのですが、せっかくなので、そのままクリックしたら書籍ページに飛べるような table を作成してみます。集計まで終わった dat2 のデータを使用していきます。
dat2
dat_table <- dat2 %>% #以下の結果をdat_tableに渡す
select(titlename, count, book) # titlename, count, book列の抽出
link <- dat_table %>% # 以下の結果をlinkに渡す
pull(book) # book列をベクトルとして取り出す
link <- str_c( # 文字の結合
"https://www.google.com/search?q=", #結合する文字1
link # 結合する文字2 (book列のベクトル link)
) # 結合する文字3
dat_table <- cbind(dat_table, link) # dat_tableにlink列を挿入
dat_table %>% select(link) # link列を選択して表示
これで必要なURLを作成することができました。今回は、Google検索に飛ぶように設定しました。これを反映するためには html の table にする必要があります。book列に上記のlinkを組み込むように設定します。map()
や map2()
を使うことで、一括した列操作が可能です。
html_table <- dat_table %>% # 以下の操作をhtml_tableに渡す
mutate( # 列操作
book = map2( # 以下2つの引数に対して ~ 以下の処理を実行する
book, link, # book列、link列に対して
~ .x %>% htmltools::a( # book(.x) に以下の a属性を与える
href = .y, # .y のリンク情報を与える
target = "_blank")), # リンクには新規タブを開いてジャンプする
book = map( # 以下1つの引数に対して ~ 以下の処理を実行する
book, # book列に対して
~ gt::html(as.character(.x)))) # htmlの情報を反映させる
html_table %>% # 以下の操作を実行
select(book, count) %>% # book列, count列を選択
rename("書籍名"=book) %>% # 列名の変更
gt() %>% # gt オブジェクトとして表示
cols_align(align = "left") # 左寄せにする
この表でも十分ですが、また、せっかくなので table の中に棒グラフも入れてみます。下記の記事を参考にします。
Mock T. The Mockup Blog: 10+ Guidelines for Better Tables in R. Published online September 4, 2020. Accessed June 9, 2021. https://themockup.blog/posts/2020-09-04-10-table-rules-in-r/
ここに書いてある 10. Barplot にある、bar_chart()
の関数を使用します。
# 関数 bar_chartの作成
bar_chart <- function(value, color = "red", display_value = NULL){
# Choose to display percent of total
if (is.null(display_value)) {
display_value <- " "
} else {
display_value <- display_value
}
# paste color and value into the html string
glue::glue("<span style=\"display: inline-block; direction: ltr; border-radius: 4px; padding-right: 2px; background-color: {color}; color: {color}; width: {value}%\"> {display_value} </span>")
}
先程作成した、html_table に棒グラフを加えていきます。今回もmap
を使用していきます。完成したものを gtsave()
でhtmlとpdfに保存します。
html_table_2 <- html_table %>% # 以下の操作をhtml_table_2に渡す
mutate( # 列操作
rank = count/max(count) * 100, # 棒グラフのために%でrankを作成
rank = map( # 以下1つの引数に対して ~ 以下の処理を実行する
rank, # rank列に対して
~ bar_chart(value = .x, # bar_chart関数を実行
color = "#BD4670")), # 棒グラフの色は #BD4670 へ
rank = map( # その後、もう一度 map を実行
rank, # rank列に対して
~ gt::html(as.character(.x)))) %>% # htmlの情報を反映させる
select(book, count, rank) %>% # book, count, rank 列を選択
rename( # 名前の変更
"書籍名" = book, # book を「書籍名」に変更
" " = count, # count を スペースへ
" " = rank) %>% # rank もスペースへ
gt() %>%# gt オブジェクトへ
cols_align(align = "left") # 左寄せ
html_table_2
gtsave(data = html_table_2, "html_table_2.html") # htmlで保存(推奨)
gtsave(data = html_table_2, "html_table_2.pdf") # pdfで保存
今度は、今回集計した age 列を活用してみます。group_by()
に bookとageの2つを入力することで、ageとbookについて集計する事ができます。
dat3 <- dat1 %>% # 以下の操作をdat3に渡す
group_by(book, age) %>% # bookとageについてグループ化
summarise(count = n(), # book, ageについて個数を count列に挿入する
.groups="drop") # グループ化 の解除
dat3
並び順を先程作成した dat2 と一緒にします。right_join()
を使って、データを突合(merge)することができます。先程作成したdat2の並び順 (rowname) をdat3に突合します。
dat3 <- dat2 %>% #以下の操作をdat3に渡す
select(rowname, book) %>% # dat2 のrowname, book 列を抽出
right_join(., dat3) # 抽出したものを dat3 と突合
Joining, by = "book"
dat3 # dat3 の表示
先程と同様にして、見やすさのために、本の文字数を20文字にします。
titlename <- dat3 %>% # titlenameの作成
pull(book) %>% # book列のベクトルを取り出す
str_sub(start = 1, end = 20) # 最初の20文字を抽出
dat3 <- cbind(dat3, titlename) # dat3 にtitlenameを追加
先程完成した棒グラフ make_graph() を使ってみます。
h1 <- dat3 %>% # 以下の操作をh1に渡す
make_graph() # make_graph関数の実行
h1 # h1の表示
このままだと、book列が併せて集計されたままになるので、facet_wrap()
を使って、年代ごとに分けて表示します。
h2 <- # 以下の操作をh2に渡す
h1 + facet_wrap(age ~ .) # h1 を年代ごとに分ける
h2 # h2の表示
ここまでで作成した図をggsave()
を使って、論文投稿でよく使う形式である .tiffとして保存します。dpi = 300
とすることで、dpiを設定できます。compression = "lzw"
を入れることで、サイズを大幅に圧縮して保存することも可能です。
ggsave(plot = g3, # オブジェクトの指定
filename = "figure1.tiff", # ファイル名
width = 10, # 幅 10 inch
height = 15, # 縦 15 inch
dpi =300, # dpi 300
compression = "lzw") # 圧縮の選択
ggsave(plot = g4, filename = "figure1_sub1.tiff", width = 10, height = 15, dpi =300, compression = "lzw")
ggsave(plot = g5, filename = "figure1_sub2.tiff", width = 10, height = 15, dpi =300, compression = "lzw")
ggsave(plot = h2, filename = "figure2.tiff", width = 10, height = 15, dpi =300, compression = "lzw")
pdfで保存することもできます。
ggsave(plot = g3, filename = "figure1.pdf", device = cairo_pdf, width = 10, height = 15, dpi =300)
ggsave(plot = h2, "figure2.pdf", device = cairo_pdf, width = 10, height = 15, dpi =300)
コメント欄をarrange()で文字数の多い順に並べたあと、select()で抜き出して表示します。
t1 <- dat %>% # 以下の操作を t1 に渡す
arrange(desc(str_length(comment))) %>% # 文字数の多い順に並べる
select(comment) %>% # comment列の選択
na.omit() # 欠損値のある行を削除
t1 # t1の表示
自由記載の場合は、ある程度形式を整える必要があるときがあります。str_replace()
を使って、文字を置換していきます。
t1 <- t1 %>% # 以下の操作をt1に渡す
pull(comment) %>% # comment列についてベクトルを抜き出す
str_replace( # 文字の置換
pattern=" https://.*", # http://以下 を
replacement="") %>% # 削除
tibble() %>% # ベクトルを表(tibble)形式へ
rename("他のおすすめ本" = ".") # 列名の設定
t1 # t1 の表示
たとえば、2行目の「精神力動学的精神医学(グレン.O.ギャバード)、神経症状の診かた、考え方(福武敏夫)」は、2つの書籍情報が入っています。分割するのに、いろいろな方法があります。最初に使った separate()
で「、」で分割したのちに縦長データへする方法もありますが、今回は少し力技で行きます。t1[-2,]
で2行目を取り除いたものに、rbind()
で “精神力動学的精神医学(グレン.O.ギャバード)”と、“神経症状の診かた、考え方(福武敏夫)”を、それぞれ行に追加していきます。
t1 <- rbind( # 行結合
t1[-2,], # t1から2行目を取り除く
"精神力動学的精神医学(グレン.O.ギャバード)", #行の追加
"神経症状の診かた、考え方(福武敏夫)") # 行の追加
t1 # t1の表示
同様にして今、2行目にきている行も操作します。
t1 <- rbind( # 行結合
t1[-2,], # t1から2行目を取り除く
"「発想の航跡」神田橋條治", #行の追加
"「精神療法面接のコツ」神田橋條治") #行の追加
t1 # t1の表示
先ほどと同様の手法でタイトルをクリックするとGoogle検索できるようにリンクを貼っていきます。繰り返す操作は関数をつくってしまいましょう。今回は add_link
という関数名にします。
# 関数の作成
add_link <- # add_linkという関数を設定
function(book_name){ # 引数はbook_nameという書籍名のベクトル
link_info <- # link情報のベクトルを作成
str_c("https://www.google.com/search?q=",book_name) # 文字結合
book_name <- cbind(book_name, link_info) %>% # 列の結合
data.frame() %>% # 表形式にする
setNames(c("book_name","link_info")) %>% # 列名の設定
mutate( # 列操作
book_name = map2( # 以下2つの引数に対して ~ 以下の処理を実行する
book_name, link_info, # book_name, link_info 列について
~ .x %>% htmltools::a( # book_name(.x) に以下の a属性を与える
href = .y, # link_info(.y) のリンク情報を与える
target = "_blank")), # リンクには新規タブを開いてジャンプする
book_name = map( # 以下1つの引数に対して ~ 以下の処理を実行する
book_name, # book_name列に対して
~ gt::html(as.character(.x)))) %>% # htmlの情報を反映させる
select(-link_info) %>% # link_info列を取り除く
rename("書籍リスト" = book_name) %>% # 列名の変更
gt() %>% # gtオブジェクトへ
cols_align(align = "left") # 左寄せ
return(book_name) # できたbook_nameを結果として返す
}
t2 <- t1 %>% #以下の結果をt2に返す
pull(他のおすすめ本) %>% # 他のおすすめ本のベクトルを抽出
add_link() # 自作したadd_link関数を使用
t2 # t2の表示
# html, pdf で保存
gtsave(data = t2, "recommed.html")
gtsave(data = t2, "recommed.pdf")
今回のWeb調査から、書籍情報を取得してみようと思います。これは R の rvest
パッケージを使用します。
source_url <- "https://docs.google.com/forms/d/e/1FAIpQLSeWZdSS3a0lGJ-5A4bRd40sPwxs-HycLA4v0WSBBOAumQpQmg/viewform" # URLの指定
recall_html <- read_html(source_url, encoding = "UTF-8") # 指定したURLを UTF-8で読み込む
recall_html # 読み込んだhtml情報の表示
{html_document}
<html lang="ja" class="m2">
[1] <head>\n<meta http-equiv="Content-Type" content="text/html; charset=UTF- ...
[2] <body dir="ltr" itemscope itemtype="http://schema.org/CreativeWork/FormO ...
htmlドキュメントを読み込むことができました。このあとは、Chrome拡張のSelectorGadgetを使うと捗ります。SelectorGadgetを使って取り込みたい要素をクリックすると、“.freebirdFormviewerComponentsQuestionCheckboxHasImage , .freebirdFormviewerComponentsQuestionBaseHeader” と表示されるので、これをコピーします。簡単にいうと htmlドキュメント内の住所のようなものです。html_node() にいれることで、その要素の情報を取得することができます。
booklist <- recall_html %>% # 以下の操作をbooklistへ
html_nodes(".freebirdFormviewerComponentsQuestionCheckboxHasImage , .freebirdFormviewerComponentsQuestionBaseHeader") %>% # SelectorGadget で取得した情報を代入
html_text() # テキストデータのみ抜き出す
booklist # booklistの表示
[1] "年齢をお選びください"
[2] "オススメ書籍はどれですか?(複数回答可)"
[3] "誤りやすい異常脳波. 第3版."
[4] "医療福祉総合ガイドブック 2020年度版"
[5] "うつ病治療ガイドライン 第2版"
[6] "カプラン精神科薬物ハンドブック 第5版"
[7] "カプラン臨床精神医学テキスト DSM-5診断基準の臨床への展開 第3版"
[8] "看護のための精神医学 第2版"
[9] "急性中毒診療レジデントマニュアル 第2版"
[10] "心の健康問題により休業した労働者の職場復帰支援の手引き~メンタルヘルス対策における職場復帰支援~"
[11] "こころの病を診るということ"
[12] "支持的精神療法入門"
[13] "症例でわかる精神病理学"
[14] "ストール精神薬理学エセンシャルズ 神経科学的基礎と応用 第4版"
[15] "精神科身体合併症マニュアル 第2版"
[16] "精神科診療に必要な書式マニュアル 第四版 2017年 12 月号"
[17] "精神科における予診・初診・初期治療"
[18] "精神科の薬がわかる本"
[19] "精神科臨床Q&A for ビギナーズ"
[20] "精神症候学"
[21] "精神症状から身体疾患を見抜く"
[22] "精神診療プラチナマニュアル 第2版"
[23] "大うつ病性障害・双極性障害治療ガイドライン"
[24] "治療的柔構造―心理療法の諸理論と実践との架け橋"
[25] "てんかん診療ガイドライン2018"
[26] "統合失調症薬物治療ガイドライン"
[27] "認知症疾患診療ガイドライン2017"
[28] "脳波判読step by step 入門編. 第4版"
[29] "脳波判読step by step 症例編. 第4版."
[30] "不明熱・不明炎症レジデントマニュアル"
[31] "ホスピタリストのための内科診療フローチャート 第2版―専門的対応が求められる疾患の診療の流れとエビデンス―. 第2版"
[32] "もったいない患者対応"
[33] "モーズレイ処方ガイドライン 第13版 日本語版"
[34] "臨床家のための実践的治療構造論"
[35] "DSM-5診断面接ポケットマニュアル"
[36] "DSM-5 精神疾患の診断・統計マニュアル"
[37] "DSM-5 精神疾患の分類と診断の手引"
[38] "DSM-5を使いこなすための臨床精神医学テキスト"
[39] "ICD-10精神科診断ガイドブック"
[40] "精神病者の魂への道-ゲルトルート・シュヴィン"
[41] "精神病理学臨床講義第2版"
[42] "こころの治療薬ハンドブック 第13版"
[43] "現代臨床精神医学"
[44] "縮刷版 精神医学事典"
[45] "精神療法の基本: 支持から認知行動療法まで"
[46] "ケアする人も楽になる 認知行動療法入門"
[47] "認知行動療法トレーニングブック[DVD/Web動画付] 第2版"
[48] "Beckの娘のジュディスの認知行動療法実践ガイド:基礎から応用まで 第2版"
[49] "四訂精神保健福祉法詳解(精神保健福祉研究会監修、中央法規)"
[50] "新版精神保健福祉法講義第3版(大谷實、成文堂)"
[51] "不安とうつの統一プロトコル―診断を越えた認知行動療法ワークブック"
[52] "科学的認知症診療 5Lessons"
[53] "知られていない認知症の治し方(森 悦朗)"
[54] "最新臨床睡眠学(第2版)"
[55] "失踪日記/吾妻ひでお"
[56] "失踪日記2アル中病棟/吾妻ひでお"
[57] "人間仮免中/卯月妙子"
[58] "ガダラの豚"
[59] "西丸四方、西丸甫夫『やさしい精神医学』(改訂5版)南山堂"
[60] "西丸四方、西丸甫夫『精神医学入門』(改訂25版)南山堂"
[61] "山下格『誤診のおこるとき 精神科診断の宿命と使命』みすず書房"
[62] "古茶大樹『臨床精神病理学 精神医学における疾患と診断』日本評論社"
[63] "中安信夫『精神科臨床を始める人のために 精神科臨床診断の方法』星和書店"
[64] "中安信夫『体験を聴く・症候を読む・病態を解く』星和書店"
[65] "クラウス・コンラート『分裂病のはじまり』岩崎学術出版社"
[66] "中井久夫『精神科治療の覚書』(新版)日本評論社"
[67] "中井久夫『最終講義 分裂病私見』みすず書房"
[68] "クルト・シュナイダー『臨床精神病理学序説』みすず書房"
[69] "鹿島晴雄他『妄想の臨床』新興医学出版社"
[70] "広沢正孝『成人の高機能広汎性発達障害とアスペルガー症候群 社会に生きる彼らの精神行動特性』医学書院"
[71] "宮岡等、内山登紀夫『大人の発達障害ってそういうことだったのか』医学書院"
[72] "濱田秀伯『精神医学エッセンス』(第2版)弘文堂"
[73] "原田憲一『精神症状の把握と理解(精神医学の知と技)』中山書店"
[74] "原田誠一『精神療法の工夫と楽しみ』金剛出版"
[75] "近藤伸介監訳『神経精神医学ケースブック 脳とからだの精神科』メディカル・サイエンス・インターナショナル"
[76] "尾久守侑『精神症状から身体疾患を見抜く』金芳堂"
[77] "尾久守侑『器質か心因か』中外医学社"
[78] "村松太郎『統合失調症当事者の症状論』中外医学社"
[79] "竹中星郎『老いの心と臨床』みすず書房"
[80] "八木剛平、田辺英『精神病治療の開発思想史 ネオヒポクラティズムの系譜』星和書店"
[81] "安永浩『精神科医のものの考え方 私の臨床経験から』金剛出版"
[82] "エルンスト・クレッチマー『医学的心理学』みすず書房"
[83] "クルト・シュナイダー『臨床精神病理学』(原著第15版)文光堂"
[84] "カール・ヤスパース『精神病理学原論』みすず書房"
[85] "内村祐之『精神医学の基本問題 精神病と神経症の構造論の展望』(復刻版)創造出版"
[86] "改訂版予診・初診・初期治療笠原診療新社"
[87] "改訂版精神療法の第一歩成田善弘診療新社"
[88] "改訂版意識障害を診わける"
[89] "精神病 笠原嘉"
[90] "軽症うつ病笠原嘉開談社現代新書"
[91] "精神・心理症状学ハンドブック[第2版]"
[92] "援助者必携はじめての精神科"
[93] "精神科・治療と看護のエッセンス"
[94] "精神衛生を始める人の100カ条"
[95] "すべての診療科で役立つ精神科必修ハンドブックー外来や病棟でよく出会う精神症状・疾患への対応"
[96] "Primary Care Note うつ病"
[97] "精神科臨床ニューアプローチ (1 症候からみた精神医学2気分障害3神経症性障害とストレス関連障害4統合失調症と類縁疾患5パーソナリティ障害・摂食障害6老年期精神障害7児童期の精神医学 8睡眠障害・物質依存) 上島国利"
[98] "神経科精神科卒後研修マニュアル(第1部 基本コース)"
[99] "神経科精神科卒後研修マニュアル(第2部疾患別治療ガイドライン)"
[100] "精神医学ハンドブック医学・保健・福析の基礎"
[101] "精神医学レビューシリーズ"
[102] "精神科ポケット辞典"
[103] "ケースでわかる! 精神科治療ガイドラインのトリセツ by EGUIDEプロジェクト"
[104] "脳波判読オープンキャンパス 誰でも学べる7STEP"
[105] "ポケット臨床脳波"
[106] "今日の精神疾患治療指針 第2版"
[107] "精神・心理機能評価ハンドブック"
[108] "メモリークリニック診療マニュアル"
[109] "精神科臨床144のQ & A"
[110] "精神科リハビリテーションワークブック"
[111] "健康ライブラリーシリーズ"
[112] "摂食障害―食べない、食べられない、食べたら止まらない"
[113] "医学論文のための統計手法の選び方・使い方"
[114] "今日の治療薬2021: 解説と便覧"
[115] "精神科レジデントマニュアル"
[116] "新版 精神療法家の仕事―面接と面接者"
[117] "成人期の自閉症スペクトラム診療実践マニュアル"
[118] "精神科診断面接のコツ"
[119] "TEXT精神医学"
[120] "他のオススメ本"
1,2 行目と120行目はいらないようなので抜き出します。その後に、これまでと同様Google検索リンクをつけて表示します。
booklist <- booklist[-1:-2] #1,2行目を抜き出す
booklist <- booklist[-118] #120から2行取り除いたので118が該当行
t3 <- booklist %>% # 以下の結果をt3に返す
add_link() # 自作したadd_link関数を使用する
t3 # t3の表示
# html, pdf で保存
gtsave(data = t3, "boolkist.html")
gtsave(data = t3, "boolkist.pdf")
先程の表から、アンケートで選択されなかった書籍を抜き出してみます。booklistベクトルを表形式にした、list_1というデータと、アンケートのbook列を抜き出したlist_2というデータを突合します(list_3)。その際にlist_2には目印のためにmarkという名前の列を追加し、値を1に指定します。
list_1 <- booklist %>% data.frame() # booklistベクトルを表形式にする
list_2 <- dat2 %>% select(book) %>% # アンケートのbook列を抜き出す
mutate(mark = 1) # markという名前の列を追加し、値を1にする
list_3 <- full_join(list_1,list_2, by=c("."="book")) # list_1とlist_2の突合
list_3 #list_3の表示
これで、選択されなかった書籍は mark列が欠損値 NA となりました。filter()で、mark列が欠損値である行を抜き出せば、アンケートで選択された書籍は除いたものを抽出することができます。
list_3 <- list_3 %>% filter(is.na(mark)) # mark列が欠損値である行を抽出
list_4 <- list_3 %>% pull(".") # 書籍名のある . 列 ベクトルを抜き出す
t4 <- list_4 %>% # 以下の結果をt4に渡す
add_link() # 自作したadd_link関数の使用
t4 # t4 の表示
# html, pdf で保存
gtsave(data = t4, "boolkist2.html")
gtsave(data = t4, "boolkist2.pdf")
今回のpdfなどの結果はこちらからダウンロードできます。pdfをこれまで gtsave()
で作成し保存してきましたが、実のところ現在の仕様だと細かい設定ができません。そのため、html ファイルで保存したものを、ブラウザの印刷→pdfで保存の機能作成したpdfを配布用として作成しています。
今回行った解析は以上です。なるべくシンプルにしたかったのですが、ところどころ複雑で読みづらいコードになっている箇所があったと思います。少しでもRに興味を持っていただけたら嬉しいです。
ご意見や質問等あれば、お問い合わせや、twitter からお気軽にご連絡ください。
最後までお読みいただきありがとうございました。