{----------------------------------------------------------
     Datei mit Beispielen zur Lazy Evaluation 
----------------------------------------------------------}
-- import IO

----------------------------------------------------------
-- Definition unendlicher Datenstrukturen
----------------------------------------------------------

liste1 :: Num a => [a]
liste1 =  1 : liste1      -- [1,1..], repeat 1

from   :: Num a =>  a -> [a]   
from n =  n : from (n+1)  -- [n..]

fibnbs :: Num a => a -> a -> [a]   
fibnbs n m =  n : fibnbs m (n+m)

fib :: Int -> Integer
fib 0 = 1
fib 1 = 1
fib (n+2) = fib n + fib (n+1)

fib' :: Int -> Integer
fib' n = (fibnbs 1 1)!!n

fib3 :: Int -> Integer
fib3 n = aux n 1 1
 where aux :: Int -> Integer -> Integer -> Integer
       aux 0 n k = n
       aux (j+1) n k = aux j k (n+k)
       


----------------------------------------------------------
-- Primzahlgenerierung mit dem Sieb des Eratosthenes
----------------------------------------------------------

not_multiple         :: Int -> Int -> Bool
not_multiple x y     =  (y `mod` x) > 0

sieve               :: [Int] -> [Int]
sieve []            =  []
sieve (x:xs)        =  x: sieve (filter (not_multiple x) xs)

is_prime            :: Int -> Bool
is_prime n          =  elem n (sieve [2..])

twins               :: [Int] -> [(Int,Int)]
twins  []           =  []
twins  [x]          =  []
twins  (x:xs@(y:ys))|  y - x <= 2  = (x,y):twins xs
                    | otherwise    = twins xs

---------------------------------------------------------------
-- Bsp: Newtonsches Iterationsverfahren
-- ------------------------------------------------------------
-- Sei a > 0, x_0 > 0. Dann konvergiert die Folge
-- <x_i | i >= 0> mit x_{i+1} = (x_i + a/x_i) / 2 
-- gegen sqrt(a).

-- Iterationsfunktion
next     :: Fractional a => a -> a -> a
next a x =  (x + a/x) / 2

-- Folgendefinition
folge :: Fractional a => a -> a -> [a]
folge a x_0 = iterate (next a) x_0

-- Abbruchkriterium
within :: (Ord a, Num a) => a -> [a] -> a 
within eps (x1:x2:xs) 
    | abs (x2-x1) < eps  = x2
    | otherwise          = within eps (x2:xs)

-- Approximation der Quadratwurzel
mysqrt           :: (Ord a, Fractional a) => a -> a -> a -> a 
mysqrt x_0 eps a =  within eps (folge a x_0)


-----------------------------------------------------------
-- Problemloesen mit Generate-and-Test
-- --------------------------------------------------------
gt :: (a -> [b]) -> (b -> Bool) -> a -> [b]
gt    generate      test           params 
    =  filter test (generate params)

-- Beispiel: Permutation Sort 
-----------------------------------------------------------
-- Erzeugung aller Permutationen einer Liste
allPerms :: [a] -> [[a]]
allPerms []     = [[]]
allPerms (x:xs) = concat (map (distr x) (allPerms xs))
   where distr x []       = [[x]]
         distr x l@(y:ys) = (x:l):(map (y:) (distr x ys))

-- Teste, ob Liste sortiert ist
sorted          :: Ord a => [a] -> Bool
sorted xs       =  and $ zipWith (<=) xs (tail xs)


-- Permutation Sort: 
-- generiere alle Permutationen und filtere sortierte heraus
psort :: Ord a => [a] -> [a]
psort =  head . (gt allPerms sorted)


-----------------------------------------------------------
-- Verarbeitung partieller Informationen
-- --------------------------------------------------------

data Tree a = Leaf a | Node a (Tree a) (Tree a)
                deriving Show


-- Bsp: Bestimme mit nur einem Baumdurchlauf 
-- das Minimum in einem Baum und ersetze jeden
-- Eintrag durch diesen Wert

-- Ansatz: 
-- Minimum bestimmen
minTree              :: Ord a => Tree a -> a 
minTree (Leaf x)     =  x
minTree (Node x l r) =  min x (min (minTree l) (minTree r))

-- Knoteneintraege durch vorgegebenen Wert ersetzen
replace                :: Tree a -> b -> Tree b
replace (Leaf x)     y =  Leaf y
replace (Node x l r) y =  Node y (replace l y) (replace r y)

-- Alle Knoteneintraege durch Minimum ersetzen
-- replaceMin   :: Ord a => Tree a -> Tree a
replaceMin t =  replace t $ minTree t


-- -> diese Loesung benoetigt zwei Baumdurchlaeufe


-- Definiere durch Paarung von minTree und replace 
-- eine Funktion, die mit einem Baumdurchlauf auskommt
minReplace                :: Ord a => Tree a -> a -> (a, Tree a)
minReplace (Leaf x)     y =  (x, Leaf y)
minReplace (Node x l r) y =  (min x (min ml mr), Node y ly ry)
            where (ml,ly) =  minReplace l y
                  (mr,ry) =  minReplace r y
                  
-- ... und nun in einem Durchlauf:
replaceMin1   :: Ord a => Tree a -> Tree a
replaceMin1 t =  mt where (mint, mt) = minReplace t mint   

          

-- Testbaum

testbaum = Node 10 (Node 15 (Node 16 (Node 7 (Leaf 3) 
                                             (Node 39 (Leaf 15) 
                                                      (Leaf 18)))
                                     (Node 17 (Leaf 13) 
                                              (Node 9 (Leaf 11) 
                                                      (Leaf 2))))
                            (Leaf 18)) 
                   (Node 25 (Node  6 (Node 14 (Leaf 34) 
                                              (Node 3 (Leaf 5) 
                                                      (Leaf 36)))
                                     (Node 80 (Leaf 26) 
                                              (Node 19 (Leaf 4) 
                                                       (Leaf 12))))
                            (Leaf 99)) 
testbaum2 = let t = Node 25 (Node  6 (Node 14 (Leaf 34) 
                                      (Node 3 (Leaf 5) 
                                              (Leaf 36)))
                             (Node 80 (Leaf 26) 
                                      (Node 19 (Leaf 4) 
                                               (Leaf 12))))
                    (Leaf 99)
            in (Node 3 t (Node 1 t t))


-----------------------------------------------------------
-- Prozessnetze
-- --------------------------------------------------------

--
--           .---.    .---.   .-------------.
--  fibs <---| 1 |<---| 1 |<--| zipWith (+) |
--         | '---'  | '---'   '-------------'
--         |        |_____________^     ^
--         |____________________________|
--           
fibs :: [Integer] 
fibs =  1:1:zipWith (+) fibs (tail fibs)

-- Vergleiche: 
fibs1    :: () -> [Integer]
fibs1 () =  1:1:zipWith (+) (fibs1 ())  (tail (fibs1 ()))


fibs2    :: () -> [Integer]
fibs2 () =  1:1:zipWith (+) fs (tail fs)
         where fs = fibs2 ()

--         .---.      .-------------.
-- ps  <---| 0 |<-----| zipWith (+) |<-- xs
--       | '---'      '-------------'
--       |                   ^
--       |___________________|
--

prefixSums    :: Num a => [a] -> [a]
prefixSums xs =  ps 
    where  ps =  0 : zipWith (+) xs ps


-- 
main :: IO()
main = putStr "Hello"


---------------------------------------------------------------
-- Simulation einer Client-Server-Interaktion
---------------------------------------------------------------

type Request  = Integer
type Response = Integer
type Result   = Integer

system = let resps        =  server  reqs  
             (reqs,ress)  =  client2 resps 
         in ress


server :: [Request]  -> [Response]
server = map (\ x -> x+x)  


client :: [Response] -> ([Request],[Result])
client rs@(~(a:as)) = (2:req:as,rs)
       where req = if a == 0 then 1 else a 

client2 :: [Response] -> ([Request],[Result])
client2 rs = (2:req:as,rs)
       where req = if a == 0 then 1 else a 
             (a:as) = rs
             
---- Lazy Pattern in unzip-Definition
--unzip   :: [(a,b)] -> ([a],[b])
--unzip   = foldr (\(a,b) ~(as,bs) -> (a:as, b:bs)) 
--		([], [])

unzip2   :: [(a,b)] -> ([a],[b])
unzip2   = foldr (\(a,b) (as,bs) -> (a:as, b:bs)) 
		([], [])

pl :: [(Bool,Bool)]
pl = [(True,False), error "Ups"] 		
		



---------------------------------------------------------------
-- Strombasierte Ein-/Ausgabe mit interact
---------------------------------------------------------------

-- interact :: (String -> String) -> IO ()  
-- interact f = do cs <- getContents 
--                 putStr (f cs)
--
-- getContents :: IO String
-- liefert die Eingabe als Character-Strom (lazy list)

infixl 9 >.>
g >.> f = f.g

readAndReverse :: String -> String
readAndReverse =  (lines >.> mapUntil (==[]) reverse >.> unlines)
                  >.> ("Type in a line, please!\n"++)


mapUntil            :: (a -> Bool) -> (a->a) -> [a] -> [a]
mapUntil p f []     =  []
mapUntil p f (x:xs) 
        | (p x)     =  []
        | otherwise =  (f x) : mapUntil p f xs



-- vergleichbares Verhalten mit monadischer IO
readRevWrite :: IO ()  
readRevWrite =  do  putStr "Type in a line, please!\n"
                    l <- getLine 
                    if l == [] then return ()
                               else do  putStr ((reverse l) ++ "\n")
                                        readRevWrite


-- mit monadischer Kontrollstruktur While
while :: (a -> Bool) -> IO a       -> IO ()
while    test           action 
   =  loop 
      where loop  = do val <- action
                       if test val then loop
                                   else return ()

readRevWrite1 :: IO String  -- einzelne Zeile bearbeiten
readRevWrite1 =  do inp <- getLine 
                    cs  <- apply reverse inp
                    putStr (cs ++ "\n")
                    return cs

apply :: (a->b) -> a -> IO b
apply    f         x =  return (f x)

interactReadAndRev2 :: IO ()
interactReadAndRev2 =  while (not.null) readRevWrite1 

-- mit Eingabeaufforderungen
readAndReverse' :: String -> String
readAndReverse' =  lines >.> mapUntil (==[]) ((++"\nType in a line, please?" ).reverse) >.> unlines
                   >.> ("Type in a line, please?\n" ++)



----------------------------------------------------------------------
-- Interaktives Palindrom-Testprogramm mit interact
----------------------------------------------------------------------

palindrome line = (line == reverse line)

test :: String -> String
test =  (lines >.> mapUntil (==[]) process >.> unlines)
        >.> ("Type in a line, please?\n" ++)

process :: String -> String
process line | line == []       = "Good bye\n"
             | palindrome line  = line ++ " is a palindrome!\n"     ++ prompt
             | otherwise        = line ++ " is not a palindrome!\n" ++ prompt
             where prompt = "Type in a line, please?"