4444 puzzle in Haskell

# 4444 puzzle とは
$4$つの$4$と四則演算$+,-,\times,\div$また，べき乗$a^b$によって$1$から$100$までの自然数を作成するパズルである．
```
(((4+4)-4)/4) = 1
(4-((4+4)/4)) = 2
(((4+4)+4)/4) = 3
(4+((4-4)*4)) = 4
```
また，複数の$4$を並べて$44$や$444$などの数を作り用いてもよい．
```
((4+44)/4) = 12
```
この操作をリガチャーと呼ぶ．

## 演算子の定義
演算子として`Operator`型を定義する．

また，`Operator`型の値を文字列に変換するために`Show`型クラスのインスタンスを定義する．
```hs
data Operator = Add | Sub | Mul | Pow | Div | Ligature

instance Show Operator where
  show Add = "+"
  show Sub = "-"
  show Mul = "*"
  show Pow = "^"
  show Div = "/"
  show Ligature = ""
```
## 式の定義
`Operator`型を用いて，式を定義する．

式は値`Val`または子構造として演算子`Operator`と2つの式`Expr`を持つ`App`で構成される．
```hs
data Expr = Val Int | App Operator Expr Expr

instance Show Expr where
  show (Val n) = show n
  show (App Ligature e1 e2) = show e1 ++ show e2
  show (App op e1 e2) = "(" ++ show e1 ++ show op ++ show e2 ++ ")"
```
定義された式を評価する関数`eval`を定義する．
```hs
eval :: Expr ->Maybe Int
eval (Val n) = Just n
eval (App Add e1 e2) = (+) <$> eval e1 <*> eval e2
eval (App Sub e1 e2) = (-) <$> eval e1 <*> eval e2
eval (App Mul e1 e2) = (*) <$> eval e1 <*> eval e2
eval (App Pow e1 e2) = do
  x <- eval e1
  y <- eval e2
  if y < 0 then Nothing else Just (x ^ y)
eval (App Div e1 e2) = do
  x <- eval e1
  y <- eval e2
  if y == 0 || x `mod` y /= 0 then Nothing else Just (x `div` y)
eval (App Ligature e1 e2) = do 
  if isVal e1 && isVal e2 then do
    x <- eval e1
    y <- eval e2
    if y < 0 then Nothing else Just (x * 10 ^ (length (show y)) + y)
  else Nothing
```
演算の結果は失敗する可能性があるので，`Maybe`モナドを用いて結果を表現する．

べき乗の計算は$0$乗の場合には$1$を返し，負のべき乗の場合には失敗する．

割り算は$0$で割る場合や，商が整数でない場合には失敗する．

リガチャーの計算は，両方の子構造が値である場合にのみ計算を行う．
そのために，`isVal`関数を定義する．
```hs
isVal :: Expr -> Bool
isVal (Val _) = True
isVal (App Ligature e1 e2) = isVal e1 && isVal e2
isVal _ = False
```
再帰的に`isVal`関数が定義されているのは$2$つ以上の$4$に対してもリガチャーを適用できるようにするためである．
## 括弧の組方
全ての括弧の組方を列挙する関数`combine`を定義する．
```hs
combine :: Expr -> Expr -> Expr -> Expr -> Operator -> Operator -> Operator -> [Expr]
combine v1 v2 v3 v4 op1 op2 op3 = [App op3 (App op2 (App op1 v1 v2) v3) v4,
                                   App op3 (App op1 v1 (App op2 v2 v3)) v4,
                                   App op2 (App op1 v1 v2) (App op3 v3 v4),
                                   App op1 v1 (App op3 (App op2 v2 v3) v4),
                                   App op1 v1 (App op2 v2 (App op3 v3 v4))]
```
## 結果用の型
式と値の組を表す型`Ans`を定義する．
```hs
newtype Ans = Ans (Expr, Int)

instance Eq Ans where
  (Ans (_, x)) == (Ans (_, y)) = x == y

instance Ord Ans where
  (Ans (_, x)) <= (Ans (_, y)) = x <= y

instance Show Ans where
  show (Ans (e, n)) = show e ++ " = " ++ show n
```
## 解の列挙
全ての組み合わせを列挙する関数`ans`を定義する．

計算が成功した場合のみを抽出し，調伏した回は削除する．
```hs
ans :: [Ans]
ans = nub $ sort $ do 
  e <- concat $ do
    op1 <- ops
    op2 <- ops
    op3 <- ops
    return $ combine (Val 4) (Val 4) (Val 4) (Val 4) op1 op2 op3
  let 
    eval_e = eval e
  case eval_e of
    Just n -> return $ Ans (e, n)
    Nothing -> []
```
~~男は黙って全探索~~
## 結果の表示
解を表示する関数`main`を定義する．
```hs
main :: IO ()
main = do
  mapM_ print ans
```
## 結果
```
(4-(4^(4*4))) = -4294967292
(4-(44^4)) = -3748092
(4-((4*4)^4)) = -65532
(4-((4+4)^4)) = -4092
(4-(4*(4^4))) = -1020
((4-(4^4))*4) = -1008
(4-444) = -440
(4-(4+(4^4))) = -256
((4/4)-(4^4)) = -255
((4+4)-(4^4)) = -248
((4*4)-(4^4)) = -240
(44-(4^4)) = -212
(4-(4*44)) = -172
((4-44)*4) = -160
((4-(4^4))/4) = -63
(4-((4*4)*4)) = -60
((4-(4*4))*4) = -48
(4-(4+44)) = -44
((4/4)-44) = -43
((4+4)-44) = -36
(4-((4+4)*4)) = -28
((4-(4+4))*4) = -16
((4/4)-(4*4)) = -15
(4*((4/4)-4)) = -12
((4-44)/4) = -10
((4+4)-(4*4)) = -8
(4-(44/4)) = -7
(((4-4)*4)-4) = -4
((4-(4*4))/4) = -3
(((4+4)/4)-4) = -2
((4-(4+4))/4) = -1
((4+4)-(4+4)) = 0
(((4+4)-4)/4) = 1
(4-((4+4)/4)) = 2
(((4+4)+4)/4) = 3
(4+((4-4)*4)) = 4
((4+(4*4))/4) = 5
(4+((4+4)/4)) = 6
((4+4)-(4/4)) = 7
(((4+4)+4)-4) = 8
((4+4)+(4/4)) = 9
((44-4)/4) = 10
((4+44)/4) = 12
(4+(44/4)) = 15
(((4+4)+4)+4) = 16
((4*4)+(4/4)) = 17
((4+(4/4))*4) = 20
((4+4)+(4*4)) = 24
(((4+4)*4)-4) = 28
((4*4)+(4*4)) = 32
(4+((4+4)*4)) = 36
(44-(4/4)) = 43
((4+44)-4) = 44
((4/4)+44) = 45
(((4+4)+4)*4) = 48
((4+4)+44) = 52
((4*4)+44) = 60
(((4^4)-4)/4) = 63
((4+4)*(4+4)) = 64
((4+(4^4))/4) = 65
(4+((4*4)*4)) = 68
((4+(4*4))*4) = 80
((4-(4/4))^4) = 81
(44+44) = 88
(444/4) = 111
(((4+4)*4)*4) = 128
(4*(44-4)) = 160
((4*44)-4) = 172
(4+(4*44)) = 180
((4+44)*4) = 192
((4^4)-44) = 212
((4^4)-(4*4)) = 240
((4^4)-(4+4)) = 248
((4^4)-(4/4)) = 255
(((4+4)-4)^4) = 256
((4^4)+(4/4)) = 257
((4+4)+(4^4)) = 264
((4*4)+(4^4)) = 272
((4^4)+44) = 300
((4+4)*44) = 352
(444-4) = 440
(4+444) = 448
((4^4)+(4^4)) = 512
((4+(4/4))^4) = 625
((4*4)*44) = 704
(4*((4^4)-4)) = 1008
((4*(4^4))-4) = 1020
(((4+4)^4)/4) = 1024
(4+(4*(4^4))) = 1028
((4+(4^4))*4) = 1040
(4*444) = 1776
(44*44) = 1936
((4+4)*(4^4)) = 2048
(((4+4)^4)-4) = 4092
((4*4)*(4^4)) = 4096
(4+((4+4)^4)) = 4100
4444 = 4444
((4^4)*44) = 11264
((44/4)^4) = 14641
(((4+4)^4)*4) = 16384
(((4+4)+4)^4) = 20736
(((4*4)^4)-4) = 65532
((4^4)*(4^4)) = 65536
(4+((4*4)^4)) = 65540
((4+(4*4))^4) = 160000
(4*((4*4)^4)) = 262144
((44^4)/4) = 937024
(((4+4)*4)^4) = 1048576
((4-44)^4) = 2560000
((44^4)-4) = 3748092
(4+(44^4)) = 3748100
(4^(44/4)) = 4194304
((4+44)^4) = 5308416
(4*(44^4)) = 14992384
((4+4)^(4+4)) = 16777216
((4*44)^4) = 959512576
((4^(4*4))/4) = 1073741824
((4-(4^4))^4) = 4032758016
((4^(4*4))-4) = 4294967292
((4*4)^(4+4)) = 4294967296
(4+(4^(4*4))) = 4294967300
((4+(4^4))^4) = 4569760000
(4*(4^(4*4))) = 17179869184
(444^4) = 38862602496
((4*(4^4))^4) = 1099511627776
(44^(4+4)) = 14048223625216
((4+4)^(4*4)) = 281474976710656
(44^(4*4)) = 3317774966719512576
```
これらの値が$4$つの$4$と四則演算とべき乗とリガチャーによって作成される全ての自然数である．

$1$から$100$までの数を生成するには単項演算子$!$や$\sqrt{}$を用いる必要があるが，それはまた別の機会に．