[ツリー表示へ] [ワード検索] [Home]
タイトル ： Re^10: 組み合わせ合計検索 つづき 投稿日 ： 2023/08/29(Tue) 21:15 投稿者 ： たけし
| お世話になります。 結果が以下のように詳細値が15個あります。 これを10個以下で詳細値を求めたいと思っています。 『設定値：1230 詳細値：36, 40, 45, 51, 55, 65, 69, 76, 82, 98, 106, 108, 115, 119, 165』 --------------------------------------------------------------------------------------------------- Dim 値一覧3 As Integer() = {36, 40, 45, 51, 55, 65, 69, 76, 82, 98, 106, 108, 115, 116, 118, 119, 123, 129, 133, 139, 148, 159, 163, 165, 184, 186} 探索(1230, 値一覧3) --------------------------------------------------------------------------------------------------- Public Sub 探索(ByVal 設定値 As Integer, ByVal 寸法一覧 As Integer(), ByVal kyoyouti 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("抽出できませんでした。") MsgBox("抽出できませんでした。") Else 'Console.WriteLine("合計値：{0} 詳細値：{1}", 結果.Sum(), String.Join(", ", 結果.Select(Function(寸法) CStr(寸法)))) ★ MsgBox("合計値：" & 結果.Sum() & " 詳細値：" & String.Join(", ", 結果.Select(Function(寸法) CStr(寸法)))) End If End Sub ------------------------------------------------------------------- 以下のように変更した場合 msgbox の値は以下のようになります。 一回目:8 二回目:15 三回目（★）:『設定値：1230 詳細値：36, 40, 45, 51, 55, 65, 69, 76, 82, 98, 106, 108, 115, 119, 165』 一回目:8の時に 以下のように表示させるにはどうすればよかったでしょうか。 （★）:『設定値：1230 詳細値： ''' <summary>合計値が完全一致する組み合わせを探す</summary> ''' <param name="targetValue">設定値</param> ''' <param name="values">値リスト</param> ''' <returns>最初に見つけたものを一つだけ返す</returns> Public Function FindCombination(ByVal targetValue As Integer, ByVal 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) Dim a As Integer = 0 If Not edge Is Nothing Then Return '既に発見済み For i = index To maxIndex Dim nextValue = ordered(i) '値を昇順に抽出 Dim nextNode As New Node(parent, nextValue) a = a + 1 If nextNode.Total <= targetValue Then parent.Add(nextNode) '超過しないなら抽出 If nextNode.Total = targetValue Then ' edge = nextNode '目標値に達したので探索終了 If a < 10 Then MsgBox(a) edge = nextNode '目標値に達したので探索終了 Return Else Search(i + 1, nextNode) '再帰して次の組み合わせを選ぶ End If 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 |
をクリックするとツリー全体を一括表示します） - 組み合わせ合計検索 つづき - たけし 23/08/11-06:34No.12125