From d55b40f6f7ae376a32ccda8424d1a31fc614aa9e Mon Sep 17 00:00:00 2001 From: Ivaylo Ivanov Date: Sun, 21 Nov 2021 20:01:06 +0100 Subject: [PATCH] Add initial UE6 --- code/Angabe6.hs | 80 ++++++++++++++++++++ code/Test6.hs | 191 ++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 271 insertions(+) create mode 100644 code/Angabe6.hs create mode 100644 code/Test6.hs diff --git a/code/Angabe6.hs b/code/Angabe6.hs new file mode 100644 index 0000000..eada766 --- /dev/null +++ b/code/Angabe6.hs @@ -0,0 +1,80 @@ +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 + + + +-- Aufgabe A.1 + +instance Show MatrixF where + show (Mf t f) = error "Nicht implementiert!" + + +{- Knapp, aber gut nachvollziehbar geht die Instanzbildung fuer Show folgendermassen vor: + ... +-} + + + +-- Aufgabe A.2 + +matrixtyp :: MatrixF -> Maybe Matrixtyp +matrixtyp (Mf t f) = error "Nicht implementiert!" + + + +{- Knapp, aber gut nachvollziehbar geht natrixtyp folgendermassen vor: + ... +-} + + + +-- Aufgabe A.4 + +instance Eq MatrixF where + (Mf t1 f1) == (Mf t2 f2) = error "Nicht implementiert!" + +{- Knapp, aber gut nachvollziehbar geht die Instanzbildung fuer Eq folgendermassen vor: + ... +-} + + + +-- Aufgabe A.5 + +instance Num MatrixF where + (Mf t1 f1) + (Mf t2 f2) = error "Nicht implementiert!" + (Mf t1 f1) - (Mf t2 f2) = error "Nicht implementiert!" + (Mf t1 f1) * (Mf t2 f2) = error "Nicht implementiert!" + negate (Mf t f) = error "Nicht implementiert!" + abs (Mf t f) = error "Nicht implementiert!" + signum (Mf t f) = error "Nicht implementiert!" + fromInteger n = error "Nicht implementiert!" + + +{- Knapp, aber gut nachvollziehbar geht die Instanzbildung fuer Num folgendermassen vor: + ... +-} \ No newline at end of file diff --git a/code/Test6.hs b/code/Test6.hs new file mode 100644 index 0000000..11f1136 --- /dev/null +++ b/code/Test6.hs @@ -0,0 +1,191 @@ +module Test6 where + +import Angabe6 +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.Ingredients (composeReporters) +import Test.Tasty.Ingredients.ConsoleReporter (consoleTestReporter) +import Control.Exception (ErrorCall(ErrorCallWithLocation), try, evaluate) + +main :: IO () +main = defaultMainWithIngredients [consoleTestReporter] spec + +{-----TESTDATEN BEGINN-----} +m0 = Mf (2,2) (\_ _ -> 0) :: MatrixF +m1 = Mf (2,2) (\z s -> if z == 1 then s else z+s) :: MatrixF +m2 = Mf (2,2) (\z s -> s + ((z-1)*(snd (2,2)))) :: MatrixF +m3 = Mf (2,2) (\z s -> s + ((z-1)*(snd (mtyp m2)))) :: MatrixF +m4 = Mf (2,2) (\z s -> if z == 1 then (succ (fib (s-1))) else ((+) z (binom z (s-1)))) :: MatrixF +m5 = Mf (3,2) (\z s -> if z == 1 then s else if z == 2 then z+s else succ (z+s+1)) :: MatrixF +m6 = Mf (3,2) (\z s -> z*s + ((z-1)*(snd (mtyp m5)))) :: MatrixF +mF = Mf (0,0) (\_ _ -> 0) :: MatrixF +m7 = Mf (1,0) (\z s -> z+s) :: MatrixF +m8 = Mf (0,1) (\z s -> z+s) :: MatrixF +m9 = Mf (2,3) (\z s -> z-s) :: MatrixF +m10 = Mf (2,2) (\_ _ -> -5) :: MatrixF +m11 = Mf (5,9) (\z s -> (z * (-s) + fib s)) :: MatrixF +m12 = Mf (9,5) (\z s -> (z * s) `mod` 4) :: MatrixF + +-- Hilfsfunktionen +fib :: Nat0 -> Nat1 +fib 0 = 0 +fib 1 = 1 +fib n = fib (n-2) + fib (n-1) + +binom :: Nat0 -> Nat0 -> Nat1 +binom n k + | n == 0 || n == k = 1 + | otherwise = binom (n-1) (k-1) + binom (n-1) k + +-- Error Messages +errGl = "Gleichheit undefiniert" :: String +errUn = "Ungleichheit undefiniert" :: String +errSg = "Vorzeichenfunktion undefiniert" :: String +{-----TESTDATEN ENDE-----} + + +getMsg :: ErrorCall -> String +getMsg (ErrorCallWithLocation msg _) = msg + +assertError :: (Show a) => String -> a -> IO () +assertError errorMsg action = do + r <- try (evaluate action) + case r of + Left e -> if (getMsg e == errorMsg) then return() + else assertFailure $ "Received unexpected error: " ++ (show e) ++ "\ninstead of: " ++ errorMsg + Right _ -> assertFailure $ "Expected error: " ++ errorMsg + +spec :: TestTree +spec = + testGroup + "Test2 Spec" + [ + showMatrixF_tests, + matrixtyp_tests, + equality_tests, + num_tests + ] + +showMatrixF_tests :: TestTree +showMatrixF_tests = + testGroup + "-show MatrixF Tests----------" + [ + testCase "show m1" $ + show m1 @?= "([1,2] [3,4])", + testCase "show m2" $ + show m2 @?= "([1,2] [3,4])", + testCase "show m3" $ + show m3 @?= "([1,2] [3,4])", + testCase "show m4" $ + show m4 @?= "([1,2] [6,5])", + testCase "show m5" $ + show m5 @?= "([1,2] [3,4] [6,7])", + testCase "show m6" $ + show m6 @?= "([1,2] [4,6] [7,10])", + testCase "show mF" $ + show mF @?= "()", + testCase "show m7" $ + show m7 @?= "()" + ] + +matrixtyp_tests :: TestTree +matrixtyp_tests = + testGroup + "-matrixtyp Tests----------" + [ + testCase "matrixtyp m5" $ + matrixtyp m5 @?= Just (3,2), + testCase "matrixtyp mF" $ + matrixtyp mF @?= Nothing, + testCase "matrixtyp m7" $ + matrixtyp m7 @?= Nothing, + testCase "matrixtyp m8" $ + matrixtyp m8 @?= Nothing + ] + +equality_tests :: TestTree +equality_tests = + testGroup + "-equality Tests----------" + [ + testCase "m1 == m2" $ + m1 == m2 @?= True, + testCase "m1 == m5" $ + m1 == m5 @?= False, + testCase "m1 == mF" $ + assertError errGl (m1 == mF), + testCase "mF == m1" $ + assertError errGl (mF == m1), + testCase "mF == m7" $ + assertError errGl (mF == m7), + testCase "m1 /= m2" $ + m1 /= m2 @?= False, + testCase "m1 /= m5" $ + m1 /= m5 @?= True, + testCase "m1 /= mF" $ + assertError errUn (m1 /= mF), + testCase "mF /= m1" $ + assertError errUn (mF /= m1), + testCase "mF /= m7" $ + assertError errUn (mF /= m7) + ] + +num_tests :: TestTree +num_tests = + testGroup + "-Num Tests----------" + [ + testCase "m1 + m2" $ + show (m1 + m2) @?= "([2,4] [6,8])", + testCase "m1 + m5" $ + show (m1 + m5) @?= "()", + testCase "m1 + mF" $ + show (m1 + mF) @?= "()", + testCase "m1 + m7" $ + show (m1 + m7) @?= "()", + testCase "m7 + m1" $ + show (m7 + m1) @?= "()", + testCase "m1 - m2" $ + show (m1 - m2) @?= "([0,0] [0,0])", + testCase "m1 - m4" $ + show (m1 - m4) @?= "([0,0] [-3,-1])", + testCase "m1 - m5" $ + show (m1 - m5) @?= "()", + testCase "m1 - mF" $ + show (m1 - mF) @?= "()", + testCase "m1 - m7" $ + show (m1 - m7) @?= "()", + testCase "m7 - m1" $ + show (m7 - m1) @?= "()", + testCase "m1 * m2" $ + show (m1 * m2) @?= "([7,10] [15,22])", + testCase "m1 * m5" $ + show (m1 * m5) @?= "()", + testCase "m1 * mF" $ + show (m1 * mF) @?= "()", + testCase "m5 * m9" $ + show (m5 * m9) @?= "([2,-1,-4] [4,-3,-10] [7,-6,-19])", + testCase "m11 * ,12" $ + show (m11 * m12) @?= "([42,60,82,0,42] [-19,10,11,0,-19] [-80,-40,-60,0,-80] [-141,-90,-131,0,-141] [-202,-140,-202,0,-202])", + testCase "negate m0" $ + show (negate m0) @?= "([0,0] [0,0])", + testCase "negate m9" $ + show (negate m9) @?= "([0,1,2] [-1,0,1])", + testCase "negate mF" $ + show (negate mF) @?= "()", + testCase "abs m0" $ + show (abs m0) @?= "([0,0] [0,0])", + testCase "abs m9" $ + show (abs m9) @?= "([0,1,2] [1,0,1])", + testCase "abs mF" $ + show (abs mF) @?= "()", + testCase "signum m0" $ + show (signum m0) @?= "([0])", + testCase "signum m1" $ + show (signum m1) @?= "([1])", + testCase "signum m9" $ + assertError errSg (signum m9), + testCase "signum m10" $ + show (signum m10) @?= "([-1])" + ]