cleaned init

src/Aufgabe4.hs

@@ -0,0 +1,109 @@
+-- Aufgabe 4
+-- =========
+
+module Aufgabe4 where
+
+import Control.Monad
+
+
+-- Mighty List Monad und das Vierfarbenproblem
+-- -------------------------------------------
+
+-- In Vorlesung 2 haben Sie den Vierfarbensatz kennen gelernt. Mithilfe der 
+-- List Monade lassen sich in wenigen Zeilen Code alle gültigen Kombinationen 
+-- von Einfärbungen finden. Reicht einem eine gültige Lösungen, so kann man 
+-- getrost die gleiche Funktion verwenden und Haskells Laziness sorgt dafür, 
+-- dass nur die eine nötige Lösung berechnet wird. 
+
+
+data Farbe = Rot | Gruen | Gelb | Blau
+  deriving (Show, Eq, Enum)
+
+data Landname = Frankreich 
+              | Deutschland 
+              | Niederlande
+              | Grossbritannien
+              | Belgien
+              | Polen
+              | Oesterreich
+              | Ungarn
+              | Island
+              | Schweiz
+              | Luxemburg
+              | Irland
+              | Italien
+              | Portugal
+              | Spanien 
+              | Slowenien
+              | Liechtenstein
+              | Slowakei 
+              | Tschechien
+  deriving (Show,Eq,Enum)
+
+data Land = Land Landname [Landname] 
+  deriving (Show,Eq)
+
+defaultMap = [ Land Frankreich [Spanien, Italien, Schweiz, Deutschland, Luxemburg]
+             , Land Deutschland [Frankreich, Schweiz, Oesterreich, Luxemburg, Polen, Niederlande, Belgien, Tschechien]
+             , Land Niederlande [Deutschland, Belgien]
+             , Land Grossbritannien [Irland]
+             , Land Belgien [Frankreich, Deutschland, Luxemburg]
+             , Land Polen [Slowakei, Tschechien, Deutschland]
+             , Land Oesterreich [Italien, Schweiz, Deutschland, Slowakei, Liechtenstein, Slowenien, Ungarn, Tschechien]
+             , Land Ungarn [Oesterreich, Slowenien, Slowakei,Deutschland ]
+             , Land Island [Schweiz]
+             , Land Schweiz [Frankreich, Italien, Oesterreich, Deutschland]
+             , Land Luxemburg [Frankreich, Deutschland]
+             , Land Irland [Grossbritannien]
+             , Land Italien [Frankreich, Schweiz, Oesterreich, Slowenien ]
+             , Land Portugal [Spanien]
+             , Land Spanien [Frankreich, Spanien]
+             , Land Slowenien [Italien, Oesterreich, Ungarn ]
+             , Land Liechtenstein [Schweiz, Oesterreich]
+             , Land Slowakei [Oesterreich, Ungarn, Tschechien]
+             , Land Tschechien [Oesterreich, Slowakei, Polen, Deutschland ]
+             ]
+
+-- Schreiben Sie eine Funktion `gültig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool`, 
+-- die überprüft, ob eine konkrete Landeinfärbung `(Farbe,Land)` vor dem 
+-- Hintergrund bereits bestehender Einfärbungen `[(Farbe,Land)]` gültig ist. 
+-- 'Gültig' bedeutet, dass keine angrenzenden Länder dieselbe Farbe haben. 
+
+gueltig :: (Farbe,Land) -> [(Farbe, Land)] -> Bool
+gueltig (f, (Land _ ns)) xs = undefined
+
+-- Exkurs: Von List comprehensions kennen Sie die Möglichkeit mit Prädikaten zu prüfen, 
+-- ob ein Wert in die Liste aufgenommen werden soll oder nicht. 
+
+listcomp xs = [ x | x <- xs , pred x ]
+
+-- Wenn Sie statt dessen do-Notation verwenden (oder `>>=`...), können Sie die Funktion
+-- `guard :: MonadPlus m => Bool -> m ()` verwenden, um Ihre Prüffunktion innerhalb eines 
+-- do-Blocks unterzubringen. Der Type constraint `MondadPlus` stellt sicher, dass die 
+-- entsprechende Monad-Instanz auch ein neutrales Element `mzero` kennt. Wenn die 
+-- Prüffunktion von `guard` zu `False` auswertet, wird die Berechnung durch ein `mzero`
+-- unterbrochen: 
+
+doNotation xs = do 
+  x <- xs 
+  guard $ pred x
+  return x
+
+-- Vervollständigen Sie nun die folgenden, rekursiven Funktionen, welche alle gültigen
+-- Einfärbungen einer Liste von Ländern berechnet. Benutzen Sie hierfür die Ihre 
+-- `gültig-`Funktion. Beide Funktionen machen das Gleiche, aber zu Übungszwecken 
+-- nutzen Sie für `einfaerbenM` do-Notation und für `einfaerbenLC` List comprehension.
+
+einfaerbenM :: [Land] -> [[(Farbe,Land)]]
+einfaerbenM (x:[]) = do -- alternativ: pure $ (,) <$> [Rot .. Blau] <*> [x]
+  f <- [Rot .. Blau] 
+  return [(f,x)]
+einfaerbenM (x:xs) = undefined
+
+
+einfaerbenLC :: [Land] -> [[(Farbe,Land)]]
+einfaerbenLC (x:[]) = [ [(f,x)] | f <- [Rot .. Blau] ]
+einfaerbenLC (x:xs) = undefined
+
+result :: String
+result = show $ head $ einfaerbenM defaultMap