-- Examples for using functional patterns

import List(nub)
import AllSolutions
import SetFunctions


-- Define permutations with functional patterns:
perm :: [a] -> [a]
perm []     = []
perm (xs++x:ys) = x : perm (xs++ys)

-- Does a list contain adjacent elements in descending order?
descending :: [Int] -> Success
descending (_++x:y:_) | x > y = success

-- Another implementation of permutation sort (due to Ken Shan and
-- Sebastian Fischer, Curry mailing list of 03/06/2012)
sort :: [Int] -> [Int]
sort l | isEmpty (set1 descending p) = p
  where p = perm l


-------------------------------------------------------------
-- From ACM programming contest:
-- compute the length of a list up to the first repeated element:
lengthUpToRepeat (p++[r]++_) 
    | nub p == p && r `elem` p 
    = length p + 1

m1 = lengthUpToRepeat [1,2,3,42,56,2,3,1]

-- works also for infinite lists (if we don't ask for all solutions)
m2 = lengthUpToRepeat ([1,2,3,42,56]++[0..])

-------------------------------------------------------------
-- Arithmetic expressions:
data Exp = Lit Int | Var String | Add Exp Exp | Mul Exp Exp

-- Replacement operation:
replace :: Exp -> [Int] -> Exp -> Exp
replace _         []    x = x
replace (Add l r) (1:p) x = Add (replace l p x) r
replace (Add l r) (2:p) x = Add l (replace r p x)
replace (Mul l r) (1:p) x = Mul (replace l p x) r
replace (Mul l r) (2:p) x = Mul l (replace r p x)

-- Possible simplifications:
evalTo :: Exp -> Exp
evalTo e = Add (Lit 0) e
         ? Add e (Lit 0)
         ? Mul (Lit 1) e
         ? Mul e (Lit 1)

simplify :: Exp -> Exp
simplify (replace c p (evalTo x)) = replace c p x

m3 = simplify (Mul (Lit 1) (Var "x"))  --> (Var "x")

exp = Mul (Lit 1) (Add (Var "x") (Lit 0))

m4 = simplify (simplify exp)  --> (Var "x")

-- Apply a transformation to some data structure as long as it is defined:
transformAll :: (a -> a) -> a -> IO a
transformAll trans term =
   (getOneValue (trans term)) >>= maybe (return term) (transformAll trans)

m5 = transformAll simplify exp  --> (Var "x")

exp_n n e = if n==0 then e else Add (exp_n (n-1) e) (exp_n (n-1) e)

bigexp | e =:= exp_n 8 exp = e  where e free

-- return some variable occurring in an expression:
varInExp :: Exp -> String
varInExp (replace _ _ (Var v)) = v

-- return a list of all variable names in an expression:
getVarsInExp :: Exp -> [String]
getVarsInExp e = sortValues (set1 varInExp e)

m6 = getVarsInExp exp
m7 = length (getVarsInExp bigexp)  --> 256