【追記 2018/5/13】コードをWordpressに貼り付けたときに一部の文字(””)が違う文字として貼り付けられてしまっていることに気づきました。現状では、そのまま貼り付けただけではエラーになりますので、ご注意ください。 -> 解決しました。
【追記 2018/5/29】特定の人数でエラーを吐くバグを修正しました。バグをご指摘くださった田村さんありがとうございました。
【追記 2018/5/31】出力の”member”が”menber”になってました。どれだけ麺好きなんだ。ということで修正しました。
【追記 2018/8/24】この関数について、Nagoya.Rでもっと簡単に同じことができるというコメントをいただきました。詳しくはこちら。
表題の件について。前々から作ろうと思っていたけど、近いうちにNagoya.Rをやることになりそうなので、話の種に作ってみた。
以下をRのコンソールに貼り付ける。
Windowsの方はこちら
groupfunc <- function(p){ d <- as.vector(read.table("clipboard", header = F, sep = ",")[,1]) #学生数 n <- length(d) #余りの人数 r <- n%%p #空の行列を作成 if(1 <= r){ tb <- matrix(, nrow = trunc(n/p), ncol = (p+1)) #余りが1以上であれば、余分に1列を追加 }else{ tb <- matrix(, nrow = trunc(n/p), ncol = p) } #余った学生がいなくなるまで1人多くサンプリング for(i in 1:trunc(n/p)){ if(i <= r){ for(j in 1:(p+1)){ tb[i,j] <- sample(d, 1) d <- d[-which(d %in% tb[i,j])] } }else{ for(j in 1:p){ tb[i,j] <- sample(d, 1) d <- d[-which(d %in% tb[i,j])] } } } result <- as.data.frame(tb) #空行の削除(参考:http://id.fnshr.info/2017/08/14/r-blank-row-col/) # is_blank の定義 is_blank <- function(x) {is.na(x) | x == ""} # すべてが空欄である行を探す unnecessary_row <- apply(result, 1, function(x){ all(is_blank(x)) }) # 「すべてが空欄である行」以外を残す(=空行の除去) result <- result[!unnecessary_row,] #見出し行に名前を付与 namae <- "member.1" for(k in 2:ncol(result)){ namae <- append(namae, paste("member.", k)) } colnames(result) <- namae result }
【追記 2018/5/13】Macの方はこちらを。Macでは動かないことをご指摘くださった田村さんありがとうございました!
groupfunc <- function(p){ d <- as.vector(read.table(pipe("pbpaste"), header = F, sep = ",")[,1]) #学生数 n <- length(d) #余りの人数 r <- n%%p #空の行列を作成 if(1 <= r){ tb <- matrix(, nrow = trunc(n/p), ncol = (p+1)) #余りが1以上であれば、余分に1列を追加 }else{ tb <- matrix(, nrow = trunc(n/p), ncol = p) } #余った学生がいなくなるまで1人多くサンプリング for(i in 1:trunc(n/p)){ if(i <= r){ for(j in 1:(p+1)){ tb[i,j] <- sample(d, 1) d <- d[-which(d %in% tb[i,j])] } }else{ for(j in 1:p){ tb[i,j] <- sample(d, 1) d <- d[-which(d %in% tb[i,j])] } } } result <- as.data.frame(tb) #空行の削除(参考:http://id.fnshr.info/2017/08/14/r-blank-row-col/) # is_blank の定義 is_blank <- function(x) {is.na(x) | x == ""} # すべてが空欄である行を探す unnecessary_row <- apply(result, 1, function(x){ all(is_blank(x)) }) # 「すべてが空欄である行」以外を残す(=空行の除去) result <- result[!unnecessary_row,] #見出し行に名前を付与 namae <- "member.1" for(k in 2:ncol(result)){ namae <- append(namae, paste("member.", k)) } colnames(result) <- namae result }
( )の中の引数でグループ毎の人数を指定する。2人グループ(要するにペア)なら2を、3人グループなら3を入れる、といった感じで。
空行の削除は、以下の記事を参考とさせていただきました。
人数がグループ数で割り切れない場合、余った人を各グループに1人ずつ割り当てるような仕様となっている。例えば30人で4人グループを作る場合、4人グループが5組と、5人グループが2組できる。これは自分が授業内で即興でグループを作るときのアルゴリズムに則っている。「いや自分なら4人グループ7組と2人ペア1組にする」という先生がいましたら、この関数はそういうのには対応していませんごめんなさい。
この仕様のせいで、思ったようなグループの人数にならないときがある。例えば40人で7人グループを作るとき、余った5人をできたグループに割り当てていくと、すべてのグループが8人になってしまう。これは余りの人数などで例外処理をしていけばいいのだろうけど、しんどいので今回は割愛。そもそも7人グループとか作ることなんて滅多にないと思う。
これをShinyアプリにするのが本当のねらいなのだけど、それはまた時間のあるときに。
今MBAでやろうとして気づいたけど関数内にクリップボード使ってるからそこ書き換えないといかんなw
そうだそうだw
すぐ更新します
あと最後に}が1つ足りない?
}は足りてるはずなんですけど、今確認したらwordpressに貼り付けたときに” “が違う文字として貼り付けられてますね。これどうしたらいいのかな。
あーそうそうそれはあった。だから自分で書き換えなおしたな。Rpubsとかにアップして参照してもらうとか?
あとこれはMacだからなのかわからんけど,名前のセルで姓名の間にスペース入ってると読み込んだときに区切りをそこに設定してしまっているっぽい。うちはDLした名簿のデフォルトが日本語でも英語でもスペースありなんだよな。sep=”,”にしてとりあえず解決。
GitHubに上げようとしたら文字コード絡みでコメントが全滅して嫌になりそうw
区切り文字は明示的に指定しておいたほうが良さそうですね。
よく見たらテストに使ってたうちの名簿も氏名の間に半角スペースありました。僕の環境だと問題なく動いたんで気がつきませんでした。
38人でやろうとしたら,引数が2, 6. 7. 9ならできるんだけど,3~5だと「sample.int(length(x), size, replace, prob) でエラー:一番目の引数が不正です」というエラーが出た…
関数でなければエラー吐きつつ結果も出るんですけど、関数だとダメみたいですね…直します。
バグは直ったけどコードが上手く貼れない…