線形計画法・シンプレックス法 その2

シンプレックス法の続き。
　
前回の調査で

library(lpSolve)
lp.assign

を使えばいけそうなことが判明したので、

#データはリンクから作成しておく。
library(lpSolve)
res <- lp.assign(data, direction="max") #全体を最大化するような最適化。最小化もできる = "min"
final <- matrix(0, nr=nrow(res$solution), nc=2)
for(i in 1:nrow(final)){
	final[i, 1] <- which(res$solution[i,]==1) #誰がどのコースに割り振られたか。
	final[i, 2] <- data[i, which(res$solution[i,]==1)] #各学生の割り振られたコースについての事前評価。
}

　
シミュレーションデータの都合で、評価Bに当たってしまうような学生がなかなかでてこないので、このデータを使ってみる。
　
このデータで上のプログラムを実行すると、評価Bの学生が9人出てくる。
dataを複数回実行してみると

loop_res <- lapply(mapply(rep, 0, 1:4), unique)
par(mfrow=c(2, 2))
for(i in 1:4){
	loop_res[[i]] <- lp.assign(data, direction="max")$solution
	image(loop_res[[i]], main=paste("loop", i))
}

dataを固定したまま回しただけでは、違うパターンは生じないようだ。

　
学生の順番、つまり行列の行をランダムに入れ替えてみる。

shuffle_res <- lapply(mapply(rep, 0, 1:8), unique)
final_res <- lapply(mapply(rep, 0, 1:8), unique) #学生のコース評価を格納する。
par(mfrow=c(2, 4))
for(i in 1:8){
	data <- data[sample(1:nrow(data)), ] #ランダムに入れ替える。
	
	shuffle_res[[i]] <- lp.assign(data, direction="max")$solution
	
	final <- matrix(0, nr=nrow(shuffle_res[[i]]), nc=2) 
	for(j in 1:nrow(shuffle_res[[i]])){
		final[j, 1] <- which(shuffle_res[[i]][j,]==1) #コース評価を割り振り
		final[j, 2] <- data[j, which(shuffle_res[[i]][j,]==1)] #学生によるコース評価
	}
	final_res[[i]] <- final
	
	image(shuffle_res[[i]], main=paste("shuffle", i))
}

#入れ替えにより評価Bの学生数が変化したかどうかを調べる。
for(i in 1:length(final_res)){
	print(sum(final_res[[i]][,2]==2))
}

行の入れ替えが起こる度に、最適化したコース分けが変化している。
評価Bの学生は9人のまま変化しない。通りの選び方があるのだろう。