(VBA) 部分集合和問題

質問

TVを録画した複数の動画ファイルがあります。
これをBDにムーブする場合
　BDの容量25GBになるべく上手く収まるようにファイル組み合わせたいと思います。

（一つのファイルで25GB以上になる事はありません。）

つまり、
　複数のファイルを組み合わせて25GBを超えないで
　　最大25GBに一番近いように組み合わせる手法です。

ファイルが複数あるので
　2枚以上になる場合は、1枚を決定後に
　　　残ったファイルから同じ手法で25GBに上手く収まるようにファイルを選択します。

数学的には「部分集合和問題」と言うそうです。

現在、複数の動画ファイルは、2行目から
　各ファイルのファイル名（b列）とサイズ（ｃ列）をセルに記載済みです。
（1行目は見出し行）

----------------------------------
参考になる記事をネットで探してみました。

下記などが参考になりそうです。

http://kikutips.blog13.fc2.com/blog-entry-201.html

初心者の私が理解できたのは、
　C列にデータ、D列に目標値（25GB＝25600MB）を記入してEnterをクリックすると
　新規シートに組み合わせの結果が表示されると言う事です。

参考画像（結果表示）
https://imgur.com/Fmav5hZ

-------------------------------------
上記から入手出来るサンプル（kent201.zip)は、
　　組み合わせが目標値と同じ値になる場合しか結果が表示されません。
　　これを目標値を超えないで一番近い数値をのみを求めるように改造したいのです。
　　（もちろん、目標値と同じ組み合わせがあれば最上位の候補になります。）

以下に、kent201.zipのコードを添付しました。

Option Explicit

Dim dic As Object

Public Sub Samp2(dicR As Object, vS As Variant)
Dim vSrc As Variant

Set dic = CreateObject("Scripting.Dictionary")
vSrc = mySort(dicR.Items)
Call NotReCode(vS, vSrc)
Call myPrint2(vS, vSrc, dic.Items)
Set dic = Nothing
End Sub

Private Function mySort(ByVal vSrc As Variant) As Variant
Dim v As Variant
Dim i As Long
Dim bNG As Boolean

bNG = True
While (bNG)
bNG = False
For i = LBound(vSrc) To UBound(vSrc) - 1
If (vSrc(i)(0) < vSrc(i + 1)(0)) Then
v = vSrc(i)
vSrc(i) = vSrc(i + 1)
vSrc(i + 1) = v
bNG = True
End If
Next
Wend
For i = UBound(vSrc) - 1 To LBound(vSrc) Step -1
vSrc(i)(2) = vSrc(i + 1)(0) + vSrc(i + 1)(2)
Next
mySort = vSrc
End Function

Private Sub NotReCode(vNum As Variant, vSrc As Variant)
Dim iPosAry() As Long, iPosMax As Long
Dim iRdPos As Long, iPos As Long
Dim vSum As Variant, v As Variant
Dim i As Long

iPosMax = UBound(vSrc)
iRdPos = LBound(vSrc)
iPos = iRdPos
ReDim iPosAry(iPos To iPosMax)
vSum = 0

While (vSrc(iRdPos)(0) > vNum)
iRdPos = iRdPos + 1
If (iRdPos > iPosMax) Then Exit Sub
Wend

While (1)
v = vNum - vSum
Do
If (iRdPos > iPosMax) Then
If (iPos <= LBound(iPosAry)) Then Exit Sub ' ここでのみ大元 While を抜ける
iPos = iPos - 1
iRdPos = iPosAry(iPos) + 1
vSum = vSum - vSrc(iRdPos - 1)(0)
v = vNum - vSum
End If
Do While (iRdPos <= iPosMax)
If ((vSrc(iRdPos)(0) + vSrc(iRdPos)(2)) < v) Then
iRdPos = iPosMax
ElseIf (vSrc(iRdPos)(0) <= v) Then
Exit Do
End If
iRdPos = iRdPos + 1
Loop
Loop While (iRdPos > iPosMax)
iPosAry(iPos) = iRdPos
If (v = vSrc(iRdPos)(0)) Then
i = dic.Count
dic(i) = Array(iPosAry, iPos)
Else
vSum = vSum + vSrc(iRdPos)(0)
iPos = iPos + 1
End If
iRdPos = iRdPos + 1
Wend
End Sub
Private Sub myPrint2(vNum As Variant, vSrc As Variant, vA As Variant)
Dim iRowMax As Long
Dim i As Long, j As Long
Dim v As Variant, vv As Variant
Dim vData As Variant

On Error Resume Next
iRowMax = UBound(vA) - LBound(vA) + 2
If (iRowMax > Rows.Count) Then iRowMax = Rows.Count
ReDim vData(1 To iRowMax, 1 To UBound(vSrc) - LBound(vSrc) + 2)
vData(1, 1) = vNum
i = 2
For Each v In vSrc
vData(1, i) = v(0)
i = i + 1
Next
j = 1
For Each v In vA
vv = v(0)
vData(j + 1, 1) = j
For i = LBound(vv) To v(1)
vData(j + 1, vv(i) - LBound(vSrc) + 2) = "○"
Next
j = j + 1
If (j > iRowMax) Then Exit For
Next
Application.ScreenUpdating = False
With Worksheets.Add(After:=ActiveSheet)
With .Cells(1, 1).Resize(iRowMax, UBound(vData, 2))
.Value = vData
.Rows(1).Interior.

回答No.4

kkkkkm · ベストアンサー

> 組み合わせの中で一度利用したデーターを削除する必要は無いと思いますが　？

一度だけの計算でしたら問題はありません。
NuboChanさんがテストした画像の14作で一度だけ計算し、選択されなかった残り7作は次の選択肢にはいれないというのでしたら削除しなくてもいいと思います。

同一データで複数回計算するのでしたら、たとえば
質問で参考としてあげているサイトの最初に出てくる4つの画像の右上で見ると
A1の値になる組み合わせを2行目から10行目まで各行で求めていて、同じ値が選択されています。
たとえば、3行5行6行目でF列の765が選択されています。

> 求める指定も最大容量、最大総額、最大重量と３つを指定するようになっています。

最大値を超えないように設定するだけみたいですから、データの方の価格をファイルサイズにして後は1にし、最大は全て25600にしたらいけると思います。

Const N = 5 ' データの数
はそのままでデータの数ですのでテスト画像の場合は14です。

添付画像は質問のテスト画像の、結果の方の順番にデータを入れて最初の4940を4939にしています。

お礼

解説ありがとうございます。

「ナップザック問題解答マクロ」の利用方法が理解できました。

少し試して上手く組み合わせが出来ているようです。

以下参考画像
https://imgur.com/DxMc6dh

利便性から考えると
(VBA) 部分集合和問題 (2)で試したコードのほうが視覚的に分かりやすいので
昨日のコードと袋詰問題()のコードを合わせて利用したいと思います。

今回もお世話になりありがとうございます。

回答No.3

kkkkkm

部分集合和問題は完全一致するかどうか判定するものだと思いますので結果

> 組み合わせが目標値と同じ値になる場合しか結果が表示されません。

だと思います。

また、改変して超過しない近似値を出せたとしても、もとのデータで既に選択されたものは削除しなければいけないのではないでしょうか。同じものが以降の選択結果の中に入っていますから。

> ナップサック問題とは、n 種類の品物（各々、価値 vi、重量 wi）が与えられたとき

回答にも書きましたが、価値を全て同じ値(たとえば「1」)にすれば重量だけで計算するのと同じになると思います。

> 「ナップザック問題解答用Excelマクロ」は、使い方が記載されていないので
> 　利用方法が判りません。

ダウンロードしたZIP内の
ReadMe.txt
に簡単な説明があります。

補足

何度もありがとうございます。

>改変して超過しない近似値を出せたとしても、もとのデータで既に選択されたものは削除しなければいけないのではないでしょうか。
>同じものが以降の選択結果の中に入っていますから。

一番近い近似値を出せれば、そこで計算がそこで終了しても実用上は問題有りません。
（一番近いが、最初に計算されるかどうかは不明なら鶏が先、卵が先の問題になりますが。。。。）

意味が不明なのですが、
　組み合わせの中で一度利用したデーターを削除する必要は無いと思いますが　？
　結果を求める仕組み（アルゴリズム）で、一度利用したデーターは除かないとだめな場合はあきらめます。

>価値を全て同じ値(たとえば「1」)にすれば重量だけで計算するのと同じになると思います。

全て「1」にすると、重量だけの計算になるんですね。

他の方法をもう少し探してみますが、
面倒でも、ファイル数が増減するたびに
　データ分だけセル構造を調整する必要があり手間が掛かかるので
　こちらは正直避けたいです。

>ダウンロードしたZIP内のReadMe.txtに簡単な説明があります。

確かに、以下の説明があり「使い方が記載されていない」は、正確ではなく誤りです。
このテキストファイルは、見ましたが残念ながら私が見て理解できないのです。

前にも記載しましたが、「ナップザック問題」は条件が、複雑です。
つまり、「ナップザック問題解答用Excelマクロ」は、
　　価格、容積、重量、個数と要素が4つも有り
　　求める指定も最大容量、最大総額、最大重量と３つを指定するようになっています。
　　（私の場合、要素はファイルサイズだけで指定値も一つだけです。）

使い方
　マクロの記述されているブック『ナップザック問題解答マクロ.xls』を開くと『ナップザック問題』というワークシートが表示されます。
　最初から例を示すために値が入っていますが、御自分の用途に合わせて数値を自由に変えてください
　もし、商品の数が足りないと感じたら、『knapsack』マクロの『Const N = 5 ' データの数』とある列を自分の目的とするデータの数に書き直してください。
----------------

回答No.2

kkkkkm

あと
ナップザック問題解答用Excelマクロ
https://www.vector.co.jp/soft/data/edu/se504980.html
これを改変して利用できるかもしれせん。

ただ、PCのデータサイスで実サイズとディスク利用サイズの差があるように、BDの方でそのような事がないのでしょうかという気もします。

回答No.1

kkkkkm

ナップサック問題をEXCELワークシート関数で解く
https://www.yomogi2017.xyz/entry/2019/01/08/123558
この表を利用して価値は全て1として重量をサイズに置き換えて解決できないでしょうか。

サイトでは15列だけなので25列とか30列まで右の表は伸ばして下方向はデータ分だけ伸ばす必要がありますし、一つ解決するたびにヒットしたデータをメモして削除していくという手間はかかりますが。

補足

回答ありがとうございます。

前日の質問（VBA フォルダー内のファイル名・サイズの書き出し）は、
　本質問をする上での事前処理を行うのに必要な相談でした。

まず、回答にある「ナップザック問題」と言うのが
　さっぱり分からなかったの調べてみました。

　　ナップサック問題とは、n 種類の品物（各々、価値 vi、重量 wi）が与えられたとき、
　　重量の合計が W を超えない範囲で品物のいくつかをナップサックに入れて、
　　その入れた品物の価値の合計を最大化するには入れる品物の組み合わせを選び出す問題のようです。

提示頂いた「ナップザック問題」は条件が、複雑ですし
　「ナップサック問題をEXCELワークシート関数で解く」は、
　kkkkkmさんも述べられているようにファイル数が増減するたびに
　データ分だけセル構造を調整する必要があり手間が掛かります。

　又、「ナップザック問題解答用Excelマクロ」は、使い方が記載されていないので
　利用方法が判りません。
　（改変まで進みません。）
-------------------------------------------

私には、コードが長く、複雑で判らないのですが
　「kent201.zip」でのコード中のどこかで
　　＝　を　＞＝（又は、＜＝）に書き換えれば良さそうな気がするのですがどうでしょうか　？