module Sol_Exercise_5 where
import Test.QuickCheck
import Data.List
import Data.Maybe

{- Library -- nicht verändern! -}

type State = Integer
type DA = (State, State -> Char -> State, State -> Bool)
type ListDA = (State, [((State, Char), State)], [State])

a :: DA
a = (0, delta, (==1))
  where
    delta 0 'a' = 1
    delta 1 'a' = 1
    delta 2 'a' = 1
    delta 0 'b' = 2
    delta 1 'b' = 2
    delta 2 'b' = 2

toDA :: ListDA -> DA
toDA (start, delta, final) = (start, deltaFun delta, (`elem` final))
  where deltaFun dl = curry (fromMaybe 0 . flip lookup dl)

{- G1 -}

iter :: Int -> (a -> a) -> a -> a
iter n f x | n <= 0 = x
           | otherwise = iter (n - 1) f (f x)

pow :: Int -> Int -> Int
pow n m = iter m (*n) 1

drop' :: Int -> [a] -> [a]
drop' n xs = iter n tail xs

replicate' :: Int -> a -> [a]
replicate' n x = iter n (x:) []

{- G2 -}

-- 1 a) rekursiv
partitionA :: (a -> Bool) -> [a] -> ([a], [a])
partitionA _ [] = ([], [])
partitionA p (x : xs) =
  if p x then (x : ts, fs) else (ts, x : fs)
  where (ts, fs) = partitionA p xs

-- 1 b) mit foldr
partitionB :: (a -> Bool) -> [a] -> ([a], [a])
partitionB p =
  foldr (\x (ts, fs) -> if p x then (x : ts, fs) else (ts, x : fs)) ([], [])

-- 1 c) mit filter
partitionC :: (a -> Bool) -> [a] -> ([a], [a])
partitionC p xs = (filter p xs, filter (\x -> not (p x)) xs)

-- 1 d)
prop_partitionA xs = partitionA even xs == partition even xs
prop_partitionB xs = partitionB even xs == partition even xs
prop_partitionC xs = partitionC even xs == partition even xs

-- 1 e)
prop_partitionDistrib xs ys =
    partition even (xs ++ ys) == (xs1 ++ ys1, xs2 ++ ys2)
  where
    (xs1, xs2) = partition even xs
    (ys1, ys2) = partition even ys

-- 1 f)
{-
Die ersten beiden Implementierungen sind effizienter als die dritte, weil "p"
nur einmal pro Element angewandt wird statt zweimal. Die zweite ist etwa knapper
als die erste, aber die erste ist womoeglich einfacher zu verstehen. Die dritte
Version ist wahrscheinlich die einfachste von den drei. Statt
"(\x -> not (p x))" kann man auch "not . p" schreiben (vgl. 6.7 in den Folien).
-}


-- 2
zipWith' :: (a -> b -> c) -> [a] -> [b] -> [c]
zipWith' f [] [] = []
zipWith' f (x : xs) (y : ys) = f x y : zipWith' f xs ys



{- G3 -}

{-
Der erste lambda-Ausdruck ist die Identitaetsfunktion mit dem Typ
[a] -> [a].

Der zweite lambda-Ausdruck ist die Indentitaetsfunktion mit dem Typ
(a -> b -> c) -> a -> b -> c.
-}


{- G4 -}

{-
1. Die Evaluierung von "zeros" terminiert nicht:

    zeros = 0 : zeros = 0 : 0 : zeros = 0 : 0 : 0 : zeros = ...

Das sieht man deutlich, wenn man versucht, die Funktion in "ghci" auszuwerten.

2. Fallunterscheidungen in Haskell werden sequenziell angewandt. Das heisst,
die Gleichung "h_geq" kann nur dann angewandt werden, wenn weder "m == n" noch
"m < n"; insbesondere kann sie nicht fuer "h 0 0" angewandt werden.

Wenn man "h 0 0" auswertet, bekommt man dank der Gleichung "h_eq" sofort "0".

Die Funktion "h" terminiert (fuer alle Eingaben).
-}


{- H1 -}

fixpoint :: (a -> a -> Bool) -> (a -> a) -> a -> a
fixpoint eq f x = if eq x (f x) then x else fixpoint eq f (f x)

{- cents erweitert die Eingabeliste um die Zahlen, die als Summe von genau 2
   Zahlen in der Eingabeliste geschrieben werden können. Z.B.

   cents [5,7] == union [5,7] [5+5, 5+7, 7+5, 7+7] = [5,7,10,12,14]
   cents [5,7,10,12,14] == union [5,7,10,12,14]
                           [5+5, 5+7, 5+10, 5+12, 5+14,
                            7+5, 7+7, 7+10, 7+12, 7+14,
                            10+5, 10+7, 10+10, 10+12, 10+14,
                            12+5, 12+7, 12+10, 12+12, 12+14,
                            14+5, 14+7, 14+10, 14+12, 14+14]
                        == [5,7,10,12,14,15,17,19,21,20,22,24,26,28]

   Die wiederholte Anwendung dieser Funktion fuegt also immer groessere
   moegliche Summen ein. Der Fixpunkt wird erreicht wenn wir alle solche
   Summen < 100 erschoepft haben---das ist genau die Fragestellung-}
cents :: [Integer] -> [Integer]
cents xs = union xs [x + y | x <- xs, y <- xs, x + y < 100]

eqSet :: Eq a => [a] -> [a] -> Bool
eqSet xs ys = null (xs \\ ys) && null (ys \\ xs)

trancl :: [(Integer, Integer)] -> [(Integer, Integer)]
trancl = fixpoint eqSet tranclStep
  where
    tranclStep :: [(Integer, Integer)] -> [(Integer, Integer)]
    tranclStep gr = union gr [(x, z) | (x, y) <- gr, (y', z) <- gr, y == y']


{- H2 -}

advance :: DA -> State -> String -> State
advance (_,delta,_) = foldl delta

prop_advance_empty :: DA -> State -> Bool
prop_advance_empty a s = advance a s "" == s

prop_advance_single :: DA -> State -> Char -> Bool
prop_advance_single a s c = advance a s [c] == delta s c
  where (_,delta,_) = a

prop_advance_concat :: DA -> State -> String -> String -> Bool
prop_advance_concat a s xs ys =
    advance a (advance a s xs) ys == advance a s (xs ++ ys)


accept :: DA -> String -> Bool
accept a@(start,_,final) xs = final (advance a start xs)

-- alternativ: accept a@(start,_,final) = final . advance a start

reachableStates :: DA -> State -> [Char] -> [State]
reachableStates (_,delta,_) s alph = fixpoint (==) reach [s]
  where
    reach ss = sort $ nub $ [delta s c |s <- ss, c <- alph] ++ ss

{- H3 -}

{-WETT-}
subseq :: Eq a => [a] -> [a] -> Bool
subseq [] _ = True
subseq _ [] = False
subseq (x : xs) (y : ys) = subseq (if x == y then xs else x : xs) ys

quasiSubseq :: Eq a => [a] -> [a] -> Bool
quasiSubseq [] _ = True
quasiSubseq xs [] = length xs <= 1
quasiSubseq (x : xs) (y : ys) =
  if x == y then quasiSubseq xs ys
  else subseq xs (y : ys) || quasiSubseq (x : xs) ys
{-TTEW-}

{-WETT-}
subseq' :: Eq a => [a] -> [a] -> Bool
subseq' [] _ = True
subseq' _ [] = False
subseq' (x : xs) (y : ys) = subseq' (if x == y then xs else x : xs) ys

quasiSubseq' :: Eq a => [a] -> [a] -> Bool
quasiSubseq' [] _ = True
quasiSubseq' xs ys =
  any (\xs -> subseq' xs ys) [take (n - 1) xs ++ drop n xs | n <- [1..length xs]]
{-TTEW-}

{-WETT-}
sums [] [] = []
sums (x : xs) (y : ys) = x + y : sums xs ys

subseqIndices _ [] _ = []
subseqIndices _ [_] _ = []
subseqIndices n (x : xs) [] = n + 1 : subseqIndices n xs []
subseqIndices n (x : xs) (y : ys) =
  if x == y then n : subseqIndices (n + 1) xs ys
  else subseqIndices (n + 1) (x : xs) ys

quasiSubseqNeedleTooLong (_ : xs) (_ : ys) = quasiSubseqNeedleTooLong xs ys
quasiSubseqNeedleTooLong (_ : _ : _) [] = True
quasiSubseqNeedleTooLong _ _ = False

quasiSubseq'' :: Eq a => [a] -> [a] -> Bool
quasiSubseq'' xs ys =
  not (quasiSubseqNeedleTooLong xs ys) &&
  any (<= length ys)
      (sums (0 : subseqIndices 1 xs ys)
            (reverse (0 : subseqIndices 1 (reverse xs) (reverse ys))))
{-TTEW-}