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

タイトル ： サンプル1改
投稿日： 2023/02/18(Sat) 10:10
投稿者： 魔界の仮面弁士
> 手元に VB2010 が無いので、
> 「VB2022 + .NET Framework 4」のコンソールアプリで作りました。

No12102 のコードを、ローカル関数を使わないバージョンへと書き換えてみました。
処理の流れを追うのであれば、こちらの方がデバッグしやすいでしょう。


環境依存度を減らすため、今回は VB2005 でもコンパイルが通る文法で書いてみました。
(VB.NET 2002/2003 では動きません)

VB2022 + .NET Framework 2.0 での動作検証しかしていないですけれどね。


Option Strict On

Public Class Node
    Inherits List(Of Node)
    Public Value As Integer    '選択された[値]
    Public Parent As Node      'ひとつ前に選択した[値]
    Public Total As Integer    '祖先からここまでの[値]の合計
    Public Sub New(Parent As Node, Value As Integer)
        Me.Value = Value
        Me.Parent = Parent
        If Parent Is Nothing Then
            Total = Value
        Else
            Total = Value + Parent.Total
        End If
    End Sub
End Class

Module Module1
    Sub Main()
        'No12097 の設問
        Dim 値一覧1() As Integer = New Integer() {60, 57, 54, 45, 42, 500, 1000, 60, 25, 57}

        'No.12091 の設問
        Dim 値一覧2() As Integer = New Integer() {5988, 2994, 1245, 3296, 19777, 1497, 14823, 13177, 37885, 5988, 6290, 6038, 22653, 28474, 29564, 26871, 23844, 4366, 4101, 14116, 7037, 17500, 24062, 23644, 17717, 25162, 9461, 19788, 29762, 25099, 28935, 1011, 4655, 22234, 9589, 30377, 10081, 2887, 24336, 3517, 16020, 6494, 16745, 24100, 28340, 24825, 13382, 6801, 19893, 28700}


        '『設定値：590　合計値：587　詳細値：42, 45, 500』
        探索(590, 値一覧1)

        '『設定値：586　合計値：585　詳細値：25, 60, 500』
        探索(586, 値一覧1)

        '『設定値：88792　合計値：88792　詳細値：1011, 1245, 1497, 2887, 2994, 3296, 3517, 4101, 4366, 4655, 6290, 6494, 14116, 14823, 17500』
        探索(88792, 値一覧2)

        Console.ReadKey()
    End Sub

    Sub 探索(設定値 As Integer, 寸法一覧 As Integer())
        Console.Write("設定値：{0}　", 設定値)
        Dim 結果() As Integer = New Integer() {}
        For 設定値 = 設定値 To 設定値 - 20 Step -1
            結果 = FindCombination(設定値, 寸法一覧)
            If 結果.Length > 0 Then Exit For
        Next
        If 結果.Length = 0 Then
            Console.WriteLine("抽出できませんでした。")
        Else
            Dim 合計値 As Integer = Sum(結果)
            Console.Write("合計値：{0}　詳細値：{1}", 合計値, 結果(0))
            For n = 1 To UBound(結果)
                Console.Write(", {0}", 結果(n))
            Next
            Console.WriteLine()
        End If
    End Sub

    Private Function Sum(values() As Integer) As Integer
        Dim total As Integer = 0
        For Each value As Integer In values
            total += value
        Next
        Return total
    End Function

    ''' <summary>探索処理</summary>
    ''' <param name="edge">発見した組み合わせ</param>
    ''' <param name="targetValue">目標値</param>
    ''' <param name="ordered">昇順に並んだ値の一覧</param>
    ''' <param name="index">分岐位置…0 以上 UBound(ordered) 以下</param>
    ''' <param name="parent">ここまでの分岐情報</param>
    Private Sub Search(ByRef edge As Node, targetValue As Integer, ordered() As Integer, index As Integer, parent As Node)
        If Not edge Is Nothing Then Return  '既に最終結果を発見済みなので、もう探索しない
        For i As Integer = index To UBound(ordered)
            Dim nextValue As Integer = ordered(i)
            Dim nextNode As New Node(parent, nextValue)
            If nextNode.Total > targetValue Then
                Return '合計値が目標値を超えたので、この分岐はここで打ち切り
            Else
                parent.Add(nextNode)    '合計値以下なので、分岐を追加
                If nextNode.Total = targetValue Then
                    edge = nextNode     '目標値に達したので、最終結果を edge に渡して終了
                    Return
                End If
            End If
            '再帰して次の組み合わせを選ぶ
            Search(edge, targetValue, ordered, i + 1, nextNode)
        Next
    End Sub

    ''' <summary>合計値が完全一致する組み合わせを探す</summary>
    ''' <param name="targetValue">設定値</param>
    ''' <param name="values">値リスト</param>
    ''' <returns>最初に見つけたものを一つだけ返す</returns>
    Public Function FindCombination(targetValue As Integer, ParamArray values() As Integer) As Integer()
        If values Is Nothing OrElse values.Length = 0 Then Throw New ArgumentNullException("values")
        For Each v As Integer In values
            If v <= 0 Then Throw New ArgumentOutOfRangeException("values", "自然数が必要です。")
        Next

        '[値]の昇順に並べる
        Dim ordered() As Integer = CType(values.Clone(), Integer())
        Array.Sort(ordered)
        '設定値を超えるものは除外
        For n As Integer = 0 To UBound(ordered)
            If ordered(n) > targetValue Then
                ReDim Preserve ordered(n - 1)
            End If
        Next

        '探索処理
        Dim maxIndex As Integer = UBound(ordered)
        Dim edge As Node = Nothing  '発見した組み合わせ

        '探索実行
        Dim root As New Node(Nothing, 0)
        Search(edge, targetValue, ordered, 0, root) 'これが処理の本体
        'root は、抽出した分岐の組み合わせが入っており
        'edge には、合計値が合致したその分岐の末端部が入っている

        '分岐の末端である edge を親方向に辿って、抽出結果として返す
        If edge Is Nothing Then
            '見つからなかった
            Return New Integer(-1) {}
        Else
            Dim result As New List(Of Integer)()
            Dim n As Node = edge
            Do
                result.Insert(0, n.Value)
                n = n.Parent
            Loop Until n Is root
            Return result.ToArray()
        End If
    End Function
End Module
- 関連一覧ツリー （ をクリックするとツリー全体を一括表示します）

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