This repository has been archived on 2021-11-27. You can view files and clone it, but cannot push or open issues or pull requests.
fprog2021WS/code/Angabe6.hs

132 lines
4.5 KiB
Haskell

module Angabe6 where
{- 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!
5. Ersetzen Sie die Trivialimplementierungen error "Nicht implementiert" durch
sinnvolle Implementierungen, die die jeweilige Aufgabenstellung erfüllen.
-}
type Nat0 = Int
type Nat1 = Int
type Zeilenzahl = Nat1
type Spaltenzahl = Nat1
type Zeile = Nat1
type Spalte = Nat1
type Skalar = Int
type Matrixtyp = (Zeilenzahl,Spaltenzahl)
type Matrixfkt = Zeile -> Spalte -> Skalar -- ausschliessl. total def. Abb.!
-- Matrizenwerte als Typ und funktionale Darstellung
data MatrixF = Mf { mtyp :: Matrixtyp, mf :: Matrixfkt }
-- Namesvereinbarung fuer den Fehlerwert
fehler = Mf (0,0) (\_ _ -> 0) :: MatrixF
-- helper functions
type Row = [Skalar]
construct_matrix :: MatrixF -> Zeile -> [Row] -> [Row]
construct_matrix m rc res
| rc > numrow = res
| otherwise =
construct_matrix m (rc + 1) (res ++ [(construct_row f numcol rc 1 [])])
where
numcol = snd (mtyp m)
numrow = fst (mtyp m)
f = mf m
construct_row :: Matrixfkt -> Spaltenzahl -> Zeile -> Spalte -> Row -> Row
construct_row f numcol rc cc res
| cc > numcol = res
| otherwise = construct_row f numcol rc (cc + 1) (res ++ [(f rc cc)])
is_correct_matrix :: MatrixF -> Bool
is_correct_matrix m
| height == 0 || width == 0 = False
| fst t == height && snd t == width = True
| otherwise = False
where
t = mtyp m
mtx = construct_matrix m 1 []
height = length mtx
width = length (head mtx)
is_empty :: [Row] -> Bool
is_empty m
| null m = True
| otherwise = False
-- Aufgabe A.1
instance Show MatrixF where
show (Mf t f) = matrix_to_string (construct_matrix (Mf t f) 1 []) "("
matrix_to_string :: [Row] -> String -> String
matrix_to_string matrix res
| is_empty matrix = "()"
| length m /= 0 && null ms = res ++ show m ++ ")"
| otherwise = matrix_to_string ms (res ++ show m ++ " ")
where
m:ms = matrix
-- Aufgabe A.2
matrixtyp :: MatrixF -> Maybe Matrixtyp
matrixtyp (Mf t f)
| not(is_correct_matrix (Mf t f)) = Nothing
| otherwise = (Just (height, width))
where
mtx = construct_matrix (Mf t f) 1 []
height = length mtx
width = length (head mtx)
-- Aufgabe A.4
instance Eq MatrixF where
(Mf t1 f1) == (Mf t2 f2)
| not(is_correct_matrix (Mf t1 f1)) || not(is_correct_matrix (Mf t2 f2)) = error "Gleichheit undefiniert"
| otherwise = show (Mf t1 f1) == show (Mf t2 f2)
(Mf t1 f1) /= (Mf t2 f2)
| not(is_correct_matrix (Mf t1 f1)) || not(is_correct_matrix (Mf t2 f2)) = error "Ungleichheit undefiniert"
| otherwise = show (Mf t1 f1) /= show (Mf t2 f2)
-- Aufgabe A.5
instance Num MatrixF where
(Mf t1 f1) + (Mf t2 f2) = if t1 == t2 then Mf t1 (\x y -> (f1 x y) + (f2 x y)) else fehler
(Mf t1 f1) - (Mf t2 f2) = if t1 == t2 then Mf t1 (\x y -> (f1 x y) - (f2 x y)) else fehler
(Mf t1 f1) * (Mf t2 f2) = if snd t1 == fst t2 then Mf (fst t1, snd t2) (\x y -> (f1 x y) * (f2 x y)) else fehler
negate (Mf t f) = if is_correct_matrix(Mf t f) then Mf t (\x y -> -(f x y)) else fehler
abs (Mf t f) = if is_correct_matrix(Mf t f) then Mf t (\x y -> abs(f x y)) else fehler
signum (Mf t f) = sign (Mf t f)
fromInteger n = Mf (1,1) (\x y -> fromIntegral(n))
sign :: MatrixF -> MatrixF
sign (Mf t f)
| not(is_correct_matrix(Mf t f)) = error "Vorzeichenfunktion undefiniert"
| True `elem` negative =
if False `elem` negative then error "Vorzeichenfunktion undefiniert"
else Mf (1,1) (\x y -> -1)
| True `elem` positive =
if False `elem` positive then error "Vorzeichenfunktion undefiniert"
else Mf (1,1) (\x y -> 1)
| True `elem` nulls =
if False `elem` nulls then error "Vorzeichenfunktion undefiniert"
else Mf (1,1) (\x y -> 0)
| otherwise = error "Vorzeichenfunktion undefiniert"
where
m = (Mf t f)
m' = construct_matrix m 1 []
negative = boolMatrixToList (map (map (<0)) m') []
nulls = boolMatrixToList (map (map (==0)) m') []
positive = boolMatrixToList (map (map (>0)) m') []
boolMatrixToList :: [[Bool]] -> [Bool] -> [Bool]
boolMatrixToList (m:ms) res
| null m = res
| length m /= 0 && null ms = res ++ m
| otherwise = boolMatrixToList ms (res ++ m)