WCC 12.23

Main.hs

import Data.List
import Data.Tree

data Operator = Plus | Minus | Times | By | None deriving (Eq)
instance Show  Operator where
  show Plus  = "+"
  show Minus = "-"
  show Times = "*"
  show By    = "/"
  show None  = "Initial"

data State op xs = State (Operator) [Float] deriving (Show)

operators = [Plus, Minus, Times, By]

apply :: State t t1 -> State t xs
apply (State operator (x:y:xs))
  | operator == Plus   =  State operator ((x + y) : xs)
  | operator == Times  =  State operator ((x * y) : xs)
  | operator == Minus  =  State operator ((x - y) : xs)
  | operator == By     =  State operator ((x / y) : xs)

expandTree :: Float -> State t t1 -> Tree (State t t1)
expandTree _ s@(State _ ([x])) = Node s []
expandTree i s@(State _ nums)
 | elem i nums = Node s []
 | otherwise   = Node s [expandTree i $ apply state | state <- [State op xs | op <- operators, xs <- nub $ permutations nums]]

bestAnswer :: Float -> [Float] -> [[State t t1]]
bestAnswer i numbers = smallestChunks $ 
                       splitToRoot (\(State op _) -> op == None) $ 
                       find  (\(State _ l) -> elem i l) [] tree

  where tree = expandTree i (State None numbers)

        closestMatch = maximum $ filter (\x -> x <= i) $ flatten $ fmap (\(State _ nums) -> maximum nums) tree

        find pred arry (Node y lols)
          | pred y = y : arry
          | otherwise = (concatMap (find pred (y:arry)) lols)

        splitToRoot _ [] = []
        splitToRoot f l@(x:xs)
          | f x = splitToRoot f xs
          | otherwise = let (h,(t:ts)) = break f l in (t:(reverse h)):(splitToRoot f ts)

        smallestChunks xs = let size = minimum $ map length xs
                            in filter (\x -> length x == size) xs

{-Pretty print-}
draw :: (Show a) => [[a]] -> String
draw xs  = unlines [show(x) | ys <- xs, x <- ys]

main = do
    putStr $ draw $ bestAnswer 6 [2,3,5]
    putStr $ draw $ bestAnswer 522 [100, 5, 5, 2, 6, 8]