VBAHaskellの紹介 その12 （1時間以内に解けなければプログラマ失格がなんたら）
今日、表題の記事が話題になっていた。
1時間以内に解けなければプログラマ失格となってしまう5つの問題が話題に
5問あるうち、最後の「問題5」をVBAHaskellでやってみようと思った。
問題5
1,2,…,9の数字をこの順序で、”+”、”-“、またはななにもせず結果が100となるあらゆる組合せを出力するプログラムを記述せよ。例えば、1 + 2 + 34 – 5 + 67 – 8 + 9 = 100となる
再帰的なプログラムになるし、けっこうややこしいので「ループなし。イミディエイトペインだけで片付ける。」という訳にはいかなかった。ベタな再帰とループを使ったプログラムがこちら。
'数字の列の全ての組み合わせからなる配列の配列を作成
Function Question5_array(ByVal num As String) As Variant
Dim i As Long, nval As Long, substr As String
Dim ret As Variant, recur As Variant, tmpPlus As Variant, tmpMinus As Variant
If Len(num) = 0 Then 'もう文字が残っていない
Question5_array = Array(Array())
Else '文字が残っている
ret = Array()
'先頭i文字と残りの文字に分けて、残りに対して再帰
For i = 1 To Len(num) Step 1
nval = val(Left(num, i)) '先頭i文字を数値化
substr = Right(num, Len(num) - i) '残りの文字
recur = Question5_array(substr) ' 再帰呼び出し
' 配列をつなげていく（内側）
tmpPlus = mapF(p_catV(Array(nval)), recur) ' A
tmpMinus = mapF(p_catV(Array(-nval)), recur) ' A
' 配列をつなげていく（外側）
ret = catV(ret, catV(tmpPlus, tmpMinus)) ' B
Next i
Question5_array = moveVariant(ret)
End If
End Function
'上の関数で生成した配列のうち、合計値が特定の値になるものを抽出
Function Question5(ByVal num As String, ByVal target As Long) As Variant
Dim arr As Variant, flag As Variant, i As Long
arr = Question5_array(num) ' 上の関数で配列の配列を生成
flag = repeat(0, sizeof(arr)) ' フラグ列
For i = 0 To UBound(arr) Step 1
If foldl1(p_plus, arr(i)) = target Then flag(i) = 1 ' A
Next i
'フラグでフィルタリング B
Question5 = filterR(arr, flag)
End Function
上記AとコメントしたのはVBAHaskellの典型的な関数であるmapFとかfoldl1を使っている部分で、Bは配列ユーティリティ関数だ。
これで出来上がりなので、さっそくやってみる。
m = Question5("123456789", 100)
printS m
[Dim1]: 0 -> 11 : Total Size = 12 ' 12個あるようだ
for each z in m : printM z : next z
1 2 3 -4 5 6 78 9
1 2 34 -5 67 -8 9
1 23 -4 5 6 78 -9
1 23 -4 56 7 8 9
-1 2 -3 4 5 6 78 9 ' <= これ
12 3 4 5 -6 -7 89
12 3 -4 5 67 8 9
12 -3 -4 5 -6 7 89
123 4 -5 67 -89
123 -4 -5 -6 -7 8 -9
123 45 -67 8 -9
123 -45 -67 89
何かおかしい。答えのページには11個の解があると書いてあるのに、12個の解が出てきてしまった。
確認してみると、コメントで示した上から5番目のもの
-1 2 -3 4 5 6 78 9
が漏れているようだ。先頭にマイナスを付けてはいけないとは書いていないので、これは確かに解になっていると思う。
それはいいのだが、1時間以上かかってしまった。
VBAHaskellの紹介 その11 （木構造）
やっと「すごいHaskellたのしく学ぼう！」の７章まで進んだところ、139ページから始まる二分木の解説の中で、「リストを1要素ずつ辿って値を返す操作はたいがい畳み込みで実装できる」という表現に感銘を受けた。
let nums = [8,6,4,1,7,3,5]
let numsTree = foldr treeInsert EmptyTree nums
これをVABHaskellでもやってみる。VBAで木構造といえばCreateObject("Scripting.Dictionary")として連想配列が使える *1 ようだが、キーの順序はVBAデフォルトの大小関係しか対応できない。ここは任意の比較関数を与えて連想配列を実装してみたいところだ。
ただし、きちんとした平衡二分探索木構築のアルゴリズムを実装する能力がないことと、要素を挿入した新しい木を返す関数がVBAで効率よく実装できないという問題があるが、あくまでサンプルということで前者は無視、後者はハッキング *2 で誤魔化すことにする。
結果的に、テストモジュールの treeTest() に書いた通り、バラバラな型のキーで木構造を作ることができた。大小比較は、「型が異なるときは変数のVarTypeで比較、配列どうしだったら次元と要素数で比較、そうでなければ数値もしくは文字列のデフォルトの大小関係」と指定したが、厳密で弱い順序関係なら何でも指定できるはずだ。ノードの集合を定義した後で、木構造自体は foldr 一発で構築している。
'型がバラバラで配列も含む木構造のテスト
Sub treeTest()
Dim nodes As Variant, tree As Variant
Debug.Print "型がバラバラで配列も含むキーによる木構造のテスト"
'===============ノードの集合===============
nodes = Array(makeNode(75676786, "A", p_comp000) _
, makeNode("abc", "B", p_comp000) _
, makeNode(iota(1, 8), "C", p_comp000) _
, makeNode("鳥小屋", "D", p_comp000) _
, makeNode(6, "E", p_comp000) _
, makeNode(makeM(2, 2, iota(1, 4)), "F", p_comp000) _
, makeNode(300, "G", p_comp000) _
, makeNode(iota(1, 15), "H", p_comp000) _
, makeNode("犬小屋", "I", p_comp000) _
, makeNode(makeM(2, 3, iota(1, 6)), "J", p_comp000) _
)
'===============畳み込みによる木の構築===============
tree = foldr(p_insertNode, Empty, nodes)
'===============キーの選択===============
Debug.Print """abc"" => ";
printM getNode("abc", tree)
Debug.Print """犬小屋"" => ";
printM getNode("犬小屋", tree)
Debug.Print "iota(1, 8) => ";
printM getNode(iota(1, 8), tree)
End Sub
VBAHaskellでのNull除外
配列の中のNullを別の値に変換して計算（ここでは乗算）するという単純な事例だが、2通り。
1. いったん Null を 1 に変換した配列を作る。そのあとその配列に対する掛け算をする。内側にある mapF(p_replaceNull(, 1), arr) によって新しい配列が作られている。
arr = Array(1, 2, 3, Null, 5, 7, Null, 9)
? foldl1(p_mult, mapF(p_replaceNull(, 1), arr))
1890
2. 「Null を 1 に変換してから掛け算する」をひとつのクロージャとして定義する。*1下記の fn がそれである。
arr = Array(1, 2, 3, Null, 5, 7, Null, 9)
fn = p_mult(p_replaceNull(, 1), p_replaceNull(, 1))
? foldl1(fn, arr)
1890
replaceNull は下記の通り単純なもので、以前FizzBuzzを実装するのに使った。
Haskell_2_stdFunモジュールにあるライブラリ関数である。
'Nullを他の値に置換する
Function replaceNull(ByRef x As Variant, ByRef alt As Variant) As Variant
If IsNull(x) Then
replaceNull = alt
Else
replaceNull = x
End If
End Function
Function p_replaceNull(略
VBAHaskellでのコラッツ数列
「任意の正の整数 n をとり、
・ n が偶数の場合、n を 2 で割る
・ n が奇数の場合、n に 3 をかけて 1 を足す
という操作を繰り返すと、どうなるか」
素直にファンクタを作れる。（長いけど）
collatz = p_if_else(, Array(p_mod(, 2), p_plus(1, p_mult(3)), p_divide(, 2)))
' Array(条件式, 非0の場合の変換式, 0の場合の変換式)
' 3からスタートする
printM generate_while(3, p_notEqual(1), collatz )
3 10 5 16 8 4 2 1
' 27からスタートすると111ステップに及び、途中で9232 にまで増大する
collatz27 = generate_while(27, p_notEqual(1), collatz)
printM collatz27
27 82 41 124 62 31 94 47 142 71 214 107 322 161 484 242 121 364 182 91 274 137 412 206 103 310 155 466 233 700 350 175 526 263 790 395 1186 593 1780 890 445 1336 668 334 167 502 251 754 377 1132 566 283 850 425 1276 638 319 958 479 1438 719 2158 1079 3238 1619 4858 2429 7288 3644 1822 911 2734 1367 4102 2051 6154 3077 9232 4616 2308 1154 577 1732 866 433 1300 650 325 976 488 244 122 61 184 92 46 23 70 35 106 53 160 80 40 20 10 5 16 8 4 2 1printS collatz27
[Dim1]: 0 -> 111 : Total Size = 112
' 最大値の計算は foldl1 の引数に p_max を与える
? foldl1(p_max, collatz27)
9232' 最大値の位置
? find_pred(p_equal(9232), collatz27)
77' その近辺を表示
printM subM(m, iota(74, 80))
2051 6154 3077 9232 4616 2308 1154
VBAHaskellの紹介 その10 （ループの性能が上がらない）
前回書いたループ性能を改善するためにAPIにそのための関数を追加し、ついでにリファクタリングしてみた。VBAHaskellの紹介 その9 （明示的なループの性能がいまいち）
終了判定されるまで変換関数を繰り返し適用する次のような関数をAPIに追加して、250msかかったものが140msになったが、10倍以上のスピードアップを期待していたので満足できない結果となった。
// 単純なループ（終了判定されるまで変換関数を適用）
VARIANT __stdcall repeat_imple( VARIANT* init , //初期値
VARIANT* pred , //終了判定関数
VARIANT* trans , //変換関数
__int32 maxN , //回数上限
__int32 scan , //履歴 or 結果
__int32 stopCondition); //終了条件
API側に個別目的の関数を追加するのは抵抗があったので他の方法を検討していたが、いい方法が思いつかなかったのでこうした。少し残念である。
C++側でループすることでファンクタの生成コストはほとんどなくなったはずなのに性能が伸びないのは、合成した関数の呼び出し方法そのものが悪いのだろうか。
VBAHaskellの紹介 その9 （明示的なループの性能がいまいち）
ここでの「明示的なループ」とはVBAコード中のループのことで、VBAHaskellの関数適用関数である applyFun 等を繰り返し呼び出したときの性能が良くない。mapFやfoldlなどのリスト処理関数でもループ処理はしているが、それはdllの中で行われているのでこの話とは関係ない。
原因は applyFun の毎回の呼び出しの中で、VBA配列の中にネストされている関数をC++側の構造に展開するのに最低でも2回は new が走るためである。
典型的に現われるのが、繰り返し処理そのものと言える repeat_while 関数で、サンプルの中では、以下のように円周率を確率的に求めている。
4 * repeat_while (0, _
p_equal(0, 0), _
p_plus(p_less(p_distance( _
p_makePair(p_rnd(0, 1), p_rnd(0, 1)), _
Array(0, 0)), 1.0)), _
N) _
/ N
repeat_while を使って以下のことをやっている。
- 「区間 [0,1] の一様変数のペアを作り、原点からの距離が1.0未満であれば1を、そうでなければ0を加える」関数をファンクタとして作り、
- 0を初期値として、述語 p_equal(0, 0) が満たされている間、
- 最大N回繰り返す
- 結果を4倍してNで割る
述語 p_equal(0, 0) は要するに 0 = 0 なので恒真式となり、とにかくN回繰り返すわけだが、これが遅い。Core i5マシンでN=10000だと250msくらいかかるのだ。ファンクタは比較的複雑だし、述語の分もある。
lower_bound や upper_bound の中でも同様のことが起きているはずだが、述語の呼出し回数はデータ長の対数比例なので問題ないだろう。
これを改善する方法はいくつかあるはずだが、思いついたものはどれも冴えない感じなので止まっている。
比較関数の自然な例
ソートで使用する比較関数のうまい例がみつからない。
列 { Xn } をソートするのに、関数 f でマップした f(Xn) の大小関係で比較することは良くあり、そのときの比較関数は [ ] ( auto a, auto b) { return f(a) < f(b); } という内容のものになるだろう。
VBAHaskellで実装している関数は配列を直接ソートするのではなくて、ソートインデックスを出力するものだ。それならば列 { f(Xn) } を作って、デフォルトの大小関係でソートすればいいことになるし、関数 f の呼び出し回数を考慮するとその方が速度は上かもしれない。このままでは比較関数を受け取る sortIndex_pred 関数の存在意義が説得力のないものになってしまう。
あらかじめ { f(Xn) } を作っておくのが難しい（またはすごく面倒な）例はないだろうか？あれば比較関数をとる sortIndex_pred の意義をより有効に表現できるのだ。
