Countdown game with pruning

countdown.hs

{-# LANGUAGE MultiWayIf #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

{-# HLINT ignore "Redundant multi-way if" #-}

module Counting () where

-- some values
type S a = [a]

-- any combining operation between 2 values (+, - , * ...)
type Op a = a -> a -> [a]

-- select each element of some values together with the leftovers (easy)
selectEach :: S a -> [(a, S a)]
selectEach = go []
  where
    go _ [] = []
    go bf (x : xs) = error "implement"

-- given the possible combining operations and some values
-- combine each 2 values with each operation (no assumption is made on them)
-- use 'selectEach' (hard, use `concatMap` twice)
combineOnce :: [Op a] -> S a -> [(a, S a)]
combineOnce fs = go []
  where
    go bf (x : xs) = error "implement"
    go _ [] = []

-- recurse combineOnce so that all possible ricombination is produced (easy)
combineAll :: [Op a] -> S a -> [a]
combineAll fs xs = error "implement"

-- reification of the operations in structure to allow rendering
-- the value at the node is not really necessary, just a speedup
data A op a = L a | N op a (A op a) (A op a) deriving (Show)

-- value at the node
value :: A op a -> a
value (L x) = x
value (N _ x _ _) = x

data R a = None | Both a a | Straight a | Other a

-- produces all operations combinations over the given list
run :: [op] -> (op -> a -> a -> R a) -> [a] -> [A op a]
run ops compute xs =
  combineAll
    [mkN compute op | op <- ops]
    $ L <$> xs

mkN :: (op -> a -> a -> R a) -> op -> A op a -> A op a -> [A op a]
mkN f op x y = case f op (value x) (value y) of
  None -> []
  Both v v' -> [N op v x y, N op v' y x]
  Straight v -> [N op v x y]
  Other v -> [N op v y x]

-- render a reification
render :: (Show b) => (op -> String) -> A op b -> IO ()
render symbol = putStrLn . report
  where
    clean (L x) = show x
    clean (N op _ l r) = "(" ++ clean l ++ symbol op ++ clean r ++ ")"

    report (L x) = show x
    report n@(N _ b _ _) = show b ++ " = " ++ (init . tail $ clean n)

-- application

data O = Sum | Prod | Diff | Div

valueO :: (Integral a) => O -> a -> a -> R a
valueO op x y = case op of
  Sum -> Straight $ x + y
  Diff ->
    let z = x - y
     in if 
        | z > 0 -> Straight z 
        | z == 0 -> None 
        | otherwise -> Other (-z)
  Prod -> Straight $ x * y
  Div -> if
        | x * y == 0 -> None
        | otherwise ->
            let (which, x', y') = if x > y then (Straight, x, y) else (Other, y, x)
                (d, r) = divMod x' y'
             in if r == 0 then which d else None

runO :: Integral b => [b] -> [A O b]
runO = run [Sum, Diff, Prod] valueO

renderO :: O -> String
renderO Sum = "+"
renderO Prod = "*"
renderO Diff = "-"
renderO Div = "/"

-- shortcircuit on 0
bestHand :: (Ord b, Num b) => (a -> b) -> [a] -> a
bestHand _ [] = error "no best"
bestHand f (x:xs) = go (x, f x) xs 
    where 
        go r [] = fst r 
        go (b,bv) (y:ys) = if
            | f y < bv -> go (y, f y) ys
            | f y == 0 -> y 
            | otherwise -> go (b,bv) ys  

test :: IO ()
test = render renderO $ bestHand (\x -> abs (value x - 812)) $ runO [70 :: Int, 50, 2, 3, 8, 7]

{-
*Counting> test
812 = (8+50)*(2*7)
-}