Dropbox Paper

VBA VBAノック番外編その２

VBAで「3Lと5Lのバケツで4Lの水を作る」を解く｜エクセル雑感 • excel-ubara.com

思いつくアルゴリズムのままにつくってみました。途中での枝刈り条件も「同一のパターンがある」以外は考慮せず試さなくて良さそうなパターンも試してしまっています。もっと最適化したよい書き方ができる部分が多々あると思いますが。

基本的なロジックは６種類のアクションをひたすら積み上げていくというやり方です。技法的にはアクションを経路スタックに保存＋再帰ループとなります。

コードが長くなってしまったのでドロップボックスペーパにて投稿します。

Option Explicit

Const ACT_NOP = 0 '初期状態

Const ACT_A_FILL = 1 'Aを一杯にする

Const ACT_A_EMPTY = 2 'Aを空にする

Const ACT_A_POURB = 3 'AをBに注ぐ

Const ACT_B_FILL = 4 'Bを一杯にする

Const ACT_B_EMPTY = 5 'Bを空にする

Const ACT_B_POURA = 6 'BをAに注ぐ

Dim action_name 'アクション名辞書

Dim action_path         'アクションパススタック（今までのアクションとABの容量をセットで保管

Dim Abucket_size 'バケツAの容量

Dim Bbucket_size 'バケツBの容量

Dim target_little '見つけたい容量

Dim result '結果配列（見つけた手順のうち最も手順の短いもの）

Dim min_depth '最小手順

Sub vba100_102_main()

Call vba100_102_driver(tk_rand_between(3, 10), tk_rand_between(3, 10), tk_rand_between(4, 9))

'Call vba100_102_driver(3, 5, 4)

End Sub

Sub vba100_102_driver(a_Abucket_size, a_Bbucket_size, a_target_little)

'モジュール変数の設定

Abucket_size = a_Abucket_size

Bbucket_size = a_Bbucket_size

target_little = a_target_little

result = Array()

min_depth = (2 ^ 15) - 1

    Debug.Print tk_tmpl("バケツA容量={} バケツB容量={} 目的リットル={}", Abucket_size, Bbucket_size, target_little)

'手順辞書の設定

Dim ano, aname

ano = Array(ACT_NOP, ACT_A_FILL, ACT_A_EMPTY, ACT_A_POURB, ACT_B_FILL, ACT_B_EMPTY, ACT_B_POURA)

aname = Split("初期設定Ａを一杯Ａを空にＡをＢにＢを一杯Ｂを空にＢをＡに")

Set action_name = tk_dict(tk_zip(ano, aname))