タイトル : サンプル 投稿日 : 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 |