tagCANDY CGI VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
VBレスキュー(花ちゃん) の Visual Basic 2010 用 掲示板(VB.NET 掲示板)
[ツリー表示へ]  [ワード検索]  [Home]

タイトル サンプル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

- 関連一覧ツリー をクリックするとツリー全体を一括表示します)

古いスレッドにレスはつけられません。