Display the formula of the reliability of a compound system that has a simple graph

reliabiliity.hs

import Data.List
import Data.Char
import System.IO

data Formula = Operation Char [Formula] | Variable String | Constant Float deriving Show
opAdd = Operation '+'
opMul = Operation '*'

toFormula :: Sch -> Formula
toFormula (And l) = opMul $ map toFormula l
toFormula (Or l)  = oneMin $ opMul $ map (oneMin.toFormula) l
toFormula (Var s) = Variable s
toFormula (Const n) = Constant n

oneMin f = opAdd [Constant 1, opMul [Constant (-1), f]]

doOp :: Char -> [Float] -> Float
doOp '+' = sum
doOp '*' = product


simplify x = doOps $ mergeOps x

doOps (Operation typ f) =
  let
  red elem (prev, others) =
        case doOps elem of
          Constant n -> (n:prev, others)
          a -> (prev, a:others)
  (nums, elms) = foldr red ([], []) $ map doOps f
  res = Constant (doOp typ nums)
  in case (nums,elms) of
        (_,[]) -> res
        ([],_) -> Operation typ elms
        _  -> Operation typ (res : elms)
doOps a = a

mergeOps (Operation typ f) =
  let
  reducer elem r =
    case elem of
      Operation t ff | t == typ -> ff++r
      f -> f:r
  in Operation typ $ foldr reducer [] $ map mergeOps f
mergeOps a = a

toString (Operation '+' f) = 
  let plusSimple ff = case ff of
                        Operation '*' (Constant (-1) : rest) -> "- (" ++ toString (opMul rest) ++ ") "
                        o -> "+ " ++ toString o ++ " "
  in dropWhile (=='+') $ concatMap plusSimple f
toString (Operation '*' [x]) = toString x
toString (Operation '*' f) = "(" ++ (intercalate ") * (" $ map toString f) ++ ")"
toString (Variable s) = "p_" ++ s
toString (Constant n) | n == fromInteger(round n) = show $ round n
toString (Constant n) = show n

data Sch = Or [Sch] | And [Sch] | Var String | Const Float deriving Show
parseSch = fst.parseAnd
parseAnd s =
  let (v,rr) = parseOr s in
    case rr of
      (' ':rrr) -> let (vv,b) = parseAnd rrr in (And [v,vv], b)
      _ -> (v,rr)

parseOr s =
  let (v,rr) = parseElem s in
    case rr of
      ('/':rrr) -> let (vv,b) = parseOr rrr in (Or [v,vv], b)
      _ -> (v,rr)

parseElem ('(':s) = let (a,b) = span (/=')') s in (parseSch a, drop 1 b)
parseElem s = case reads s of
                [(n,r)] | 0 < n && n < 1 -> (Const n, r)
                _ -> let (name, rest) = span isAlphaNum s
                     in (Var name, rest)

main = do
    r <- getLine
    print (toString $ simplify $ toFormula $ parseSch r)
    main

About

Schema	Representation
sequence of systems of probability p_1 and p_2	1 2
systems 1 and 2 in parallel	1/2

Combining

Schema

---------(p_1)------------(p_2)---------------
   \_______(p_3)__________________/

Representation

(1 2)/3

Now has a real github repo: https://github.com/lovasoa/reliability-theory/