お気楽 Haskell プログラミング入門

●小町算

パズルの世界では、1 から 9 までの数字を 1 個ずつすべて使った数字を「小町数」といいます。たとえば、123456789 とか 321654987 のような数字です。「小町算」というものもあり、たとえば 123 + 456 + 789 とか 321 * 654 + 987 のようなものです。

Haskell で解法プログラムを作ってください。

●プログラムの作成

今回のパズルは、演算子が + と - しかないので、数字の間に演算子を挿入して式を計算する処理は簡単にプログラムできます。ちょっと面倒なのが数字を連結する処理です。そこで、数字を連結する処理、数字の間に演算子を挿入する処理、式を計算する処理に分けてプログラムを作っていくことにします。

●数字の連結

最初に数字を連結する処理を作ります。次のリストを見てください。

リスト : 数字の連結

concat_number :: [Int] -> [[Int]]
concat_number [] = [[]]
concat_number [x] = [[x]]
concat_number (x:y:zs) =
  map (x:) (concat_number (y:zs)) ++ concat_number ((x * 10 + y):zs)

関数 concat_number は数字を格納したリストを受け取り、隣り合う数字を連結してできるパターンをすべて求めてリストに格納して返します。引数が空リストの場合は [[ ]] を返します。引数が [x] の場合は [[x]] を返します。これが再帰呼び出しの停止条件になります。

要素が 2 つ以上ある場合はリストを x : y : zs に分解して、x と y を連結しないパターンと、x と y を連結するパターンに分けて処理します。x と y を連結しない場合は x をそのまま使うことになります。リスト y : zs に concat_number を適用して、数字を連結したリストを求め、その先頭に x を追加します。この処理は map を使うと簡単ですね。x と y を連結する場合は、x * 10 + y を zs の先頭に追加し、そのリストに concat_number を適用します。あとは 2 つのリストを演算子 ++ で連結するだけです。

簡単な実行例を示します。

ghci> concat_number [1,2]
[[1,2],[12]]
ghci> concat_number [1,2,3]
[[1,2,3],[1,23],[12,3],[123]]
ghci> concat_number [1,2,3,4]
[[1,2,3,4],[1,2,34],[1,23,4],[1,234],[12,3,4],[12,34],[123,4],[1234]]
ghci> concat_number [1,2,3,4,5]
[[1,2,3,4,5],[1,2,3,45],[1,2,34,5],[1,2,345],[1,23,4,5],[1,23,45],[1,234,5],
[1,2345],[12,3,4,5],[12,3,45],[12,34,5],[12,345],[123,4,5],[123,45],[1234,5],
[12345]]

●演算子の挿入

次は演算子 +, - を挿入して式を生成する処理を作ります。次のリストを見てください。

リスト : 式の生成

-- 式の定義
data Expr = Val Int | Add | Sub deriving (Eq, Show)

-- 式の生成
make_expr :: [Int] -> [[Expr]]
make_expr [x] = [[Val x]]
make_expr (x:xs) = map (\zs -> (Val x):Add:zs) ys1 
                ++ map (\zs -> (Val x):Sub:zs) ys1
  where ys1 = make_expr xs

Expr で数値と演算子を定義します。Val が数値、Add が + で Sub が - です。関数 make_expr は数字を格納したリストを受け取り、数字の間に演算子を挿入するパターンをすべて求めてリストに格納して返します。

プログラムは簡単です。引数が [x] であれば、[[Val x]] を返します。そうでなければ、引数を x : xs で分解して、xs に make_expr を適用して数式を生成します。そして、その数式の先頭に map で (Val x):Add と (Val x):Sub を追加します。この処理は map を使うと簡単ですね。あとは 2 つのリストを連結するだけです。

それでは簡単な実行例を示します。

ghci> concatMap make_expr $ concat_number [1,2]
[[Val 1,Add,Val 2],[Val 1,Sub,Val 2],[Val 12]]
ghci> concatMap make_expr $ concat_number [1,2,3]
[[Val 1,Add,Val 2,Add,Val 3],
 [Val 1,Add,Val 2,Sub,Val 3],
 [Val 1,Sub,Val 2,Add,Val 3],
 [Val 1,Sub,Val 2,Sub,Val 3],
 [Val 1,Add,Val 23],
 [Val 1,Sub,Val 23],
 [Val 12,Add,Val 3],
 [Val 12,Sub,Val 3],
 [Val 123]]

●式の計算

次は式を計算する処理を作ります。

リスト : 式の計算

calc_expr :: [Expr] -> Int
calc_expr ((Val x):xs) = iter xs x where
  iter [] a = a
  iter (Add:(Val x):xs) a = iter xs (a + x)
  iter (Sub:(Val x):xs) a = iter xs (a - x)

関数 calc_expr はリストの先頭 (左側) から順番に計算していくだけです。とくに難しいところはないと思います。

簡単な実行例を示します。

ghci> map calc_expr $ concatMap make_expr $ concat_number [1,2]
[3,-1,12]
ghci> map calc_expr $ concatMap make_expr $ concat_number [1,2,3]
[6,0,2,-4,24,-22,15,9,123]
ghci> map calc_expr $ concatMap make_expr $ concat_number [1,2,3,4]
[10,2,4,-4,6,-2,0,-8,37,-31,33,-35,28,20,-18,-26,235,-233,19,11,13,5,46,-22,
127,119,1234]

●実行結果

あとは filter で指定した値になる式を取り出すだけです。プログラムは次のようになります。

リスト : 小町算の解法

komachi :: [Int] -> Int -> [[Expr]]
komachi xs n =
  filter (\expr -> calc_expr expr == n) $ concatMap make_expr $ concat_number xs

実行結果を示します。

ghci> komachi [1..9] 100
[[Val 1,Add,Val 2,Add,Val 3,Sub,Val 4,Add,Val 5,Add,Val 6,Add,Val 78,Add,Val 9],
 [Val 1,Add,Val 2,Add,Val 34,Sub,Val 5,Add,Val 67,Sub,Val 8,Add,Val 9],
 [Val 1,Add,Val 23,Sub,Val 4,Add,Val 5,Add,Val 6,Add,Val 78,Sub,Val 9],
 [Val 1,Add,Val 23,Sub,Val 4,Add,Val 56,Add,Val 7,Add,Val 8,Add,Val 9],
 [Val 12,Add,Val 3,Add,Val 4,Add,Val 5,Sub,Val 6,Sub,Val 7,Add,Val 89],
 [Val 12,Sub,Val 3,Sub,Val 4,Add,Val 5,Sub,Val 6,Add,Val 7,Add,Val 89],
 [Val 12,Add,Val 3,Sub,Val 4,Add,Val 5,Add,Val 67,Add,Val 8,Add,Val 9],
 [Val 123,Sub,Val 4,Sub,Val 5,Sub,Val 6,Sub,Val 7,Add,Val 8,Sub,Val 9],
 [Val 123,Add,Val 4,Sub,Val 5,Add,Val 67,Sub,Val 89],
 [Val 123,Add,Val 45,Sub,Val 67,Add,Val 8,Sub,Val 9],
 [Val 123,Sub,Val 45,Sub,Val 67,Add,Val 89]]

これではよくわからないので、式を文字列に変換する関数 toStr を作ります。

リスト :  式を文字列に変換

toStr :: Int -> [Expr] -> [Char]
toStr n []     = "=" ++ show n
toStr n (x:xs) =
  case x of
    Add   -> "+"
    Sub   -> "-"
    Val x -> show x
  ++ toStr n xs

プログラムは簡単なので説明は割愛します。実行結果を示します。

ghci> map (toStr 100) $ komachi [1..9] 100
["1+2+3-4+5+6+78+9=100",
 "1+2+34-5+67-8+9=100",
 "1+23-4+5+6+78-9=100",
 "1+23-4+56+7+8+9=100",
 "12+3+4+5-6-7+89=100",
 "12-3-4+5-6+7+89=100",
 "12+3-4+5+67+8+9=100",
 "123-4-5-6-7+8-9=100",
 "123+4-5+67-89=100",
 "123+45-67+8-9=100",
 "123-45-67+89=100"]

ここまでプログラムを作ると、問題を解くのは簡単です。最初の問題は次のようになります。

ghci> a = map (komachi [1..9]) [100..999]
ghci> b = map length a
ghci> maximum b
15
ghci> :m +Data.List
ghci> map (+100) $ elemIndices 15 b
[108,117,126]

3 桁の整数の中で、式の総数の最大値は 15 になり、その値は 108, 117, 126 の 3 通りになります。たとえば、108 になる式は次のようになります。

ghci> map (toStr 108) (a !! 8)
["1+2+3+4+5+6+78+9=108",
 "1+2-3+45-6+78-9=108",
 "1+2+34-5-6-7+89=108",
 "1+2+34+5+67+8-9=108",
 "1-2-34+56+78+9=108",
 "1+23+4+5+6+78-9=108",
 "1+23-4-5+6+78+9=108",
 "1+23+4+56+7+8+9=108",
 "12+3-4-5+6+7+89=108",
 "12-3+4+5-6+7+89=108",
 "12+3+4+5+67+8+9=108",
 "12+34+56+7+8-9=108",
 "123+4-5-6-7+8-9=108",
 "123-4+5-6+7-8-9=108",
 "123-45+6+7+8+9=108"]

解のない最小値は次のように求めることができます。

ghci> head $ map (+100) $ findIndices (==0) b
160
ghci> a !! 60
[]

解が存在する最大値は次のようになります。

ghci> last $ map (+100) $ findIndices (>0) b
972
ghci> map (toStr 972) $ a !! 872
["123+4+56+789=972"]

ちなみに、数字の並びを逆順 (9,8,7,6,5,4,3,2,1) にした場合も簡単に答えを求めることができます。

ghci> c = map (komachi [9,8..1]) [100..999]
ghci> d = map length c
ghci> maximum d
19
ghci> map (+100) $ elemIndices 19 d
[102]
ghci> map (toStr 102) (c !! 2)
["9+8+7+6+54-3+21=102",
 "9+8-7+65-4+32-1=102",
 "9-8+7+65-4+32+1=102",
 "9+8+76+5+4+3-2-1=102",
 "9+8+76+5+4-3+2+1=102",
 "9+8+76-5-4-3+21=102",
 "9-8+76+5-4+3+21=102",
 "98+7+6-5-4+3-2-1=102",
 "98+7+6-5-4-3+2+1=102",
 "98+7-6+5+4-3-2-1=102",
 "98+7-6+5-4+3-2+1=102",
 "98+7-6-5+4+3+2-1=102",
 "98-7+6+5+4-3-2+1=102",
 "98-7+6+5-4+3+2-1=102",
 "98-7+6-5+4+3+2+1=102",
 "98+7+6+5+4+3-21=102",
 "98-7-6-5+4-3+21=102",
 "98-7-6-5+43-21=102",
 "98+76-54+3-21=102"]
ghci> head $ map (+100) $ findIndices (==0) d
194
ghci> (c !! 94)
[]
ghci> last $ map (+100) $ findIndices (>0) d
999
ghci> map (toStr 999) (c !! 899)
["9+8+7+654+321=999"]

●大町算

パズルの世界では小町数に 0 を加えた数を「大町数」といいます。そして、0 から 9 までの 10 個の数字を 1 個ずつ使った計算を「大町算」といいます。ただし、0123456789 のように最上位の桁に 0 を入れることはできません。今回は大町数のパズルを生成検定法で解いてみましょう。それでは問題です。

Ｃ言語でプログラムを作る場合、大町数は整数 (32 bit) の範囲を超えるためちょっとした工夫が必要になりますが、Haskell だと簡単にプログラムを作ることができます。

●プログラムの作成

それではプログラムを作りましょう。最初に整数 n の範囲を絞り込みます。大町数の最大値は 9876543210 で最小値は 1023456789 ですから、n の値は次の範囲内になります。

(**) :: Floating a => a -> a -> a

1023456789 ** (1 / 3) => 1007.758578449832
1006 * 1007 * 1008    => 1021146336 < 1023456789

9876543210 ** (1 / 3) => 2145.5319657992272
2145 * 2146 * 2147    => 9883005990 > 9876543210

x ** y は x の y 乗を返します。これらの計算結果から n は 1007 以上 2144 以下であることがわかります。n の範囲がぐっと狭くなりましたね。これならば、あとは単純に計算して大町数になるかチェックすればいいでしょう。プログラムは次のようになります。

リスト : パズル「３数で大町どうさま」の解法

import Data.List

splitDigit :: Integer -> [Integer]
splitDigit 0 = []
splitDigit n = n `mod` 10 : splitDigit(n `div` 10)

check :: Integer -> Bool
check n = length (nub (splitDigit (n * (n + 1) * (n + 2)))) == 10

answer :: Integer -> String
answer n = show n ++ "*" ++ show n1 ++ "*" ++ show n2 ++ "=" ++ show n3
  where n1 = n + 1
        n2 = n + 2
        n3 = n * n1 * n2

oomachi_solver :: [String]
oomachi_solver = map answer $ filter check [1007 .. 2144]

関数 splitDigit は整数を 1 桁ずつ数字に分解します。実行例を示します。

ghci> splitDigit 1234567890
[0,9,8,7,6,5,4,3,2,1]

数字の並びは逆になりますが、これでも今回の問題を解くことができます。興味のある方は数字の並び方が逆にならないようにプログラムを修正してみてください。

関数 check は引数 n が大町数になっているかチェックします。n * (n + 1) * (n + 2) を計算して、その値を splitDigit で分割します。nub は重複要素を取り除く関数で、モジュール Data.List に定義されています。簡単な使用例を示します。

ghci> :t nub
nub :: Eq a => [a] -> [a]
ghci> nub [1,2,3,4,2,3,4,5,3,4,5,6]
[1,2,3,4,5,6]

生成される値は 10 桁なので、重複要素を取り除いたリストの長さが 10 であれば、その値は「大町数」であることがわかります。あとは filter で大町数になる値だけ取り出して、関数 answer で文字列に変換します。

●実行結果

これでプログラムは完成です。さっそく実行してみましょう。

ghci> oomachi_solver
["1267*1268*1269=2038719564","1332*1333*1334=2368591704"]

2 通りの解を見つけることができました。