追記（2017.1.3）
makedummiesパッケージがCRANに登録されました。ブログの このページ を参照して下さい。
追記（2015.12.26）
GitHubで関数を公開しました。ブログの このページ を参照して下さい。
経緯
Rのglm関数を用いて重回帰分析を行う際には、カテゴリカルデータを自動的にダミー変数に変換してくれるため、あまり苦労しません。
現在、個人的にRStanを勉強中であり、同じ解析を行うためには自分でダミー変数を作成する必要があります。さらにカテゴリカルデータと数値データが混在しているとそれだけで非常に大変です。
そこで群馬大学の青木先生が公開されているmake.dummy関数（ http://aoki2.si.gunma-u.ac.jp/R/src/make.dummy.R ）をもとにして関数を作成しました。
作成した関数
（2015.9.6追記）以下のプログラムを修正したものを記事の下に掲載しています。こちらを使用せずにそちらを参考にして下さい。
# http://aoki2.si.gunma-u.ac.jp/R/src/make.dummy.R make.dummy <- function(dat, basal_level= FALSE, sep = "_") { name <- colnames(dat) level <- levels(dat[,1]) if (!is.data.frame(dat)) dat <- as.data.frame(dat) ncat <- ncol(dat) dat[, 1:ncat] <- lapply(dat, function(x) { if (is.factor(x)) { return(as.integer(x)) } else { return(x) } }) mx <- sapply(dat, max) start <- c(0, cumsum(mx)[1:(ncat-1)]) nobe <- sum(mx) ## modified res <- t(apply(dat, 1, function(obs) 1:nobe %in% (start+obs))) + 0 colnames(res) <- paste(name, level, sep = sep) if (basal_level == FALSE) res <- res[,-1] return(res) } make.dummys <- function(dat, ...) { n <- ncol(dat) res_list <- lapply(seq(n), function(i) { tmp <- as.data.frame(dat[,i]) colnames(tmp) <- colnames(dat)[i] if (is.factor(dat[,i])) { # factor or ordered make.dummy(tmp, ...) } else { tmp } }) res <- NULL for (i in seq(n)) { res <- cbind(res, res_list[[i]]) } return(res) }
解説
make.dummy関数
青木先生が公開されているmake.dummy関数を少しだけ改変しました。データはデータフレーム形式で渡します。
変更点は以下の点です。
- 基準となるカテゴリーを削除できるように変更
- basal_level引数が FALSE => 基準となるカテゴリーを削除する（デフォルト）
- basal_level引数が TRUE => 基準となるカテゴリーを削除しない
- 列名を追加
- sep引数で変数名とカテゴリー名を連結する文字列を設定（デフォルトは”_”）
（2015.9.6追記）新バージョンではこの関数は削除しました。ただし、引数の説明はこのまま使用できます。
make.dummys関数
元データが複数の列からなっている場合にも一度にダミー変数に変更するようにしました。
また、カテゴリカルデータ以外（主に数値データ）の場合にはそのまま出力するようにしました。
ですので make.dummys関数を使用すればOKです。引数sepとbasal_levelも使用可能です。
使用例
カテゴリカルデータの場合
基準となるカテゴリーを削除する場合
dat <- data.frame(x = factor(rep(c("a", "b", "c"), each = 3))) dat$x make.dummys(dat)
[1] a a a b b b c c c
Levels: a b c
x_b x_c
[1,] 0 0
[2,] 0 0
[3,] 0 0
[4,] 1 0
[5,] 1 0
[6,] 1 0
[7,] 0 1
[8,] 0 1
[9,] 0 1
基準となるカテゴリーを削除しない場合
make.dummys(dat, basal_level = TRUE)
x_a x_b x_c
[1,] 1 0 0
[2,] 1 0 0
[3,] 1 0 0
[4,] 0 1 0
[5,] 0 1 0
[6,] 0 1 0
[7,] 0 0 1
[8,] 0 0 1
[9,] 0 0 1
変数名とカテゴリー名を連結する文字列を変更
make.dummys(dat, sep = ":")
x:b x:c
[1,] 0 0
[2,] 0 0
[3,] 0 0
[4,] 1 0
[5,] 1 0
[6,] 1 0
[7,] 0 1
[8,] 0 1
[9,] 0 1
順序のあるカテゴリカルデータの場合
dat <- data.frame(x = factor(rep(c("a", "b", "c"), each = 3))) dat$x <- ordered(dat$x, levels = c("a" ,"c" ,"b")) dat$x make.dummys(dat)
[1] a a a b b b c c c
Levels: a < c < b
x_c x_b
[1,] 0 0
[2,] 0 0
[3,] 0 0
[4,] 0 1
[5,] 0 1
[6,] 0 1
[7,] 1 0
[8,] 1 0
[9,] 1 0
カテゴリカル変数は意味のある語が使用されることが多いため、実際にはordered変数を使用して順序のあるカテゴリカルデータとして扱うことが多いと思います。
数値データの場合
dat <- data.frame(x = rep(1:3, each = 3))
dat$x
make.dummys(dat)
x 1 1 2 1 3 1 4 2 5 2 6 2 7 3 8 3 9 3
数値データはそのまま出力されます。
複数の列をもつ場合
2つのカテゴリカルデータ
dat <- data.frame( x = factor(rep(c("a", "b", "c"), each = 3)), y = factor(rep(1:3, each = 3)) ) make.dummys(dat)
x_b x_c y_2 y_3
[1,] 0 0 0 0
[2,] 0 0 0 0
[3,] 0 0 0 0
[4,] 1 0 1 0
[5,] 1 0 1 0
[6,] 1 0 1 0
[7,] 0 1 0 1
[8,] 0 1 0 1
[9,] 0 1 0 1
それぞれダミー変数として出力されます。
カテゴリカルデータと数値データ
dat <- data.frame( x = factor(rep(c("a", "b", "c"), each = 3)), y = rep(1:3, each = 3) ) make.dummys(dat)
x_b x_c y 1 0 0 1 2 0 0 1 3 0 0 1 4 1 0 2 5 1 0 2 6 1 0 2 7 0 1 3 8 0 1 3 9 0 1 3
カテゴリカルデータと数値データが混在してもカテゴリカルデータのみがダミー変数に変換されます。
追記
2015.9.6
プログラムを修正しました。
- make.dummys関数の1つだけで動作するように改変しました。
- ダミー変数に変換するプログラムも簡潔にしました。
- 得られる結果は同じです。
- ただし、元データの行ラベルも再現するように変更しました。
2015.9.11
プログラムを少し修正しました。
統計学関連なんでもあり のNo. 21771から始まるスレッドの青木先生の書き込みをもとに変更しました。
こちらの方が行数は増えますが、処理の内容が明確でした。
make.dummys <- function(dat, basal_level = FALSE, sep = "_") { n_col <- ncol(dat) name_col <- colnames(dat) name_row <- rownames(dat) result <- NULL for (i in seq(n_col)) { ## process each column tmp <- dat[,name_col[i]] if (is.factor(tmp)) { ## factor or ordered => convert dummy variables level <- levels(droplevels(tmp)) ## http://aoki2.si.gunma-u.ac.jp/taygeta/statistics.cgi ## No. 21773 m <- length(tmp) n <- length(level) res <- matrix(0, m, n) res[cbind(seq(m), tmp)] <- 1 ## res <- sapply(level, function(j) ifelse(tmp == j, 1, 0)) colnames(res) <- paste(name_col[i], level, sep = sep) if (basal_level == FALSE) { res <- res[,-1] } } else { ## non-factor or non-ordered => as-is res <- as.matrix(tmp) colnames(res) <- name_col[i] } result <- cbind(result, res) } rownames(result) <- name_row return(result) }
4件のコメント