グループから一番の組み合わせを選択するアルゴリズム

質問

お世話になります。
標題のプログラムを組みたいと思ってます。
一定の条件でグループ化された２次元配列を持っています。
Group()()このうち、２次元目のグループの要素数はまちまちです。

それぞれのグループ毎に２個以上の全ての加算組み合わせを算出し、ある閾値の中に収まり、一番上限の閾値に近い値を算出したいと思ってます。

例えば、グループの要素数が４個の場合。
要素をA、B、C、Dとする
２個以上を加算する全てのパターンを計算する
A+B+C+D、A+B+C、A+B+D、A+C+D、B+C+D、A+B、A+C、A+D、B+C、B+D、C+D
上記の計算結果のうち、２つの閾値50と100だとしたら、100以下で一番100に近い値を算出する。その値の要素も参照できるようにしたいです。

言語はVisualBasicとしていますが、他の言語でもアルゴリズムがわかれば大丈夫です。
すみませんが、ご教授お願いいたします。

回答No.3

HohoPapa

回帰処理を使うコードを考えてみました。
こんな感じでいかがでしょうか？
なお、複数ヒットした場合は、それぞれを取得するようにしてみました。

Option Explicit

Const MaxCols = 6　　　'要素数
Const ShikiiMin = 50　 '閾値Min
Const ShikiiMax = 100　'閾値Max
Dim Arrays(MaxCols) As Long
Dim HitSumArrays As Long

Sub Sample()
　Arrays(1) = 23
　Arrays(2) = 29
　Arrays(3) = 31
　Arrays(4) = 37
　Arrays(5) = 98
　Arrays(6) = 43
　HitSumArrays = ShikiiMin
　MyCount 0, 0, ""
End Sub

Sub MyCount(num As Long, SumArrays As Long, Keys)
　Dim Couner As Long

　If ((SumArrays <= ShikiiMax) And (SumArrays >= HitSumArrays)) Then
　　If Len(Keys) > 1 Then
　　　HitSumArrays = SumArrays
　　　Debug.Print Format(HitSumArrays, "0") & " / " & Keys
　　End If
　End If

　For Couner = num + 1 To MaxCols
　　MyCount Couner, SumArrays + Arrays(Couner), Keys & Couner
　Next
End Sub

回答No.2

HohoPapa

回帰処理を使わないコードを考えてみました。
こんな感じでいかがでしょうか？
なお、複数ヒットした場合は、それぞれを取得するようにしてみました。

Option Explicit

Sub Sample()

　Const MaxCols = 6　　　'要素数
　Const ShikiiMin = 50　 '閾値Min
　Const ShikiiMax = 100　'閾値Max

　Dim nBool(MaxCols) As Boolean
　Dim PrtRec As String
　Dim wkCounter As Long
　Dim Cols As Long
　Dim SumArrays As Long
　Dim Arrays(MaxCols) As Long
　Dim HitSumArrays As Long

　Arrays(1) = 23
　Arrays(2) = 29
　Arrays(3) = 31
　Arrays(4) = 37
　Arrays(5) = 98
　Arrays(6) = 43
　HitSumArrays = ShikiiMin

　For wkCounter = 1 To MaxCols
　　nBool(wkCounter) = False
　Next wkCounter

　Do

　　PrtRec = ""
　　Cols = 0
　　SumArrays = 0

　　Do
　　　For wkCounter = 1 To MaxCols
　　　　If nBool(wkCounter) = False Then
　　　　　nBool(wkCounter) = True
　　　　　Exit Do
　　　　Else
　　　　　nBool(wkCounter) = False
　　　　End If
　　　Next wkCounter
　　Loop

　　For wkCounter = 1 To MaxCols
　　　If nBool(wkCounter) = True Then
　　　　SumArrays = SumArrays + Arrays(wkCounter)
　　　　Cols = Cols + 1
　　　　PrtRec = PrtRec & "1"
　　　Else
　　　　PrtRec = PrtRec & "0"
　　　End If
　　Next wkCounter

　　If ((SumArrays >= HitSumArrays) And _
　　　(SumArrays <= ShikiiMax) And (Cols > 1)) Then
　　　HitSumArrays = SumArrays
　　　Debug.Print _
　　　　　Format(Cols, "0") & "　/　" & _
　　　　　PrtRec & "　/　" & _
　　　　　Format(SumArrays, "0")
　　End If
'　 Debug.Print _
　　　　Format(Cols, "0") & "　/　" & _
　　　　PrtRec & "　/　" & _
　　　　Format(SumArrays, "0")

　　If Cols = MaxCols Then Exit Do

　Loop

End Sub

回答No.1

imogasi

下記をやってみてください。
その続きは質問者がやってください。詳細がわからないのと、本質問は丸投げで、回答に手間がかかりすぎる。
下記処理系は、エクセルVBAです。エクセルシートSheet1とSheet3の２つを
使います。
標準モジュールに下記をコピペして実行。

Const nStr As String = "あいうえおかきく" '←ｎ個の文字列　今回は　8
Dim m As Integer '←取り出す個数-->4,3,2文字と変化させる　
Dim n As Integer '文字の文字数 --> 今回は　8
Dim rStr As String
Dim mRow As Integer
Dim Nest As Integer
'-------------Sheet1のデータをClearして, combi2実行すること----------
Sub combi2()
n = Len(nStr) '文字の文字数 今回は　8
'------取り出す文字の個数を変化させて実行
For m = 4 To 2 Step -1
If m > n Then Exit Sub
rStr = String(m, " ") '空白文字m回繰り返し
'Cells.ClearContents
mRow = 0
Nest = 0
combiPr (0)
Next m
End Sub
Sub combi2()
n = Len(nStr) '文字の文字数 今回は　8
'------取り出す文字の個数を変化させて実行
For m = 4 To 2 Step -1
If m > n Then Exit Sub
rStr = String(m, " ") '空白文字m回繰り返し
'Cells.ClearContents
mRow = 0
Nest = 0
combiPr (0)
Next m
End Sub
'-----------------------
Sub combiPr(n1)
Dim mCol As Integer
For nn = n1 + 1 To n - m + Nest + 1
Nest = Nest + 1
Mid(rStr, Nest, 1) = Mid(nStr, nn, 1)
If Nest = m Then
mRow = Range("A100000").End(xlUp).Row + 1
'mRow = mRow + 1
For mCol = 1 To m
Cells(mRow, mCol).Value = Mid(rStr, mCol, 1)
Next
Else
Call combiPr(nn) '再帰処理
End If
Nest = Nest - 1
Next
End Sub
=================================
結果はSheet１に
あ い う え
あ い う お
あ い う か
あ い う き
あ い う く
あ い え お
以下中間は略
え き
え く
お か
お き
お く
か き
か く
き く
＝＝＝
これらに対し、各々の記号に対応する属性数値に置換する。
Sheet1をSheet3にコピペしておいて、
下記を実行。
その実行の前に、下記の　t = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9)　の部分を
対応する実際の数値に置き換えて、修正してください。
'----記号文字から値に置換
'-----Sheet1をSheet3などにコピーしておき、Sheet3をActiveにしておいて実行
Sub test01()
'---'対応する要素同士で置換 s-->t
s = Array("", "あ", "い", "う", "え", "お", "か", "き", "く", "け")
t = Array(0, 1, 2, 3, 4, 5, 6, 7, 8, 9) '<----実際は対応する計数の
'リストに修正のこと
'---
With Range("A1:F10000") '<--実際では、セル範囲に注意
For i = 1 To UBound(s)
.Replace What:=s(i), Replacement:=t(i), LookAt:=xlPart
Next i
End With
End Sub
実行するとSheet3は
A-E列
1 2 3 4 10
1 2 3 5 11
1 2 3 6 12
1 2 3 7 13
1 2 3 8 14
1 2 4 5 12
1 2 4 6 13
1 2 4 7 14
1 2 4 8 15
1 2 5 6 14
1 2 5 7 15
1 2 5 8 16
1 2 6 7 16
以下中間は省略。
4 5 - - 9
4 6 - - 10
4 7 - - 11
4 8 - - 12
5 6 - - 11
5 7 - - 12
5 8 - - 13
6 7 - - 13
6 8 - - 14
7 8 - - 15

E列は、=SUM(A1:D1)の関数式が入っていて、（横方向の合計をだし）下方向に式を複写してます。
＝＝＝
このE列の数字について、質問者は、質問にあるところの、
>「ある閾値の中に収まり、一番上限の閾値に近い値を算出したいと思ってます。」
をプログラムを組んで、求めてください。
小生には、内容を、十分理解できなかったから。
＝＝＝＝
組み合わせを求めるロジックとしては、有名な
（１）再帰（Recursive）を使わない　
（２）再帰処理を使う
本件は（２）の方です。
コード数はこのため少なくなります。
＝＝＝－
質問者に聞きたい。
数値データは、マイナスの値は混じらないのか？
１文字のケースを除外する意図がわからない。
この辺質問に明記すべきだろう。
ーーー
数的には８個のうちから２，３，４個を採って、組あわせる
8 2 28 =COMBIN(A1,B1)　＜－－エクセルの関数
8 3 56 =COMBIN(A2,B2)
8 4 70 =COMBIN(A3,B3)
の合計１５４行が、Sheet3のシートに出てくる。数はエクセル関数で簡単にわかるが、具体的に組み合わせを出すのは、面倒だ。
ーー
質問者はプログラム経験もあるようだが、WEBでも調べて.何かやってみたのかな。上記のネタは前半は、https://oshiete.goo.ne.jp/qa/3063237.htmlです
ーー
質問では、仕事がばれるのを嫌がるせいか、具体例を挙げるのは避けている。
「詰め込み問題」か何かか」？

補足

ご回答ありがとうございますm(_ _)m
曖昧な質問になってしまい、申し訳ありません。
数値データに関しましては、マイナスは入りません。
閾値は例えば50と100を設定し、組み合わせ結果がその数値内に収まる組み合わせを探すということをやりたかったです。また、その閾値は変えることも想定していました。
一文字を除いたことに関しましては、組み合わせではないため、別の処理としました。
ご回答いただきましたように組み合わせ数を求めるところまではできたのですが、実際にそのパターンを網羅して、計算するのを要素数が固定であれば考えられましたが、可変となるとどうやるのだろうと思っていました。
再帰処理を学ばないといけなかったのですね。
調べてく中でナップサック問題かともおもったのですが、特に評価を気にする必要がなく、1つの数値の加算のみなので、もっと簡単にできないのかな？と思い質問させていただきました。
まずはいただいた回答を検証してみたいと思います。
ありがとうございました。