Rでデータ解析を始めよう020 Rでナップサック問題を解いてみよう

Rでデータ解析を始めよう020 Rでナップサック問題を解いてみよう

モモノキ&ナノネと一緒に統計ソフトRの使い方を学習していきます。

モモノキ&ナノネと一緒にRでナップサック問題を解いてみよう




簡単なナップサック問題の実践練習

ナノネ、今回はR言語でナップサック問題を解いてみよう。

ナップサック問題って、たしか...条件内でどれを詰めたらベストか、最適な組み合わせを求めるヤツだよね。

そうそう、それ。ナップサック問題は一定容積のナップサックに、数種類の品物(各々、容積と価値が決まっている)を詰め込むとき、『ナップサックの容積を超えない範囲で、品物の総価値を最大化するにはどの品物を選べばよいか』という整数計画問題だよ。

さっそくナップサック問題をやってみよう。たとえば品物は以下の容積と価値の果物が5種類あったとするよ。

No.品物容積/個価値/個
1ミカン8090
2リンゴ200250
3バナナ180120
4メロン500600
5ブドウ300500


最初はナップサックの容積が750、品物はそれぞれ1個ずつある場合として、総価値を最大にする組み合わせを解いてみよう。各果物はナップサックに詰めるか詰めないかの2択になるよ。

この問題を数式で表すとこんな感じ。0-1ナップサック問題と呼ばれるよ。

\begin{eqnarray} 制約条件 \begin{cases} 80x_1 + 200x_2 + 180x_3 + 500x_4 + 300x_5 \leq 750 \\ x_1, x_2, x_3, x_4, x_5 \in \{0,1\} \end{cases} \end{eqnarray}

$$最大化:90x_1 + 250x_2 + 120x_3 + 600x_4 + 500x_5$$

モモノキ、Rでナップサック問題が簡単に解けるパッケージとかあるの?

うん、今回はlpSolveというパッケージを使ってみよう。ナップサック問題はlp()関数を利用して解けるよ。データの指定方法はあとで説明するとして、まず1度実行してみるね。

In [1]:
# install.packages("lpSolve") # 必要に応じてインストール
library(lpSolve)

VALUE <- c(90, 250, 120, 600, 500) # 品物の価値(ベクトル形式)
SIZE <- matrix(c(80, 200, 180, 500, 300), nrow=1) # 品物の容積(マトリックス形式)
CAPA <- 750 # ナップサックの容積

ans <- lp(direction = "max",
          objective.in = VALUE,
          const.mat = SIZE,
          const.dir = "<=",
          const.rhs = CAPA,
          all.bin = TRUE)

print(ans)
Success: the objective function is 870 

Successって表示されたから、計算がうまくいったみい。最大化時の総価値が870ってことかな?

そうだよ。どの品物が選ばれたかは、lp()関数の返り値$solutionで確認できるよ。

In [2]:
print(ans$solution) # -> 0 1 1 0 1 # 選択された品物(0=未選択、1=選択)
# ans$objval # -> 870 # 最大の総価値
[1] 0 1 1 0 1


データの見かたは、0が選ばれたなっかった品物で1が選ばれた品物。データは品物表の上から順番に指定したから、ミカン、リンゴ、バナナ、メロン、ブドウの順で0/1が出力されているよ。

じゃぁ、選ばれた品物はリンゴ、バナナ、ブドウの3種類だね。念のため検算してみる。

In [3]:
# 選択された品物:リンゴ、バナナ、ブドウ
250+120+500 # -> 870 品物の総価値
200 + 180 + 300 # 680 品物の総容積(ナップサック容積750以下)
870
680

たぶん、合ってるみたい。

lp()関数のデータの指定方法について簡単に説明するね。

In [4]:
# 再掲
# VALUE <- c(90, 250, 120, 600, 500) # 品物の価値(ベクトル形式)
# SIZE <- matrix(c(80, 200, 180, 500, 300), nrow=1) # 品物の容積(マトリックス形式)
# CAPA <- 750 # ナップサックの容積

# ans <- lp(direction = "max",
#           objective.in = VALUE,
#           const.mat = SIZE,
#           const.dir = "<=",
#           const.rhs = CAPA,
#           all.bin = TRUE)

1個目の引数directionは最大(max)/最小(min)化の指定で、ナップサック問題は最大化が目的なので"max"を指定するよ。

2個目の引数objective.inは最大化する目的の値、つまり今回は品物のそれぞれの価格を指定するよ。数値の並べ方は最大化式の係数をベクトル形式で順番に並べればOK。

3個目の引数const.matは制約条件の設定で、品物それぞれの容積を指定するよ。数値の並べ方は制約条件式(上段)左辺の係数を順番に並べてね。const.matに渡すデータはマトリックス形式にする必要があるから注意してね(1行で1制約指定、行を増やして複数指定も可能)。

4個目の引数const.dirも制約条件の設定で、制約式の等号・不等号(>=,<=,==)を設定するよ。今回は750以下の制約だから"<="を指定しているよ。

5個目の引数const.rhsも制約条件の設定で、制約条件式右辺の値を設定するよ。今回は750以下の制約だから750を指定しているよ。

もし、const.matで制約条件行を複数設定(マトリックス形式)したときは、const.dirとconst.rhsも条件数分だけベクトル形式で指定する必要があるから覚えておいてね。

最後の引数all.binは、結果を0/1で求めて欲しいときにTRUEを設置するよ。今回のナップサック問題は品物を選ぶか選ばないの2値だからTRUEに設定するよ。これは制約条件式下段に該当する設定だね。

データの指定が結構面倒だけど、表や式の値を見ながら順番通りに数値を並べれば大丈夫かも。

うん、ただデータ形式は間違えないように注意してね(ベクトル、マトリックス)。

次は同じ品物を複数個選んでもよい条件で、ナップサック問題を解いてみよう。

どれでも詰め放題だね。

品物(種類、容積、価値)はさっきと同じ条件で、ナップサックの容積はもっと大きくして2000とした場合で問題を解いてみよう。

品物が複数選べる条件の場合は、オプション引数のall.bin=TRUE(デフォルトFALSE)は外して、かわりにint.vecに品物の個数分の整数ベクトル(1:N)を設定してね。int.vecを設定しないと1.7個とか端数も求めちゃうから注意だよ。

In [5]:
# install.packages("lpSolve") # 必要に応じてインストール
# library(lpSolve)

VALUE <- c(90, 250, 120, 600, 500) # 品物の価値(ベクトル形式)
SIZE <- matrix(c(80, 200, 180, 500, 300), nrow=1) # 品物の容積(マトリックス形式)
CAPA <- 2000 # ナップサックの容積(大)

ans <- lp(direction = "max",
          objective.in = VALUE,
          const.mat = SIZE,
          const.dir = "<=",
          const.rhs = CAPA,
          int.vec = 1:length(VALUE) # 1~品物の個数分を整数ベクトルを指定
         )

print(ans)
print(ans$solution)
Success: the objective function is 3250 
[1] 0 1 0 0 6
In [6]:
# 検算(リンゴ1個、ブドウ6個)
250*1 + 500*6 # -> 総価値 3250
200*1 + 300*6 # -> 総容積 2000(ナップサック大の容積2000以下)
3250
2000


リンゴ1個とブドウ6個を選んだときに最大価値で、3250だって。ブドウは好きだけどブトウばっかり多いとチョット...。たとえばバナナは必ず2本以上入れるとか指定できないかな?

詳しい使い方はまだよくわからないけど、制約条件の中に『バナナを2本以上お願いします』と書いておけばOKかも?

In [7]:
# install.packages("lpSolve") # 必要に応じてインストール
# library(lpSolve)

VALUE <- c(90, 250, 120, 600, 500) # 品物の価値(ベクトル形式)
SIZE <- matrix(c(80, 200, 180, 500, 300), nrow=1) # 品物の容積(マトリックス形式)
BANANA <- matrix(c(0,0,1,0,0), nrow=1) # 3番目のバナナだけ1に設定
SEIYAKU <- rbind(SIZE, BANANA) # SIZEとBANANAの制約マトリックスを連結

CAPA <- 2000 # ナップサックの容積(大)
BANANA_MIN <- 2 # バナナの最低個数(2本以上お願い!)

ans <- lp(direction = "max",
          objective.in = VALUE,
          const.mat = SEIYAKU, # 制約にバナナの条件を追加
          const.dir = c("<=", ">="), # 総容積はCAPA以下、バナナ本数はBANANA_MIN以上
          const.rhs = c(CAPA, BANANA_MIN),
          int.vec = 1:length(VALUE) # 1~品物の個数分を整数ベクトルを指定
         )

print(ans)
print(ans$solution)
Success: the objective function is 2830 
[1] 1 0 2 0 5
In [8]:
# 検算(ミカン1個、バナナ2個、ブドウ5個)
90*1 + 120*2 + 500*5 # -> 総価値 2830
80*1 + 180*2 + 300*5 # -> 総容積 1940(ナップサック大の容積2000以下)
2830
1940


こんどはバナナも2本選んで貰えた(満足)。

ナップサック問題を解く練習は以上で。
またね!





スポンサーリンク

0 件のコメント :

コメントを投稿