solution of the math24 game in Haskell, also see https://www.zhihu.com/question/307729091

math24.hs

import Data.List
import Data.Maybe
import Data.Ratio
import Data.Char
import Control.Monad (liftM2, join, forM_)
import Control.Parallel.Strategies (parMap, rseq)
import Control.Arrow ((&&&))
import GHC.Exts (groupWith, sortWith)
type Number = Rational
type VarID = Int

data BinOp = Add | Sub | Mul | Div deriving (Show, Eq, Ord, Enum)
data Expr = Lit Number | Var VarID | Bin BinOp Expr Expr deriving (Eq, Ord)

showVar :: VarID -> String
showVar i = chr (ord 'a' + i) : []

showNum :: Number -> String
showNum x = if denominator x == 1 then show (numerator x) else show x

instance Show Expr where
    show (Lit x) = showNum x
    show (Var i) = showVar i
    show (Bin op a b) = "(" ++ show a ++ " " ++ ["+-*/" !! fromEnum op] ++ " " ++ show b ++ ")"

type Env = [Number]

eval :: Env -> Expr -> Maybe Number
eval env (Lit x) = Just x
eval env (Var i) = Just (env !! i)
eval env (Bin op a b) = join $ liftM2 (runOp op) (eval env a) (eval env b)
    where
        runOp :: BinOp -> Number -> Number -> Maybe Number
        runOp Add a b = Just (a + b)
        runOp Sub a b = Just (a - b)
        runOp Mul a b = Just (a * b)
        runOp Div a b = if b /= 0 then Just (a / b) else Nothing

inject :: Env -> Expr -> Expr
inject env e = case e of (Var i) -> Lit (env !! i); (Lit _) -> e; (Bin op a b) -> Bin op (inject env a) (inject env b)

data NormalForm = NF {termsOf :: [(Coefficient, [(Exponent, VarID)])]} deriving (Eq, Ord)
type Coefficient = Number
type Exponent = Int

instance Show NormalForm where
    show (NF terms) = intercalate " + " . map showTerm $ terms where
        showTerm (c, x) = (if c /= fromInteger 1 then showNum c ++ " * " else "") ++ intercalate "" (map showFactor x)
        showFactor (e, x) = showVar x ++ (if e /= fromInteger 1 then "^" ++ show e else "")

-- | merge weighted list
mergeW :: (Num c, Eq c, Ord a) => [(c, a)] -> [(c, a)] -> [(c, a)]
mergeW l1 l2 = filter ((/= fromInteger 0) . fst) . map (sum . map fst &&& snd . head) . groupWith snd . sortWith snd $ (l1 ++ l2
)

negateW :: Num c => [(c, a)] -> [(c, a)]
negateW = map (negate . fst &&& snd)

nf :: Expr -> NormalForm
nf e = case e of
    (Lit x) -> NF [(x, [])]
    (Var i) -> NF [(1, [(1, i)])]
    (Bin op a b) ->
        let terms1 = termsOf (nf a)
            terms2 = termsOf (nf b)
        in case op of
            Add -> NF (mergeW terms1 terms2)
            Sub -> NF (mergeW terms1 (negateW terms2))
            Mul -> NF (sortWith snd [(a1 * a2, mergeW x1 x2) | (a1, x1) <- terms1, (a2, x2) <- terms2])
            Div -> NF (sortWith snd [(a1 * a2, mergeW x1 (negateW x2)) | (a1, x1) <- terms1, (a2, x2) <- terms2])

expressionsFor :: [BinOp] -> Int -> [Expr]
expressionsFor ops varCount = map (snd . head) . groupWith fst . sort . map (nf &&& id) $ allExprs [0..varCount-1] where
    keepOrderExprs = f where
        f [v] = [Var v]
        f vs = [Bin op a b | op <- ops, k <- [1 .. length vs - 1], a <- f (take k vs), b <- f (drop k vs)]
    allExprs vs = concatMap keepOrderExprs $ permutations vs

------------------------------------ puzzle ------------------------------------

expressions :: [Expr]
expressions = expressionsFor [Add .. Div] 4

math24 :: [Number] -> Maybe Expr
math24 xs = fmap (inject xs) . listToMaybe . filter ((== Just 24) . eval xs) $ expressions

puzzles :: [[Number]]
puzzles = cards where
    maxNum = 13
    numberOfCard cid = toRational (cid `mod` maxNum + 1)
    n = maxNum * 4 - 1
    cards = [map numberOfCard [i,j,k,l] | i <- [0..n], j <- [i+1..n], k <- [j+1..n], l <- [k+1..n]]

main :: IO ()
main = do
    let totalCount = length puzzles
    let validCount = length . filter id . parMap rseq (isJust . math24) $ puzzles
    print ("different expr count: " ++ show (length expressions))
    print ("total: " ++ show totalCount)
    print ("valid: " ++ show validCount)
    print ("invalid ratio: " ++ show (fromIntegral (totalCount - validCount) / fromIntegral totalCount))

--test1 = expressionsFor [Add, Mul] 4
--test2 = map nf $ test1
--test = forM_ test2 print

{-
prepare:
$ stack install parallel

compile:
$ stack exec -- ghc -O2 -threaded -rtsopts math24.hs

execute:
$ math24 +RTS -N
-}