Solution for december FP fair

DecemberFair.hs

module DecemberFair where

import Data.Maybe (listToMaybe)
import Data.List  (permutations, nubBy)
                  
-- only non-symetric permutations
permute :: (Eq a) => [a] -> [[a]]
permute = nubBy (\ys zs -> ys == (reverse zs)) . permutations

-- binary operators
type BinOp = (String, Int -> Int -> Int)

-- available operators
ops = [ (" + ", (+))
      , (" - ", (-))
      , (" * ", (*))
      , (" / ", div) ]

-- form of expression without concrete numbers
data Form = N                       -- Number - blank place for a number
          | A BinOp Int Form Form   -- Application 
                                    --   - Int means size of the left subform
instance Show Form where
    show  N = "_"
    show (A (op,_) _ l r) = concat ["(", show l, op, show r, ")"]

-- generates all forms of given size
forms :: Int -> [Form]
forms 1 = [ N ]
forms n = [ A op s l r | op <- ops 
                       , s  <- [1 .. (n-1)]
                       , l  <- forms s
                       , r  <- forms (n-s) ]

-- evaluates form with given list of numbers
--  returns Maybe because of division by zero posibility
eval :: Form -> [Int] -> Maybe Int
eval  N [n] = Just n
eval (A op s l' r') ns | length ns > s = do
    let (nl,nr) = splitAt s ns
    l <- eval l' nl
    r <- eval r' nr
    if fst op == " / " && r == 0 
       then Nothing
       else Just ((snd op) l r)
eval _ _ = Nothing  -- this is case, when sizes are not equal
    
-- fills blanks in form with given numbers
--  returns Maybe because number list may be of non-proper size
fill :: Form -> [Int] -> String
fill  N [n] = show n
fill (A (op,_) s l r) ns | length ns > s =
    let (nl,nr) = splitAt s ns
    in concat ["(", fill l nl, op, fill r nr, ")"]
fill _ _ = ""      -- this is case, when sizes are not equal

-- generates expressions, that are evaluated to given number
solutions x ns = [ fill f ms | f  <- forms (length ns)
                             , ms <- permute ns
                             , eval f ms == Just x ]

-- returns first solution
solution :: Int -> [Int] -> Maybe String
solution x ns = listToMaybe (solutions x ns)

Для проверки:

> solution 21 [1,5,6,7]
Nothing
> solution 21 [1,5,6,7,24]
Just (1 + (5 * ((6 + 24) / 7)))

Чтобы было понятнее, что делают функции, можно позапускать их в ghci:

> let print' x = mapM_ print x

> let fs = forms 3
> print' fs

> print' [ fill f [1,2,3] | f <- fs ]
> print' [ eval f [1,2,3] | f <- fs ]

> print' $ solutions 5 [1,2,3]

Вывод этих команд достаточно наглядно изобразит работу каждой функции и ступени работы алгоритма в целом.