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時間以上かかってしまった。
