-- Fortgeschrittene Funktionale Programmierung,
--   LMU, TCS, Wintersemester 2015/16
--   Steffen Jost, Alexander Isenko
--
-- Übungsblatt 03 am 3.11.2015
--
-- Thema:
--
-- Anweisung:
--   Gehen Sie diese Datei durch und bearbeiten Sie
--   alle Vorkommen von undefined bzw. die mit -- !!! TODO !!!
--   markierten Stellen. Testen Sie Ihre Lösungen mit GHCi!
--
--

import Data.List (groupBy)
import Data.Function (on)

-- Bearbeiten Sie zuerst Übungsblatt 02 vollständig!


---- A3-1 Funktoren
--
-- Machen Sie folgende Datentypen zur einer Instanz der Klasse Functor.
-- Versuchen Sie dabei, möglichst nicht in die Folien zu schauen!
-- (Falls Sie doch in die Folien schauen, dann möglichst nur 2-25 und 2-31ff.;
-- da die Beispiele 2-28 und 2-29 nahezu die komplette Lösung verraten.)


-- a)
data Options a = None | One a | Two a a | Three a a a
 deriving (Ord, Show)

-- Wenn wir nur die ersten beiden Konstuktoren von "Options" betrachten,
-- dann haben wir genau den Datentyp "Maybe"  aus der Standardbibliothek.

instance Functor Options where
  fmap _ None = None
  fmap f (One a) = One (f a)
  fmap f (Two a b) = Two (f a) (f b)
  fmap f (Three a b c) = Three (f a) (f b) (f c)

-- Zum Testen:
testO0 = None
testO1 = One 4.2
testO2 = Two 4.2 6.9
-- Tests auskommentierbar, sobald Functor Instanz definiert:
testa1 = None == fmap (+2) testO0
testa2 = Two 8.4 13.8 == fmap (*2) testO2


-- b)
data Tree a = Node a [Tree a]
 deriving (Eq, Show)

--Hilfsfunktion
leaf :: a -> Tree a
leaf x = Node x []

instance Functor Tree where
  fmap f (Node a xs) = Node (f a) $ map (fmap f) xs

-- Zum Testen:
testT1 = Node 1 [Node 2 [Node 3 [], leaf 4, Node 5 [leaf 6, leaf 7, leaf 8]], leaf 9, Node 10 [leaf 11]]
testT2 = Node False [Node True [Node False [],leaf True,Node False [leaf True,leaf False,leaf True]],leaf False,Node True [leaf False]]
-- Test auskommentierbar, sobald Functor Instanz definiert:
testb1 = testT2 == (fmap even testT1)




---- A3-2 Funktor (->) a
--
-- Die Standardbibliothek definiert eine Funktor-Instanz für den Typ "(->) a".
-- Wir wollen hier herausfinden, was dies bedeutet:
--
-- Der Typ "(->) a" ist ein Typ mit einem ``Loch'',
-- so wie die Typen "Tree" oder "[ ]" auch.
-- Die runde Klammer bedeutet lediglich Präfix-Notation anstatt Infix-Notation.
-- Wenn wir also einen Typ "b" hineingeben wird daraus der Typ (im vertrauten Infix)
--    a -> b
-- ganz analog wird aus "Tree" oder "[ ]" zu "Tree b" oder "[b]".
--

-- a) Welchen konkreten Typ bekommt die Funktion "fmap"
--    für die Funktor-Instanz von "(->) a"?
--
--    Hinweis: Ein Beispiel findet sich auf Folie 2-26.
--             Oben ist der allgemeine Typ von fmap angegeben.
--             Unten dann nochmal konkreter für die Listen-Instanz.

{-
  fmap :: Functor f => (a -> b) -> f a -> f b
  fmap :: (a -> b) -> (x -> a) -> (x -> b)
-}

-- b) Die Standardbibliothek enthält bereits eine Funktion des in a) gefundenen Typs!
--    Wie heisst diese Funktion und was macht sie?
--    Testen Sie anschließend in GHCI, ob sie die Funktion
--    tatsächlich mit fmap vertauschen können!
--
--    Hinweis: Diese Funktion wird Ihnen in einer Vorlesung über
--             funktionaler Programmierung  mit Sicherheit begegnet sein,
--             da sie von fundamentaler Bedeutung ist.
--             (Jedoch sicherlich nicht als Funktor behandelt... ;) )

{-
  fmap ist hier identisch zu (.)
  λ ((\a -> (a, a)) `fmap` (\i -> i + 2)) 2
  (4,4)
-}




---- A3-3 Unendliche Listen
--
-- a) Definieren Sie die unendliche Liste alle Zweierpotenzen: [1,2,4,8,16,32,64,128,256,..]

quadrate :: [Integer]
quadrate = map (2^) [0..]

-- Zum Testen:
q1 = take 5 quadrate
-- > q1
-- [1,2,4,8,16]
q2 = quadrate !! 10
-- > q2
-- 1024


-- b) Definieren Sie eine unendliche Liste, welche alle
--    erdenklichen Strings aus den Buchstaben ['a','b','c','d'].
--    Die Reihenfolge ist relativ egal, aber kürzere Strings sollen vor längeren Erscheinen;
--    d.h. "dd" kommt nach "b", aber vor "abc"

alleVariablen :: [String]
alleVariablen = seed : alleVariablen' [seed]
  where
    seed = ""
    vars = ['a','b','c','d']
    alleVariablen' prevs = now ++ alleVariablen' now
      where
        now = [v : p | v <- vars, p <- prevs]

-- Zum Testen:
check l x = (map length . groupBy ((==) `on` length)) (take x l)

-- Beispielimplementierung (muss nicht identisch sein):
-- > take 30 alleVariablen
-- [""
-- ,"a"  ,"b"  ,"c"  ,"d"
-- ,"aa" ,"ab" ,"ac" ,"ad" ,"ba" ,"bb" ,"bc" ,"bd" ,"ca" ,"cb","cc","cd","da","db","dc","dd"
-- ,"aaa","aab","aac","aad","aba","abb","abc","abd","aca"]
--
-- Prüfe Längen:
-- > check alleVariablen 30
-- [1,4,16,9]




-- A3-4 Instanzen
-- Wer sich mit Klassen und Instanzen noch nicht so sicher fühlt,
-- sollte zur Übung die automatisch abgeleiteten Instanzdeklaration
-- für die Datentypdeklarationen in A3-1 von Hand deklarieren;
-- also z.B.
--   von "Options" zur Typklassen "Eq"
--   von "Tree a"  zur Typklasse "Ord"
--
-- sie müssen oben in den Datentypdeklarationen dann natürlich
-- die entsprechenden Klassen aus Zeile mit "deriving" herauslöschen
-- da es ja immer nur _eine_ Instanzdeklaration pro Typ/Klassen-Paar geben darf

instance Eq a => Eq (Options a) where
  None == None = True
  None == _ = False
  One a == One a' = a == a'
  One _ == _ = False
  Two a b == Two a' b' = a == a' && b == b'
  Two _ _ == _ = False
  Three a b c == Three a' b' c' = a == a' && b == b' && c == c'
  Three _ _ _ == _ = False

instance Ord a => Ord (Tree a) where
  compare (Node x xs) (Node x' xs') = compare x x' `mappend` compare xs xs'
    where
      -- Siehe Data.Monoid
      mappend LT _ = LT
      mappend EQ EQ = EQ
      mappend EQ LT = LT
      mappend EQ GT = GT
      mappend GT _ = GT