複数のデータフレームを組み合わせる+α
徳岡 大
2017/11/26 HijiyamaR.final
dplyr::select()
- データセットから変数選択をできる
- 変数の選択の仕方がいろいろ
- 書き方1: 1つずつ変数を指定するのも可
dplyr::select(dat01, # 第一引数にはデータフレームを宣言
trial, rt, status)
## # A tibble: 15 x 3
## trial rt status
## <int> <int> <int>
## 1 1 2190 2
## 2 2 1993 2
## 3 3 2531 1
## 4 4 2415 2
## 5 5 3849 1
## 6 6 3305 2
## 7 7 4295 1
## 8 8 2641 1
## 9 9 1324 1
## 10 10 4191 2
## 11 11 1277 2
## 12 12 2819 1
## 13 13 1754 1
## 14 14 8387 2
## 15 15 5671 2
dplyr::select(dat01, # 第一引数にはデータフレームを宣言
-card, -uk, -trialinblock, -task, -cardShape, -cardNum, -cardColor, -selected)
## # A tibble: 15 x 3
## trial rt status
## <int> <int> <int>
## 1 1 2190 2
## 2 2 1993 2
## 3 3 2531 1
## 4 4 2415 2
## 5 5 3849 1
## 6 6 3305 2
## 7 7 4295 1
## 8 8 2641 1
## 9 9 1324 1
## 10 10 4191 2
## 11 11 1277 2
## 12 12 2819 1
## 13 13 1754 1
## 14 14 8387 2
## 15 15 5671 2
dplyr::select(dat01, # 第一引数にはデータフレームを宣言
-card:-cardColor, -selected)
## # A tibble: 15 x 3
## trial rt status
## <int> <int> <int>
## 1 1 2190 2
## 2 2 1993 2
## 3 3 2531 1
## 4 4 2415 2
## 5 5 3849 1
## 6 6 3305 2
## 7 7 4295 1
## 8 8 2641 1
## 9 9 1324 1
## 10 10 4191 2
## 11 11 1277 2
## 12 12 2819 1
## 13 13 1754 1
## 14 14 8387 2
## 15 15 5671 2
dplyr::select()における変数の選択方法
dplyr::select(dat01, # 第一引数にはデータフレームを宣言
contains("card"))
## # A tibble: 15 x 4
## card cardShape cardNum cardColor
## <int> <chr> <int> <chr>
## 1 35 star 1 red
## 2 44 star 3 yellow
## 3 4 circle 1 yellow
## 4 51 triangle 1 red
## 5 11 circle 3 red
## 6 39 star 2 red
## 7 45 star 4 blue
## 8 46 star 4 green
## 9 48 star 4 yellow
## 10 33 star 1 blue
## 11 43 star 3 red
## 12 17 cross 1 blue
## 13 25 cross 3 blue
## 14 34 star 1 green
## 15 52 triangle 1 yellow
stringr::str_sub()
- 特定の列の文字列を抜き出す
- mutate()の中で使用することで文字列操作した変数を加えられる
- stringr::str_sub(列やオブジェクトの指定, 抜き出したい最初の文字数, 抜き出したい最後の文字数)
NRS <- "アイエエエ!ニンジャ!?ナンデ!?"
stringr::str_sub(NRS, 7, 12)
## [1] "ニンジャ!?"
# データフレームから列を選択することも可能
stringr::str_sub(dat01$task, 1, 2) # taskの中の最初の2文字を持ってくる
## [1] "sh" "sh" "sh" "sh" "sh" "nu" "nu" "nu" "nu" "nu" "co" "co" "co" "co"
## [15] "co"
## [1] "shape" "shape" "shape" "shape" "shape" "number" "number"
## [8] "number" "number" "number" "color" "color" "color" "color"
## [15] "color"
実験データの読み込みに利用(準備)
- 実験データの読み込みについては，専修大の国里先生の資料を参照し，自分の実験データに合わせています。
- 詳しく知りたい人は上記のリンク先へGO!!
workDir <- getwd() # 現在のwdをworDirに格納
setwd(paste(workDir, "expData_17", sep = "/")) # 実験データの入ったフォルダをwdに設定
fileNames <- list.files () # wd内のファイル名を格納
setwd("..") # 1つ上の階層のフォルダをwdに指定
print(fileNames)
## [1] "01co.csv" "01mp.csv" "01mv.csv" "01pv.csv" "02co.csv" "02mp.csv"
## [7] "02mv.csv" "02pv.csv"
numberSubject <- length(fileNames) # ファイル数を格納
print(numberSubject)
## [1] 8
いざデータ読み込み(基本形)
# expdataの準備
exp_data <- NULL
# 1からnumberSubject分（8回）操作を繰り返す
for(i in 1:numberSubject){
# 読み込んだcsvファイルのデータをtemp_dataに保存
temp_data <- readr::read_csv(paste(workDir, "expData_17", fileNames[i], sep = "/"), na = ".")
#データの結合
exp_data <- dplyr::bind_rows(exp_data, temp_data)
}
データの確認
- 他にもほしい変数がある!(ファイル名, 実験条件, RTのラグ…etc)
- 使わない変数は消しときたい
# データの確認
DT::datatable (exp_data, options = list(pageLength = 20))
いざデータ読み込み(応用系)
# expdataの準備
exp_data <- NULL
# 1からnumberSubject分（8回）操作を繰り返す
for(i in 1:numberSubject){
# 読み込んだcsvファイルのデータをtemp_dataに保存
temp_data <- readr::read_csv(paste(workDir, "expData_17", fileNames[i], sep = "/"), na = ".")
temp_data <- temp_data %>%
dplyr::select(-card, -uk, -task, -cardShape, -cardNum, -cardColor) %>% # 使用しない変数を削除
dplyr::mutate(id = rep(i, length(rt))) %>% # ファイル名ごとにidを付与
dplyr::mutate(csv_name = fileNames[i]) %>% # ファイル名を追加
dplyr::mutate(csv_id = stringr::str_sub(fileNames[i], 1, 4)) %>% # 質問紙データにはファイル名-.csvで記入してある
dplyr::mutate(cond = stringr::str_sub(fileNames[i], 3, 4)) %>% # あとでデータをつける紐付け用
dplyr::mutate(bf_rt = lag (rt)) %>% # 反応時間のラグをとる
dplyr::mutate(rt_f = lag (status) - 1) %>% # 前の試行の正誤を判別する
dplyr::mutate(rt_ff = lag (status, n = 2) - 1) # 2つ前の試行の正誤
#データの結合
exp_data <- dplyr::bind_rows(exp_data, temp_data)
}
データの確認
# データの確認
DT::datatable (exp_data)
できたー!!
dplyr:left_join()
- join系は2つのデータフレームの結合させる
- left_join(x, y)の場合はxのデータフレームに対応するyを新たな列として追加
dat06 <- dplyr::left_join(dat01, dat03, by = "trial")
DT::datatable (dat06, options = list(pageLength = 5))
パイプ演算子を使うとこんな感じ
dat01 %>%
dplyr::left_join(dat03, by = "trial") %>%
DT::datatable (options = list(pageLength = 5))
変数の合成など
q_data02 <- q_data01 %>%
dplyr::mutate (no = 1) %>% # 実験データとjoinするときに使用。別に必要なかった。
dplyr::select (-free, -備考 ) %>%
# know_dummyの作成(1=1, 2or3=0)
dplyr::mutate (know_d = ifelse (know == 1, 1, 0)) %>%
# 逆転項目の処理
dplyr::mutate (stai1r = 8 - stai1) %>%
dplyr::mutate (stai2r = 8 - stai2) %>%
dplyr::mutate (stai5r = 8 - stai5) %>%
# 合成変数の追加
dplyr::mutate (stai = (stai1r + stai2r + stai3 + stai4 + stai5r) / 5, na.rm = TRUE) %>% # stai
dplyr::select (file_id, no, stai, know_d, stai1r, stai2r, stai3, stai4, stai5r)
データフレームの確認
- 欠測が1項目でもあるとNAになってしまう
- 欠測をどうにかしたい場合は，FIMLなどを使った因子分析や項目反応理論を用いて因子得点にして処理していくのが良さそう
因子得点を使う場合
library(lavaan)
# CFAを行い因子得点をf_staiに格納
cfa_stai <- '
f_stai =~ stai1r + stai2r + stai3 + stai4 + stai5r
'
cfa01 <- cfa (cfa_stai, data = q_data02, missing="fiml")
f_stai <- data.frame (lavPredict(cfa01))
f_stai <- add_rownames (f_stai)
q_data03 <- q_data02 %>%
dplyr::add_rownames () %>%
dplyr::left_join(f_stai, by = "rowname") %>%
dplyr::select (file_id, no, know_d, stai, f_stai)
datatable(q_data03)
実験データと質問紙データをjoin
- まずexp_data01にあるcsvIdとq_data03にあるfile_idの紐付けると，勝手に複製してくれる
full_data01 <- exp_data %>%
dplyr::left_join(q_data03, by = c("csv_id" = "file_id")) %>%
dplyr::select(-status, -selected, -csv_name)
datatable (full_data01)
できたー!!
遠回りな方法だった…
- 2つの変数で紐づけて，各idのtrial = 1にだけ数値が入るようにする
- tidyr::fillを使って，空白のセルに手前の数値をコピーする
full_data02 <- exp_data %>%
dplyr::left_join(q_data03, by = c("csv_id" = "file_id", "trial" = "no")) %>%
dplyr::select(-status, -selected, -csv_name)
datatable (full_data02)
full_data02 %>%
tidyr::fill (f_stai) %>% # know_d:f_staiのようにして複数選択も可能
datatable ()
ワイド型→ロング型
l_data01 <- w_data01 %>%
tidyr::gather(key = 試行数, value = 正誤, trial1:trial5)
l_data02 <- w_data01 %>%
tidyr::gather(key = 試行数, value = 正誤, contains ("trial"))
l_data03 <- w_data01 %>%
tidyr::gather(key = 試行数, value = 正誤, -id)
