タイトル : サンプル2改 投稿日 : 2023/02/13(Mon) 13:51 投稿者 : 魔界の仮面弁士
> ただし今回のコードは、 No12091 の「最も近い組み合わせを獲得したい」を優先しており、 > 「最小値を超えたけれど、もっと最大値に近い組み合わせがある」場合、必ずしも列挙されません。 > そのため、すべての組み合わせが得られるわけではありません。 > (それでも一応、当初の目的には合致しているはず…) > > Dim 値一覧 = {1, 2, 3, 4, 5} > result = FindCombinations(1, 5, 値一覧) '1 以上 5 以下の組み合わせ 最小値以上、最大値以下となる「すべての組み合わせ」を返すように変更したもの。 ''' <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)()))() For total = minValue To maxValue edges.Add(total, New List(Of Tuple(Of Integer, Integer)())) Next 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) '超過しないなら抽出 If minValue <= nextNode.Total Then '最低値条件をクリアした終端を登録 edges(nextNode.Total).Add(GetValueArray(nextNode)) End If Search(i + 1, nextNode) '再帰して次の組み合わせを選ぶ End If Next End Sub '探索実行 Search(0, root) Return edges End Function |