[ツリー表示へ] [ワード検索] [Home]
タイトル ： サンプル 投稿日 ： 2023/02/12(Sun) 10:52 投稿者 ： 魔界の仮面弁士
| > Windows10 > vb.net 2010使用しています。 手元に VB2010 が無いので、 「VB2022 + .NET Framework 4」のコンソールアプリで作りました。 VB2010 当時の文法仕様だけで書いたつもりですが、 コンパイル エラーが出るようならご指摘ください。 →追記：VB2010 での動作を確認しました。(VB2008 では動きません) ・基本的なアルゴリズムは、最初の質問にあった Excel VBA 版の「木構造と枝刈りロジック」と同じです。 https://blog-imgs-67-origin.fc2.com/h/a/t/hatenachips/VBASearchSumAlgo.png VBA 版では、ソート処理部を自作(クイックソート)していましたが、こちらは LINQ で処理しています。 ・参考 URL (Excel VBA 版)では、合致する組み合わせを複数列挙していましたが、 今回のコードは「合致する組み合わせを一つ見つけたら、そこで探索終了」としています。 ・合致しない場合はより近い値を求める…というルールだったので、発見できない時は 設定値を 1 ずつ減らして、再度探索しなおすという方式を採っています。 ・No12091 の設問と No12093 の「最大桁数は4桁になります。最小桁数は2桁です。」の要件が 矛盾するため、値リストの条件として No12095 の「自然数のみです。」を採用しています。 ・[番号]は無視して、[寸法]の組み合わせのみを管理しています。そのため、 No12097 にて『詳細値：60, 500, 25』という結果が例示されていましたが、このコードでは 昇順に並んだ『詳細値：25, 60, 500』という結果で出力されます。 '------------- Option Strict On Public Class Node Inherits List(Of Node) Public ReadOnly Value As Integer '選択された[値] Public ReadOnly Parent As Node 'ひとつ前に選択した[値] Public ReadOnly Total As Integer '祖先からここまでの[値]の合計 Public Sub New(Parent As Node, Value As Integer) Me.Value = Value Me.Parent = Parent Total = Value + If(Parent Is Nothing, 0, Parent.Total) End Sub End Class Module Module1 Sub Main() 'No12097 の設問 Dim 値一覧1 As Integer() = {60, 57, 54, 45, 42, 500, 1000, 60, 25, 57} 'No.12091 の設問 Dim 値一覧2 As 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() = {} For 設定値 = 設定値 To 設定値 - 20 Step -1 結果 = FindCombination(設定値, 寸法一覧) If 結果.Length > 0 Then Exit For Next If 結果.Length = 0 Then Console.WriteLine("抽出できませんでした。") Else Console.WriteLine("合計値：{0} 詳細値：{1}", 結果.Sum(), String.Join(", ", 結果.Select(Function(寸法) CStr(寸法)))) End If 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") 'If values.Any(Function(v) v < 10 OrElse v > 9999) Then Throw New ArgumentOutOfRangeException("values", "2〜4桁の自然数が必要です。") If values.Any(Function(v) v <= 0) Then Throw New ArgumentOutOfRangeException("values", "自然数が必要です。") '設定値を超えるものは除外した上で、[値]の昇順に並べる Dim ordered As Integer() = (From v In values Where v <= targetValue Order By v).ToArray() '探索処理 Dim maxIndex = ordered.GetUpperBound(0) Dim edge As Node = Nothing '発見した組み合わせ Dim Search As Action(Of Integer, Node) = Sub(index, parent) If Not edge Is Nothing Then Return '既に発見済み For i = index To maxIndex Dim nextValue = ordered(i) '値を昇順に抽出 Dim nextNode As New Node(parent, nextValue) If nextNode.Total <= targetValue Then parent.Add(nextNode) '超過しないなら抽出 If nextNode.Total = targetValue Then edge = nextNode '目標値に達したので探索終了 Return Else Search(i + 1, nextNode) '再帰して次の組み合わせを選ぶ End If End If Next End Sub '探索実行 Dim root As New Node(Nothing, 0) Search(0, root) If edge Is Nothing Then '見つからなかった Return New Integer(-1) {} Else Dim result As New Stack(Of Integer)() Dim e = edge Do result.Push(e.Value) e = e.Parent Loop Until e Is root Return result.ToArray() End If End Function End Module |
をクリックするとツリー全体を一括表示します） - 組み合わせ合計探索 - たけし 23/02/07-20:51No.12091