| タイトル | ： サンプル3 |
| 記事No | ： 12104 |
| 投稿日 | ： 2023/02/12(Sun) 15:30 |
| 投稿者 | ： 魔界の仮面弁士 |
> ただし、発見したすべての組み合わせを列挙するようにしたため、
> アイテム数が多くなると、列挙が開始されるまでに長い時間がかかるようになっています。
No12103「サンプル2」
No12105「サンプル2改」の実装は、
探索が終了するまで、結果が返されない仕様でした。
そこで応答を早くするため、まだ探索を完全に終えていなくても、
条件を満たす組み合わせをひとつ見つけるごとに、随時通知するようにしてみました。
組み合わせが多いと完了まで時間がかかる点は変わりませんが、
結果を表示し始めるまでの応答開始が早くなるというメリットがあります。
さらに、必要に応じて列挙を中断できるよう、キャンセル処理も可能な仕組みを追加してあります。
VB2010 という制限があるため、Iterator / Yield を利用することはできないので、
代わりにデリゲートで通知する方針にしています。(あるいはイベントで通知する方法にしても良いでしょう)
'------------
Option Strict On
Public Class Node
Inherits List(Of Node)
Public ReadOnly Value As Tuple(Of Integer, Integer) '選択された[位置番号]と[値]
Public ReadOnly Parent As Node 'ひとつ前に選択した[値]
Public ReadOnly Total As Integer '祖先からここまでの[値]の合計
Public Sub New(Parent As Node, Index As Integer, Value As Integer)
Me.Value = Tuple.Create(Index, Value)
Me.Parent = Parent
Total = Value + If(Parent Is Nothing, 0, Parent.Total)
End Sub
End Class
Module Module1
''' <summary>探索された組み合わせの一つを通知するデリゲート。</summary>
''' <param name="cancel">既定値は False。True を渡すと列挙が中断される。</param>
''' <param name="total">組み合わせの合計数。</param>
''' <param name="values">組み合わせの内容。Item1 はインデックス、Item2 が値を示す。</param>
Public Delegate Sub CombinationReceivedDelegate(ByRef cancel As Boolean, total As Integer, values As Tuple(Of Integer, Integer)())
Sub Main()
Dim 値一覧1 As Integer() = {1, 2, 3, 4, 5}
反復探索(1, 15, 値一覧1) '31通りの組み合わせ
'No12097 の設問
Dim 値一覧2 As Integer() = {60, 57, 54, 45, 42, 500, 1000, 60, 25, 57}
反復探索(570, 590, 値一覧2) '7通りの組み合わせ
'No.12091 の設問
Dim 値一覧3 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}
'反復探索(88792, 88792, 値一覧3)
'条件を満たす組み合わせがとても多いので、途中でメモリ不足になると思います…。
Console.ReadKey()
End Sub
Sub 反復探索(最小設定値 As Integer, 最大設定値 As Integer, 寸法一覧 As Integer())
Console.WriteLine("寸法一覧：{0}個", 寸法一覧.Length)
For i = 0 To 寸法一覧.Length - 1
Console.WriteLine(" [{0}]={1}", i, 寸法一覧(i))
Next
Console.WriteLine()
Console.WriteLine("設定値：{0}～{1}", 最小設定値, 最大設定値)
'Dim limit As Integer = 30 '30件で中断する場合
Dim progress As CombinationReceivedDelegate =
Sub(ByRef cancel As Boolean, total As Integer, values As Tuple(Of Integer, Integer)())
'limit -= 1
Console.WriteLine("合計値：{0} 詳細値：{1}", total, String.Join(", ", values.OrderBy(Function(x) x.Item1).Select(Function(v) String.Format("[{0}]={1}", v.Item1, v.Item2))))
'cancel = limit <= 0 '途中で列挙を止めたい場合は True をセットする
End Sub
Dim count As Integer = SearchCombinations(progress, 最小設定値, 最大設定値, 寸法一覧)
If count = 0 Then
Console.WriteLine("抽出できませんでした。")
ElseIf count > 0 Then
Console.WriteLine("総計 {0} 件の組み合わせを抽出しました。", count)
Else
Console.WriteLine("抽出処理が中断されました。{0} 件まで抽出されています。", -count)
End If
Console.WriteLine()
End Sub
''' <summary>合計値が範囲内となる組み合わせを列挙する</summary>
''' <param name="progress">列挙結果を得るためのデリゲート。</param>
''' <param name="minValue">探索したい合計値の下限</param>
''' <param name="maxValue">探索したい合計値の上限</param>
''' <param name="values">値の一覧</param>
''' <returns>列挙完了数。列挙が中断された場合は、そこまでの列挙件数×-1 を返す。</returns>
Public Function SearchCombinations(progress As CombinationReceivedDelegate, minValue As Integer, maxValue As Integer, ParamArray values As Integer()) As Integer
If minValue > maxValue Then Throw New ArgumentOutOfRangeException("minValue", minValue, "minValue は maxValue 以下である必要があります。")
If minValue <= 0 Then Throw New ArgumentOutOfRangeException("minValue", "自然数が必要です。")
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", "自然数が必要です。")
'デリゲートが無ければ列挙しない。
If progress Is Nothing Then Return 0
'設定値を超えるものは除外した上で、[値]の昇順に並べる
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))
If Not node Is root Then
Dim item = node
Do
result.Push(item.Value)
item = item.Parent
Loop Until item Is root OrElse item Is Nothing
End If
Return result.ToArray()
End Function
'探索処理
Dim maxIndex = ordered.GetUpperBound(0)
Dim cancel As Boolean = False
Dim count As Integer = 0
Dim Search As Action(Of Integer, Node) =
Sub(index, parent)
If cancel Then Return
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
'最低値条件をクリアした終端を、順次通知する
progress.Invoke(cancel, nextNode.Total, GetValueArray(nextNode))
count += 1
If cancel Then Return
End If
Search(i + 1, nextNode) '再帰して次の組み合わせを選ぶ
End If
Next
End Sub
'探索実行
Search(0, root)
'列挙件数を返す（キャンセルされたときはマイナス値にする）
Return count * If(cancel, -1, 1)
End Function
End Module
|