fprog2021WS/code/Angabe5.hs

module Angabe5 where
import Data.List

{- 1. Vervollstaendigen Sie gemaess Angabentext!
   2. Vervollständigen Sie auch die vorgegebenen Kommentaranfänge!
   3. Loeschen Sie keine Deklarationen aus diesem Rahmenprogramm, auch nicht die Modulanweisug!
   4. Achten Sie darauf, dass `Gruppe' Leserechte fuer Ihre Abgabedatei hat!
-}


type Nat0 = Int


-- Die selbstdefinierte Typklasse Menge_von:

class Eq a => Menge_von a where
   leer          :: [] a
   vereinige     :: [] a -> [] a -> [] a
   schneide      :: [] a -> [] a -> [] a
   ziehe_ab      :: [] a -> [] a -> [] a
   ist_teilmenge :: [] a -> [] a -> Bool
   ist_obermenge :: [] a -> [] a -> Bool
   ist_element   :: a -> [] a -> Bool
   ist_leer      :: [] a -> Bool
   sind_gleich   :: [] a -> [] a -> Bool
   anzahl        :: a -> [] a -> Nat0

   -- Protoimplementierungen
   leer = []
   vereinige xs ys     = clear_duplicates (xs ++ ys)
   schneide xs ys      = xs \\ (xs \\ ys)
   ziehe_ab xs ys      = xs \\ (intersectBy (==) xs ys)
   ist_teilmenge xs ys = (length (ziehe_ab xs ys) == 0)
   ist_obermenge xs ys = ist_teilmenge ys xs
   ist_element x xs    = anzahl x xs >= 1
   anzahl x xs         = if (has_duplicates xs) then error "Fehler" else (length . filter (== x)) xs
   ist_leer xs         = xs == leer
   sind_gleich xs ys   = ist_teilmenge xs ys && ist_teilmenge ys xs

clear_duplicates :: Eq a => [a] -> [a]
clear_duplicates [] = []
clear_duplicates (x:xs) = x : filter (/= x) (clear_duplicates xs)

has_duplicates:: Eq a => [a] -> Bool
has_duplicates [] = False
has_duplicates (x:xs) = if x `elem` xs then True else has_duplicates xs

-- Weitere Typen:

newtype Paar a b = P (a,b) deriving (Eq,Show)

data Zahlraum_0_10 = N | I | II | III | IV | V | VI
                     | VII | VIII | IX | X | F deriving (Eq,Ord,Show)

newtype Funktion = Fkt { f :: Zahlraum_0_10 -> Zahlraum_0_10 }

data Baum a = Blatt a | Knoten (Baum a) a (Baum a) deriving (Eq,Show)

newtype ElemTyp a = ET a

-- Pseudoheterogene Elementtypen
data PH_ElemTyp a b c d e = A a | B b | C c | D d | E e deriving (Eq,Show)
data PH_ElemTyp' q r s    = Q q | R r | S s deriving (Eq,Show)


-- Simple helper functions
roman_to_nat :: Zahlraum_0_10 -> Nat0
roman_to_nat N = 0
roman_to_nat I = 1
roman_to_nat II = 2
roman_to_nat III = 3
roman_to_nat IV = 4
roman_to_nat V = 5
roman_to_nat VI = 6
roman_to_nat VII = 7
roman_to_nat VIII = 8
roman_to_nat IX = 9
roman_to_nat X = 10
roman_to_nat F = -1

nat_to_roman :: Nat0 -> Zahlraum_0_10
nat_to_roman 0 = N
nat_to_roman 1 = I
nat_to_roman 2 = II
nat_to_roman 3 = III
nat_to_roman 4 = IV
nat_to_roman 5 = V
nat_to_roman 6 = VI
nat_to_roman 7 = VII
nat_to_roman 8 = VIII
nat_to_roman 9 = IX
nat_to_roman 10 = X
nat_to_roman n
   | n > 10 = F
   | n < 0 = F
   | otherwise = error "Could not recognize input" -- this should not happen

is_correct_num :: Zahlraum_0_10 -> Bool
is_correct_num n =
   case n of
      F -> False
      _ -> True

-- Aufgabe A.1

instance Num Zahlraum_0_10 where
   (+) n n' = add_r n n'
   (-) n n' = diff_r n n'
   (*) n n' = mult_r n n'
   fromInteger n = nat_to_roman (fromInteger n)
   abs n = n
   signum n
      | n == F = F
      | n == N = N
      | otherwise = I

add_r :: Zahlraum_0_10 -> Zahlraum_0_10 -> Zahlraum_0_10
add_r n n'
   | is_correct_num n == False || is_correct_num n' == False = F
   | otherwise = nat_to_roman sum_r
   where
      a = roman_to_nat n
      b = roman_to_nat n'
      sum_r = a + b

diff_r :: Zahlraum_0_10 -> Zahlraum_0_10 -> Zahlraum_0_10
diff_r n n'
   | is_correct_num n == False || is_correct_num n' == False = F
   | otherwise = nat_to_roman dif_r
   where
      a = roman_to_nat n
      b = roman_to_nat n'
      dif_r = a - b

mult_r :: Zahlraum_0_10 -> Zahlraum_0_10 -> Zahlraum_0_10
mult_r n n'
   | is_correct_num n == False || is_correct_num n' == False = F
   | otherwise = nat_to_roman prod_r
   where
      a = roman_to_nat n
      b = roman_to_nat n'
      prod_r = a * b

-- Aufgabe A.2

instance Eq Funktion where
   (==) f f' = (show f) == (show f')

instance Show Funktion where
   show f =
      let
         result = drop 1 (show (build_pairs f N))
      in
      "{" ++ take ((length result) -1) result ++ "}"

build_pairs :: Funktion -> Zahlraum_0_10 -> [(Zahlraum_0_10, Zahlraum_0_10)]
build_pairs fkt arg
   | arg == F && z == F = [(F, F)]
   | otherwise = (arg, z) : (build_pairs fkt (arg + I))
   where
      z = (f fkt) arg

-- Aufgabe A.3

instance Menge_von Int where

instance Menge_von Zahlraum_0_10 where

instance Menge_von Funktion where

-- Aufgabe A.4

instance (Eq a,Eq b) => Menge_von (Paar a b) where

instance Eq a => Menge_von (Baum a) where

-- Aufgabe A.5

instance Eq a => Eq (ElemTyp a) where
   (==) (ET a) (ET b) = a == b

instance Show a => Show (ElemTyp a) where

-- Aufgabe A.6

instance Eq a => Menge_von (ElemTyp a) where

-- Aufgabe A.7

instance (Eq a,Eq b,Eq c,Eq d,Eq e) => Menge_von (PH_ElemTyp a b c d e) where

-- Aufgabe A.8

instance (Eq p,Eq q,Eq r) => Menge_von (PH_ElemTyp' p q r) where