[99p]ArithPuz

import Data.List

------ Predefined Consts
inputNum5 = ["2","3","5","7","11"]
inputNum6 = ["2","3","5","7","11","13"]
inputNum7 = ["2","3","5","7","11","13","17"]
inputNum8 = ["2","3","5","7","11","13","17","19"]
rpn1 = ["5", "1", "2", "+", "4", "*", "+", "3", "-"]
arithop = ["*", "/", "+", "-"]

------ Reverse Polish Notation Calculator, Permutator
rpnCalc :: [[Char]] -> Float
rpnCalc list = head (foldl rpnReader [] list)
               where rpnReader :: (Read a, Fractional a) => [a] -> [Char] -> [a]
                     rpnReader (x:y:xs) "+" = (x + y):xs
                     rpnReader (x:y:xs) "-" = (y - x):xs
                     rpnReader (x:y:xs) "*" = (x * y):xs
                     rpnReader (x:y:xs) "/" = (y / x):xs
                     rpnReader xs numstr = read numstr:xs
rpnVerify :: [[Char]] -> Bool
rpnVerify ls = and (map (\x -> (length $ filter (`elem` arithop) x) < (length $ filter (`notElem` arithop) x)) (inits ls \\ [[]]))
               && ((length $ filter (`notElem` arithop) ls) - (length $ filter (`elem` arithop) ls) == 1)
opPermu :: Int -> [[[Char]]]
opPermu n = opPermu' n [[]]
            where opPermu' :: Int -> [[[Char]]] -> [[[Char]]]
                  opPermu' 0 oplists = oplists
                  opPermu' n oplists = opPermu' (n-1) [ oplist ++ [op] | oplist <- oplists, op <- arithop ]
rpnGen :: [[Char]] -> [[Char]] -> [[[Char]]]
rpnGen ns ops = rpnGen' (length ns + length ops) ns ops [[]]
                where rpnGen' :: (Num a) => a -> [[Char]] -> [[Char]] -> [[[Char]]] -> [[[Char]]]
                      rpnGen' 0 _ _ rpnlists = rpnlists
                      rpnGen' _ [] ops rpnlists = map (++ops) rpnlists
                      rpnGen' _ _ [] rpnlists = []
                      rpnGen' len (n:ns) (o:ops) rpnlists = rpnGen' (len-1) ns (o:ops) (map (++[n]) rpnlists) ++
                                                            rpnGen' (len-1) (n:ns) ops (map (++[o]) $ filter (\x -> (length $ filter (`notElem` arithop) x) > (length $ filter (`elem` arithop) x)) rpnlists)
rpnPermu :: [[Char]] -> [[[Char]]]
rpnPermu [] = []
rpnPermu (n:ns) = map ([n]++) $ concatMap (rpnGen ns) $ opPermu (length ns)

------ Puzzle Solver
arithPuz :: [[Char]] -> [([[Char]], [[Char]])]
arithPuz numlist = concatMap rpnPair [ splitAt i numlist | i <- [1..length numlist - 1] ]
                   where rpnPair listpair = [ (a,b) | a <- rpnPermu (fst listpair), b <- rpnPermu (snd listpair), rpnCalc a == rpnCalc b ]

------ Currently too lazy to write a RPN -> Infix Notation converter >_<