[ツリー表示へ] [ワード検索] [Home]
タイトル ： サンプル2 投稿日 ： 2023/02/12(Sun) 12:54 投稿者 ： 魔界の仮面弁士
| > ・参考 URL (Excel VBA 版)では、合致する組み合わせを複数列挙していましたが、 > 今回のコードは「合致する組み合わせを一つ見つけたら、そこで探索終了」としています。 先程の Function FindCombination は「最初に見つけたもの」を返す実装でしたが 今度の Function FindCombinations は、「条件に合致したものすべて」を 位置情報も含めて列挙するようにしてあります。(最小値と最大値を指定する仕様に変更) > ・[番号]は無視して、[寸法]の組み合わせのみを管理しています。そのため、 > No12097 にて『詳細値：60, 500, 25』という結果が例示されていましたが、このコードでは > 昇順に並んだ『詳細値：25, 60, 500』という結果で出力されます。 条件に合致したもの組み合わせに対して、位置番号も併せて得られるようにしてみました。 これにより、重複値をもつ一覧であっても、どちらが選択されたのか分かるようになっています。 たとえば、585 という値を 60+500+25 の組み合わせを作成した場合に、 詳細値：[0]=60, [5]=500, [8]=25 詳細値：[5]=500, [7]=60, [8]=25 のように、位置番号の異なる重複値だった場合、それらは異なる組み合わせとして扱われます。 ※各組み合わせは、位置番号順にて返されます。 ただし、複数の組み合わせを列挙するようになったため、アイテム数が多くなると、 列挙が開始されるまでに長い時間がかかってしまいます。 管理情報が増えたため、コードとしては少し複雑に見えるかも知れませんが、 探索ロジックは先の No12102 のサンプルと同一です。 そのため、このコードを読み解くのであれば、 先に No12102 の手順を把握してからの方が良いと思います。 ただし今回のコードは、 No12091 の「最も近い組み合わせを獲得したい」を優先しており、 「最小値を超えたけれど、もっと最大値に近い組み合わせがある」場合、必ずしも列挙されません。 そのため、すべての組み合わせが得られるわけではありません。 （それでも一応、当初の目的には合致しているはず…） Dim 値一覧 = {1, 2, 3, 4, 5} result = FindCombinations(1, 5, 値一覧) '1 以上 5 以下の組み合わせ 上記の場合、 5 = 1+4, 2+3, 5 4 = 1+3, 4 3 = 1+2, 3 が列挙されますが、下記の組み合わせは取りこぼされます。 2 = 2 → 2+3 にすれば、最大値により近くなるため 1 = 1 → 1+4 にすれば、最大値により近くなるため ------ 寸法一覧：10個 [0]=60 [1]=57 [2]=54 [3]=45 [4]=42 [5]=500 [6]=1000 [7]=60 [8]=25 [9]=57 設定値：570〜590 合計値：587 組み合わせ：1件 詳細値：[3]=45, [4]=42, [5]=500 合計値：585 組み合わせ：2件 詳細値：[0]=60, [5]=500, [8]=25 詳細値：[5]=500, [7]=60, [8]=25 合計値：582 組み合わせ：2件 詳細値：[1]=57, [5]=500, [8]=25 詳細値：[5]=500, [8]=25, [9]=57 合計値：579 組み合わせ：1件 詳細値：[2]=54, [5]=500, [8]=25 合計値：570 組み合わせ：1件 詳細値：[3]=45, [5]=500, [8]=25 '------------- Option Strict On Public Class Node Inherits List(Of Node) Public ReadOnly Value As Tuple(Of Integer, Integer) '選択された[位置番号]と[値] Public ReadOnly Parent As Node 'ひとつ前に選択した[値] Public ReadOnly Total As Integer '祖先からここまでの[値]の合計 Public Sub New(Parent As Node, Index As Integer, Value As Integer) Me.Value = Tuple.Create(Index, Value) Me.Parent = Parent Total = Value + If(Parent Is Nothing, 0, Parent.Total) End Sub End Class Module Module1 Sub Main() 'No12097 の設問 Dim 値一覧 As Integer() = {60, 57, 54, 45, 42, 500, 1000, 60, 25, 57} 複数探索(570, 590, 値一覧) Console.ReadKey() End Sub Sub 複数探索(最小設定値 As Integer, 最大設定値 As Integer, 寸法一覧 As Integer()) Console.WriteLine("寸法一覧：{0}個", 寸法一覧.Length) For i = 0 To 寸法一覧.Length - 1 Console.WriteLine(" [{0}]={1}", i, 寸法一覧(i)) Next Console.WriteLine() Console.WriteLine("設定値：{0}〜{1}", 最小設定値, 最大設定値) Dim 結果 = FindCombinations(最小設定値, 最大設定値, 寸法一覧) If 結果.Count = 0 Then Console.WriteLine("抽出できませんでした。") Else For Each result In 結果.OrderByDescending(Function(x) x.Key) Console.WriteLine(" 合計値：{0} 組み合わせ：{1}件", result.Key, result.Value.Count) For Each values In result.Value Console.WriteLine(" 詳細値：" & String.Join(", ", values.OrderBy(Function(x) x.Item1).Select(Function(v) String.Format("[{0}]={1}", v.Item1, v.Item2)))) Next Next End If End Sub ''' <summary>合計値が範囲内となる組み合わせを列挙する</summary> ''' <param name="minValue">探索したい合計値の下限</param> ''' <param name="maxValue">探索したい合計値の上限</param> ''' <param name="values">「Key = 合計値, Value = (Index, 値)の組み合わせ」の一覧</param> Public Function FindCombinations(minValue As Integer, maxValue As Integer, ParamArray values As Integer()) As SortedDictionary(Of Integer, List(Of Tuple(Of Integer, Integer)())) If minValue > maxValue Then Throw New ArgumentOutOfRangeException("minValue", minValue, "minValue は maxValue 以下である必要があります。") If values Is Nothing OrElse values.Length = 0 Then Throw New ArgumentNullException("values") If values.Any(Function(v) v <= 0) Then Throw New ArgumentOutOfRangeException("values", "自然数が必要です。") '設定値を超えるものは除外した上で、[値]の昇順に並べる Dim ordered = ( From v In values.Select(Function(value, index) New With {Key index, value}) Where v.value <= maxValue Order By v.value, v.index ).ToArray() Dim root As New Node(Nothing, -1, 0) 'Node から値リストを作る Dim GetValueArray As Func(Of Node, Tuple(Of Integer, Integer)()) = Function(node) Dim result As New Stack(Of Tuple(Of Integer, Integer)) Dim item = node Do result.Push(item.Value) item = item.Parent Loop Until item Is root OrElse item Is Nothing Return result.ToArray() End Function '探索処理 Dim maxIndex = ordered.GetUpperBound(0) Dim edges As New SortedDictionary(Of Integer, List(Of Tuple(Of Integer, Integer)()))() Dim Search As Action(Of Integer, Node) = Sub(index, parent) For i = index To maxIndex Dim nextItem = ordered(i) '値を昇順に抽出 Dim nextNode As New Node(parent, nextItem.index, nextItem.value) If nextNode.Total <= maxValue Then parent.Add(nextNode) '超過しないなら抽出 Search(i + 1, nextNode) '再帰して次の組み合わせを選ぶ End If Next If parent.Count = 0 Then If parent.Total >= minValue Then '最低値条件をクリアした終端を登録 Dim lst As List(Of Tuple(Of Integer, Integer)()) = Nothing If Not edges.TryGetValue(parent.Total, lst) Then lst = New List(Of Tuple(Of Integer, Integer)())() edges.Add(parent.Total, lst) End If lst.Add(GetValueArray(parent)) End If End If End Sub '探索実行 Search(0, root) Return edges End Function End Module |
をクリックするとツリー全体を一括表示します） - 組み合わせ合計探索 - たけし 23/02/07-20:51No.12091