Rで学生・生徒を指定した人数のグループに分ける関数

【追記 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を入れる、といった感じで。

空行の削除は、以下の記事を参考とさせていただきました。

Rで空行・空列を除去する方法

人数がグループ数で割り切れない場合、余った人を各グループに1人ずつ割り当てるような仕様となっている。例えば30人で4人グループを作る場合、4人グループが5組と、5人グループが2組できる。これは自分が授業内で即興でグループを作るときのアルゴリズムに則っている。「いや自分なら4人グループ7組と2人ペア1組にする」という先生がいましたら、この関数はそういうのには対応していませんごめんなさい。

この仕様のせいで、思ったようなグループの人数にならないときがある。例えば40人で7人グループを作るとき、余った5人をできたグループに割り当てていくと、すべてのグループが8人になってしまう。これは余りの人数などで例外処理をしていけばいいのだろうけど、しんどいので今回は割愛。そもそも7人グループとか作ることなんて滅多にないと思う。

これをShinyアプリにするのが本当のねらいなのだけど、それはまた時間のあるときに。