学生100人余りに対して、実習コースがそれぞれ用意されている。
これを最適に割り振るために、シンプレックス法（具体例）というものを用いてコース割り振りしようと学生委員は考えているらしい。
その全貌をコピペした（一部改変）。
1 学生を実習コースに割り当てる方法として定めます。
2 みなさんにそれぞれのコースに対して、
A（強く希望する） B（希望する） C（どちらでもよい） D（行きたくない）
のいずれかを設定してもらいます。
- Aは5個以上、BはAの3倍、Dは15個以下とします。
3 学生の希望が最も満たされるように、プログラミングによる割り当てを行います。
- A：3点、B：2点、C：0点、D：-15点として、合計値が最大になるような割り当てを行います。
- 同一の最大値をとる割り当てが複数存在する場合は、そのうちの一つが選択されます。
- その選択は、最初に学生の番号とコースの番号をシャッフルしたのちに、割り当て計算を行うことにより実現されます。
4 学生iにコースjを割り当てるかどうかを変数で表せば、これは変数が（学生の数）×（コースの数）だけある線形計画問題と見なせます。そこで、簡単に理解でき、かつ実装も容易なシンプレックス法を採用します。
5 シンプレックス法とは、問題の条件がつくる多面体を考えたときに、その頂点のみを考察すれば十分であることを利用した方法です（高校で学んだ線形計画法を思い出してください。条件式が直線のみの場合、解は必ずそれらの交点のいずれかにあったかと思います）。
まず適当な頂点を一つ選び、一定の規則に沿って隣り合う頂点に移動することを繰り返します。
このとき、最大化すべき目的関数が増大、または変化しないように、規則を設定します。その結果、十分短い時間で最適解に行き着くことができます。
多面体は凸であるので、最大ではない極大解に収束することはありません。（感覚的にも、平面のみで構成される多面体に「凹み」がないことは明らかでしょう。）
また、プログラムが正しく機能することを検証するために何通りかの検証をいたしました。
例えば、点数の設定について、希望の偏りがない場合、ややある場合、かなりある場合の３通りについて複数のテストデータを用意して割り当てを行うと、
Aの点数がBの点数の2倍を超えない場合に（Aの数）＋（Bの数）が大きくなることが分かり、
上記の配点を採用しました。
だそうだ。
Rでシンプレックス法をするには、Rで数理計画のページから
library(linprog) solveLP
が使えるようだ。
具体例リンクをやってみると
Amat <- cbind(c(1, 1, 3), c(2, 1, 1)) bvec <- c(2, 3) names(bvec) <- c("product A", "product B") cvec <- c(14, 8, 18) names(cvec) <- c("plastic", "alminium", "gum") solveLP(bvec, cvec, Amat, maximum=TRUE)
Results of Linear Programming / Linear Optimization Objective function (Maximum): 22 Iterations in phase 1: 0 Iterations in phase 2: 2 Solution opt product A 2 product B 6 Basic Variables opt product A 2 product B 6 S gum 6 Constraints actual dir bvec free dual dual.reg plastic 14 <= 14 0 1 3 alminium 8 <= 8 0 1 1 gum 12 <= 18 6 0 6 All Variables (including slack variables) opt cvec min.c max.c marg marg.reg product A 2 2 1.5 3.0 NA NA product B 6 3 2.0 4.0 NA NA S plastic 0 0 -Inf 1.0 -1 3 S alminium 0 0 -Inf 1.0 -1 1 S gum 6 0 -0.5 0.2 0 NA
製品Aが2つ、製品Bが6つのとき、利益最大となる。
さて、実習割り振りをやってみる。
#データ作りから。 #Aは強く希望 #Bは希望 #Cはどちらでもよい #Dは行きたくない course <- 100 #実習コースの数 student <- 100 #学生の数 hope <- 4 #学生のコース評価。行きたいか行きたくないか。 hope_score <- c(3, 2, 0, -15) #各評価についての得点分配 #シミュレーションデータ data <- matrix(0, nr=student, nc=course) dimnames(data) <- list(1:student, 1:course) names(dimnames(data)) <- c("student", "course") for(i in 1:student){ D_num <- sample(1:15, size=1) #D評価をつけるコースの数 A_num <- sample(5:floor((course - D_num)/4), size=1) #A評価をつけるコースの数 hope_num <- c(A_num, 3*A_num, course - 4*A_num - D_num, D_num) #和はcourse hope_vec <- unlist(mapply(rep, hope_score, hope_num)) hope_order <- sample(1:course, size=course) #ランダムに hope_student <- hope_vec[hope_order] #ひとりの学生がそれぞれのコースを評価したもの data[i, ] <- hope_student }
で、データを作ったはいいが、ここからどうしようかで止まっている。
library(lpSolve) lp.assign
が使えそうだ。
