# FOUR-est for the trees code

## Tree.hs

module Tree (
Tree(Plus,
Minus,
Times,
Divide,
Expt,
Negate,
Sqrt,
Factorial,
Four),
eval,
evalToInt,
trees ) where

import Data.List (inits, tails)

data Tree = Plus Tree Tree
| Minus Tree Tree
| Times Tree Tree
| Divide Tree Tree
| Expt Tree Tree
| Negate Tree
| Sqrt Tree
| Factorial Tree
| Four

trees :: [Tree] -> [Tree]
trees [x] = [ f x | f <- [ id, Negate, Sqrt, Factorial ] ]
trees xs = do
(left, right) <- splits xs
t1            <- trees left
t2            <- trees right
p             <- pairs t1 t2
trees [p]

splits :: [a] -> [([a], [a])]
splits xs = init $tail$ zip (inits xs) (tails xs)

pairs :: Tree -> Tree -> [Tree]
pairs a b = [ f a b | f <- [ Plus, Minus, Times, Divide, Expt ] ]

eval :: Tree -> Maybe Float
eval (Plus a b)  = binop (+) a b
eval (Minus a b) = binop (-) a b
eval (Times a b) = binop (*) a b
eval (Expt a b)  = binop (**) a b
eval (Divide a b) = liftM2 (/) (eval a) (mfilter (/=0) (eval b))
eval (Negate a) = unaryop (0-) a
eval (Sqrt a)   = unaryop sqrt a
eval (Factorial Four) = Just (4 * 3 * 2)
eval (Factorial _)    = Nothing
eval Four = Just 4

binop :: (Float -> Float -> Float) -> Tree -> Tree -> Maybe Float
binop op a b = liftM2 op (eval a) (eval b)

unaryop :: (Float -> Float) -> Tree -> Maybe Float
unaryop op a = liftM op (eval a)

evalToInt :: Tree -> Maybe Int
evalToInt t = round <$> mfilter good (eval t) good :: Float -> Bool good v = 0 <= v && v <= 20 && isInt v isInt :: Float -> Bool isInt n = fromIntegral (round n :: Int) == n  ## missing.hs import Tree import Data.Maybe (mapMaybe) import Data.Set (difference, elems, fromList, Set) solutions :: Set Int solutions = fromList$ mapMaybe evalToInt $trees$ replicate 4 Four

main :: IO ()
main = print $elems$ difference (fromList [0..20]) solutions



## solutions.hs

{-# LANGUAGE TupleSections #-}

import Tree
import Data.List (maximumBy, minimumBy, sortBy)
import Data.Map.Strict (fromListWith, assocs)
import Data.Maybe (mapMaybe)
import Data.Ord (comparing)
import System.Environment (getArgs)

size :: Tree -> Integer
size (Plus a b)    = 1 + size a + size b
size (Minus a b)   = 1 + size a + size b
size (Times a b)   = 1 + size a + size b
size (Divide a b)  = 1 + size a + size b
size (Expt a b)    = 1 + size a + size b
size (Negate a)    = 1 + size a
size (Sqrt a)      = 1 + size a
size (Factorial a) = 1 + size a + 1 -- prefer solutions w/o !
size (Four)        = 1

evaluated :: [(Int, Tree)]
evaluated = mapMaybe (\t -> (,t) <$> evalToInt t)$ trees $replicate 4 Four solutions :: ((Tree -> Tree -> Ordering) -> [Tree] -> Tree) -> [(Int, Tree)] solutions p = sortBy (comparing fst)$ singleSolutions where
singleSolutions = assocs $fromListWith preferred evaluated preferred a b = p (comparing size) [a, b] ordering :: [String] -> (Tree -> Tree -> Ordering) -> [Tree] -> Tree ordering ["-c"] = maximumBy ordering ["-s"] = minimumBy ordering _ = minimumBy main :: IO () main = do args <- getArgs mapM_ print (solutions$ ordering args)



## Tex.hs

module Tex (display) where

import Tree

tex :: Tree -> String
tex p@(Plus a b)                = binop "+" p a b
tex p@(Minus a b)               = binop "-" p a b
tex p@(Expt a b)                = binop "^" p a b
tex p@(Times a b)               = binop "\\times" p a b
tex p@(Divide a@(Divide x y) b) = frac (divide a x y) (group p b)
tex p@(Divide a b)              = frac (group p a) (group p b)
tex p@(Negate a)                = prefix "-" p a
tex p@(Factorial a)             = postfix "!" p a
tex (Sqrt a)                    = "\\sqrt{" ++ tex a ++ "}"
tex Four                        = "4"

binop :: String -> Tree -> Tree -> Tree -> String
binop op p a b = group p a ++ " " ++ op ++ " " ++ group p b

prefix :: String -> Tree -> Tree -> String
prefix op p a = "{" ++ op ++ group p a ++ "}"

postfix :: String -> Tree -> Tree -> String
postfix op p a = "{" ++ group p a ++ op ++ "}"

divide :: Tree -> Tree -> Tree -> String
divide a x y = (group a x ++ " / " ++ group a y)

frac :: String -> String -> String
frac num denom = "\\frac{" ++ num ++ "}{" ++ denom ++ "}"

group :: Tree -> Tree -> String
group parent child
| p > c     = "(" ++ t ++ ")"
| p == c    = "{" ++ t ++ "}"
| otherwise = t
where
p = precedence parent
c = precedence child
t = tex child

precedence :: Tree -> Integer
precedence (Plus _ _)    = 1
precedence (Minus _ _)   = 1
precedence (Times _ _)   = 2
precedence (Divide _ _)  = 2
precedence (Negate _)    = 3
precedence (Sqrt _)      = 3
precedence (Factorial _) = 3
precedence (Expt _ _)    = 3
precedence Four          = 5

display :: (Integer, Tree) -> String
display (n, t) = show n ++ " = " ++ tex t



## texify.hs

import Tex (display)
import System.Environment (getArgs)

main :: IO ()
main = do
args <- getArgs
file <- readFile $head args mapM_ (putStrLn . display)$ map read \$ lines file