diff options
| author | Mart Lubbers | 2015-04-16 21:22:20 +0200 |
|---|---|---|
| committer | Mart Lubbers | 2015-04-16 21:22:20 +0200 |
| commit | 6f604b19d3f5966e5c1d7c4fdf3703bd6ff0861c (patch) | |
| tree | 96d580507249f7f58368476d9113007d4afcd748 /fp1 | |
| parent | Added student numbers (diff) | |
update to fp2 yay, public and licence
Diffstat (limited to 'fp1')
60 files changed, 2200 insertions, 0 deletions
diff --git a/fp1/week1/camil/1.1/Start.icl b/fp1/week1/camil/1.1/Start.icl new file mode 100644 index 0000000..b56a850 --- /dev/null +++ b/fp1/week1/camil/1.1/Start.icl @@ -0,0 +1,18 @@ +module Start
+
+import StdEnv
+
+Start = expr11
+
+expr0 = "Hello World!"
+expr1 = "Hello " +++ "World!"
+expr2 = 5
+expr3 = 5.5
+//expr4 = 5 + 5.5
+expr5 = [1..10]
+expr6 = (expr1,expr2,expr3,expr5)
+//expr7 = [expr1,expr2,expr3,expr5]
+expr8 = [1,3..10]
+expr9 = ['a'..'z']
+expr10 = ['a','c'..'z']
+expr11 = ['Hello World!']
\ No newline at end of file diff --git a/fp1/week1/camil/1.1/antwoorden.txt b/fp1/week1/camil/1.1/antwoorden.txt new file mode 100644 index 0000000..3a223e2 --- /dev/null +++ b/fp1/week1/camil/1.1/antwoorden.txt @@ -0,0 +1,29 @@ +Antwoorden opgave 1.1 +Camil Staps (s4498062) + +1. Het programma wordt gecompileerd. +2. Het programma wordt uitgevoerd. +3. De data types van de variabelen worden automatisch achterhaald door de IDE (en hoeven dus niet expliciet te worden gegeven door de programmeur) + +expr1 "Hello World!" + De strings worden geconcateneerd +expr2 5 + Dit is een Int waarde +expr3 5.5 + Dit is een Real waarde +expr4 Type error; cannot unify types Real and Int + Dat is omdat + is niet gedefinieerd voor Real met Int +expr5 [1,2,3,4,5,6,7,8,9,10] + Dit is een korte schrijfwijze voor deze lijst ([min..max]) +expr6 ("Hello World!",5,5.5,[1,2,3,4,5,6,7,8,9,10]) + Een tupeltje +expr7 Type error; cannot unify types [Int] and Real + Dat is omdat elementen van een lijst hetzelfde type moeten hebben, en dat hier niet het geval is +expr8 [1,3,5,7,9] + Een andere vorm van expr5 waarmee in het begin wordt aangegeven wat de interval is +expr9 ['a','b','c','d','e','f','g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v','w','x','y','z'] + Een lijst van karakters +expr10 ['a','c','e','g','i','k','m','o','q','s','u','w','y'] + Een combinatie van expr9 en expr8 +expr11 ['H','e','l','l','o',' ','W','o','r','l','d','!'] + Blijkbaar wordt ['...'] als lijst van karakters beschouwd diff --git a/fp1/week1/camil/2.1/NotatieFuncties.icl b/fp1/week1/camil/2.1/NotatieFuncties.icl new file mode 100644 index 0000000..bab2054 --- /dev/null +++ b/fp1/week1/camil/2.1/NotatieFuncties.icl @@ -0,0 +1,39 @@ +module NotatieFuncties
+
+import StdEnv
+
+f1 :: Int
+f1 = 1 + 5
+
+f2 :: Int
+f2 = (+) 1 5
+
+f3 :: Int Int -> Int
+f3 m n
+| m < n = m
+| otherwise = n
+
+f4 :: String Int -> String
+f4 s n
+| n <= 0 = ""
+| otherwise = s +++ f4 s (n-1)
+
+f5 :: Int Int -> Int
+f5 x 0 = x
+f5 x y = f5 y (x rem y)
+
+f6 :: (Int,Int) -> Int
+f6 x = fst x + snd x
+
+f7 :: (a,b) -> (b,a)
+f7 (a,b) = (b,a)
+
+f8 :: (a,a) -> (a,a)
+f8 x = f7 (f7 x)
+
+//Start = (f3 1 5, f3 4 3, f3 6 6)
+//Start = f4 "ab" 4
+//Start = (f5 13 5, f5 8 4, f5 20 20)
+//Start = f6 (2,3)
+//Start = f7 (5,7)
+Start = f8 (5,7)
diff --git a/fp1/week1/camil/2.1/antwoorden.txt b/fp1/week1/camil/2.1/antwoorden.txt new file mode 100644 index 0000000..c0c98d6 --- /dev/null +++ b/fp1/week1/camil/2.1/antwoorden.txt @@ -0,0 +1,8 @@ +f1 5+1=6; constant +f2 Reverse polix notation voor f1; zelfde functie dus +f3 Geeft de kleinste van twee integers terug +f4 Herhaalt s n keer +f5 Geeft de ggd van x en y met Euclides' algoritme +f6 Geeft de optelling x+y voor een tupel (x,y) +f7 Flipt de twee elementen van een tupel +f8 Flipt de twee elementen van een tupel twee keer (heeft geen effect) diff --git a/fp1/week1/camil/2.11/BottlesOfBeer.icl b/fp1/week1/camil/2.11/BottlesOfBeer.icl new file mode 100644 index 0000000..70628a1 --- /dev/null +++ b/fp1/week1/camil/2.11/BottlesOfBeer.icl @@ -0,0 +1,21 @@ +module BottlesOfBeer
+
+import StdEnv
+
+Start = [(fst_line x +++ "\n" +++ snd_line x +++ "\n\n") \\ x <- [99,98..0]]
+
+fst_line :: Int -> String
+fst_line n = btl n True +++ wall +++ ", " +++ btl n False +++ " of beer."
+
+snd_line :: Int -> String
+snd_line 0 = "Go to the store and buy some more, " +++ btl 99 False +++ wall +++ "."
+snd_line n = "Take one down and pass it around, " +++ btl (n-1) False +++ wall +++ "."
+
+btl :: Int Bool -> String
+btl 0 True = "No more bottles"
+btl 0 False = "no more bottles"
+btl 1 b = "1 bottle"
+btl n b = toString n +++ " bottles"
+
+wall :: String
+wall = " of beer on the wall"
\ No newline at end of file diff --git a/fp1/week1/camil/2.2/VindtDeRedex.icl b/fp1/week1/camil/2.2/VindtDeRedex.icl new file mode 100644 index 0000000..c7ec330 --- /dev/null +++ b/fp1/week1/camil/2.2/VindtDeRedex.icl @@ -0,0 +1,17 @@ +module VindtDeRedex
+
+import StdEnv
+
+e1 = 42
+
+e2 = 1 + 125 * 8 / 10 - 59
+
+e3 = not True || True && False
+
+e4 = 1 + 2 == 6 - 3
+
+e5 = "1 + 2" == "6 - 3"
+
+e6 = "1111 + 2222" == "1111" +++ " + " +++ "2222"
+
+Start = e6
diff --git a/fp1/week1/camil/2.2/antwoorden.txt b/fp1/week1/camil/2.2/antwoorden.txt new file mode 100644 index 0000000..413465c --- /dev/null +++ b/fp1/week1/camil/2.2/antwoorden.txt @@ -0,0 +1,42 @@ +e1 = 42 Is elementair + +e2 = 1 + 125 * 8 / 10 - 59 +e2 = (1 + ((125 * 8) / 10)) - 59 + ------- +e2 = (1 + (1000 / 10)) - 59 + --------- +e2 = (1 + 100) - 59 + ------- +e2 = 101 - 59 + -------- +e2 = 42 + +e3 = not True || True && False +e3 = (not True) || (True && False) + -------- +e3 = False || (True && False) + ------------- +e3 = False || False + -------------- +e3 = False + +e4 = 1 + 2 == 6 - 3 +e4 = (1 + 2) == (6 - 3) + ----- +e4 = 3 == (6 - 3) + ----- +e4 = 3 == 3 +e4 = True + +e5 = "1 + 2" == "6 - 3" + ------------------ +e5 = False + +e6 = "1111 + 2222" == "1111" +++ " + " +++ "2222" +e6 = "1111 + 2222" == (("1111" +++ " + ") +++ "2222") + ----------------- +e6 = "1111 + 2222" == ("1111 + " +++ "2222") + -------------------- +e6 = "1111 + 2222" == "1111 + 2222" + ------------------------------ +e6 = True diff --git a/fp1/week1/camil/2.3/MatchStrings.dcl b/fp1/week1/camil/2.3/MatchStrings.dcl new file mode 100644 index 0000000..527447c --- /dev/null +++ b/fp1/week1/camil/2.3/MatchStrings.dcl @@ -0,0 +1,8 @@ +definition module MatchStrings
+
+head :: String -> Char
+tail :: String -> String
+is_gelijk :: String String -> Bool
+is_deelstring :: String String -> Bool
+is_deel :: String String -> Bool
+is_match :: String String -> Bool
diff --git a/fp1/week1/camil/2.3/MatchStrings.icl b/fp1/week1/camil/2.3/MatchStrings.icl new file mode 100644 index 0000000..17859ae --- /dev/null +++ b/fp1/week1/camil/2.3/MatchStrings.icl @@ -0,0 +1,48 @@ +implementation module MatchStrings
+
+import StdEnv
+
+head :: String -> Char
+head "" = abort "head uitgevoerd op lege string"
+head s = s.[0]
+
+tail :: String -> String
+tail "" = abort "tail uitgevoerd op lege string"
+tail s = s % (1, size s - 1)
+
+is_gelijk :: String String -> Bool
+is_gelijk "" "" = True
+is_gelijk a "" = False
+is_gelijk "" b = False
+is_gelijk a b = (head a == head b) && (is_gelijk (tail a) (tail b))
+
+is_deelstring :: String String -> Bool
+is_deelstring "" b = True
+is_deelstring a "" = False
+is_deelstring a b = is_gelijk a (b % (0, size a - 1)) || is_deelstring a (tail b)
+
+is_deel :: String String -> Bool
+is_deel "" b = True
+is_deel a "" = False
+is_deel a b = head a == head b && is_deel (tail a) (tail b) || is_deel a (tail b)
+
+is_match :: String String -> Bool
+is_match "" "" = True
+is_match "" b = False
+is_match "*" "" = True
+is_match a "" = False
+is_match a b = (head a == '.' || head a == head b) && is_match (tail a) (tail b) || head a == '*' && (is_match a (tail b) || is_match (tail a) b)
+
+//Start = (head pink_floyd, tail pink_floyd)
+//Start = is_gelijk "" " "
+//Start = is_deelstring "there" pink_floyd
+//Start = is_deelstring "there" marillion
+//Start = is_deel "there" marillion
+//Start = is_deel "she and her" pink_floyd
+//Start = is_deel radiohead pink_floyd
+//Start = is_match "*.here*.here*." pink_floyd
+//Start = is_match ".here.here." pink_floyd
+
+pink_floyd = "Is there anybody in there?"
+marillion = "Just for the record"
+radiohead = "There there"
diff --git a/fp1/week1/mart/1.txt b/fp1/week1/mart/1.txt new file mode 100644 index 0000000..7ac4230 --- /dev/null +++ b/fp1/week1/mart/1.txt @@ -0,0 +1,3 @@ +1.1: +1.2: +Beide niet mogelijk zonder IDE(linux) diff --git a/fp1/week1/mart/MatchStrings.dcl b/fp1/week1/mart/MatchStrings.dcl new file mode 100644 index 0000000..527447c --- /dev/null +++ b/fp1/week1/mart/MatchStrings.dcl @@ -0,0 +1,8 @@ +definition module MatchStrings
+
+head :: String -> Char
+tail :: String -> String
+is_gelijk :: String String -> Bool
+is_deelstring :: String String -> Bool
+is_deel :: String String -> Bool
+is_match :: String String -> Bool
diff --git a/fp1/week1/mart/MatchStrings.icl b/fp1/week1/mart/MatchStrings.icl new file mode 100644 index 0000000..f10df45 --- /dev/null +++ b/fp1/week1/mart/MatchStrings.icl @@ -0,0 +1,54 @@ +implementation module MatchStrings
+
+import StdEnv
+
+head :: String -> Char
+head "" = abort "Empty String"
+head s = s.[0]
+
+tail :: String -> String
+tail "" = abort "Empty String"
+tail s = s % (1, size s - 1)
+
+is_gelijk :: String String -> Bool
+is_gelijk "" "" = True
+is_gelijk a b = (size a == size b) && (head a == head b) && is_gelijk (tail a) (tail b)
+
+is_deelstring :: String String -> Bool
+is_deelstring _ "" = False
+is_deelstring a b = is_begin a b || is_deelstring a (tail b)
+
+is_begin :: String String -> Bool
+is_begin "" _ = True
+is_begin _ "" = False
+is_begin a b = head a == head b && is_begin (tail a) (tail b)
+
+is_deel :: String String -> Bool
+is_deel "" _ = True
+is_deel _ "" = False
+is_deel a b = head a == head b && is_deel (tail a) (tail b) || is_deel a (tail b)
+
+is_match :: String String -> Bool
+is_match a b = is_begin_match a b || size b > 0 && is_begin_match a (tail b)
+
+is_begin_match :: String String -> Bool
+is_begin_match "" _ = True
+is_begin_match a "" = head a == '*' && size a == 1
+is_begin_match a b
+| head a == '.' || head a == head b = is_begin_match (tail a) (tail b)
+| head a == '*' = is_begin_match a (tail b) || is_begin_match (tail a) b
+| otherwise = False
+
+//Start= (head pink_floyd, tail pink_floyd)
+//Start= is_gelijk "" " "
+//Start= is_deelstring "there" pink_floyd
+//Start= is_deelstring "there" marillion
+//Start= is_deel "there" marillion
+//Start= is_deel "she and her" pink_floyd
+//Start= is_deel radiohead pink_floyd
+//Start= is_match "*.here*.here*." pink_floyd
+//Start= is_match ".here.here." pink_floyd
+
+pink_floyd= "Is there anybody in there?"
+marillion= "Just for the record"
+radiohead= "There there"
diff --git a/fp1/week2/camil/Makefile b/fp1/week2/camil/Makefile new file mode 100644 index 0000000..9095df9 --- /dev/null +++ b/fp1/week2/camil/Makefile @@ -0,0 +1,4 @@ +all: + clm StdT -o StdT + clm TupleOverloading -o TupleOverloading + clm VectorOverloading -o VectorOverloading diff --git a/fp1/week2/camil/StdT.dcl b/fp1/week2/camil/StdT.dcl new file mode 100644 index 0000000..ca97fdc --- /dev/null +++ b/fp1/week2/camil/StdT.dcl @@ -0,0 +1,18 @@ +definition module StdT
+
+import StdOverloaded
+
+:: T
+
+instance == T
+instance < T
+
+instance zero T
+instance + T
+instance - T
+
+instance toInt T
+instance fromInt T
+
+instance toString T
+instance fromString T
diff --git a/fp1/week2/camil/StdT.icl b/fp1/week2/camil/StdT.icl new file mode 100644 index 0000000..03c8645 --- /dev/null +++ b/fp1/week2/camil/StdT.icl @@ -0,0 +1,37 @@ +/**
+ * Mart Lubbers, s4109503
+ * Camil Staps, s4498062
+ */
+
+implementation module StdT
+
+import StdEnv
+
+:: T = {m :: Int, s :: Int}
+
+instance == T where == a b = a.m == b.m && a.s == b.s
+instance < T where < a b = a.m < b.m || a.m == b.m && a.s < b.s
+
+instance zero T where zero = {m = zero, s = zero}
+instance + T where + a b = fromInt (toInt a + toInt b)
+instance - T where - a b = if (a < b) zero (fromInt (toInt a - toInt b))
+
+instance toInt T where toInt a = a.m * 60 + a.s
+instance fromInt T where fromInt n = if (n < 0) zero {m = n/60, s = n rem 60}
+
+instance toString T where
+ toString {m = x, s = 0} = toString x +++ ":00"
+ toString a = toString a.m +++ ":" +++ (if (a.s < 10) "0" "") +++ toString a.s
+instance fromString T where
+ fromString s = if (s.[size s - 3] == ':')
+ {m = toInt (s % (0, size s - 4)), s = toInt (s % (size s - 2, size s - 1))}
+ zero
+
+Start :: (Bool, Bool, T, T, T, Int, String, T, T)
+Start = (LOTR == Tea, Tea < LOTR,
+ zero + LOTR, LOTR + Tea, Tea - LOTR,
+ toInt LOTR, toString Tea,
+ fromString "5:40", fromString "foo")
+
+LOTR = {m=178, s=0}
+Tea = {m=0,s=41}
diff --git a/fp1/week2/camil/TupleOverloading.dcl b/fp1/week2/camil/TupleOverloading.dcl new file mode 100644 index 0000000..6831948 --- /dev/null +++ b/fp1/week2/camil/TupleOverloading.dcl @@ -0,0 +1,25 @@ +definition module TupleOverloading
+
+import StdEnv
+
+instance + (a,b) | + a & + b
+instance + (a,b,c) | + a & + b & + c
+
+
+instance - (a,b) | - a & - b
+instance - (a,b,c) | - a & - b & - c
+
+instance * (a,b) | * a & * b
+instance * (a,b,c) | * a & * b & * c
+
+instance / (a,b) | / a & / b
+instance / (a,b,c) | / a & / b & / c
+
+instance zero (a,b) | zero a & zero b
+instance zero (a,b,c) | zero a & zero b & zero c
+
+instance one (a,b) | one a & one b
+instance one (a,b,c) | one a & one b & one c
+
+instance ~ (a,b) | ~ a & ~ b
+instance ~ (a,b,c) | ~ a & ~ b & ~ c
diff --git a/fp1/week2/camil/TupleOverloading.icl b/fp1/week2/camil/TupleOverloading.icl new file mode 100644 index 0000000..0ea437d --- /dev/null +++ b/fp1/week2/camil/TupleOverloading.icl @@ -0,0 +1,53 @@ +/**
+ * Mart Lubbers, s4109503
+ * Camil Staps, s4498062
+ */
+
+implementation module TupleOverloading
+
+import StdEnv
+
+instance + (a,b) | + a & + b where
+ + (a,b) (c,d) = (a+c,b+d)
+instance + (a,b,c) | + a & + b & + c where
+ + (a,b,c) (d,e,f) = (a+d,b+e,c+f)
+
+instance - (a,b) | - a & - b where
+ - (a,b) (c,d) = (a-c,b-d)
+instance - (a,b,c) | - a & - b & - c where
+ - (a,b,c) (d,e,f) = (a-d,b-e,c-f)
+
+instance * (a,b) | * a & * b where
+ * (a,b) (c,d) = (a*c,b*d)
+instance * (a,b,c) | * a & * b & * c where
+ * (a,b,c) (d,e,f) = (a*d,b*e,c*f)
+
+instance / (a,b) | / a & / b where
+ / (a,b) (c,d) = (a/c,b/d)
+instance / (a,b,c) | / a & / b & / c where
+ / (a,b,c) (d,e,f) = (a/d,b/e,c/f)
+
+instance zero (a,b) | zero a & zero b where
+ zero = (zero, zero)
+instance zero (a,b,c) | zero a & zero b & zero c where
+ zero = (zero, zero, zero)
+
+instance one (a,b) | one a & one b where
+ one = (one, one)
+instance one (a,b,c) | one a & one b & one c where
+ one = (one, one, one)
+
+instance ~ (a,b) | ~ a & ~ b where
+ ~ (a,b) = (~ a, ~ b)
+instance ~ (a,b,c) | ~ a & ~ b & ~ c where
+ ~ (a,b,c) = (~ a, ~ b, ~ c)
+
+Start = (test (1,2), test (1,2,3))
+
+test a = ( zero + a == a && a == a + zero
+ , a - zero == a && a == ~ (zero - a)
+ , one * a == a && a == a * one
+ , zero * a == zero && zero == a * zero
+ , a / one == a
+ , ~ (~ a) == a
+ )
diff --git a/fp1/week2/camil/VectorOverloading.dcl b/fp1/week2/camil/VectorOverloading.dcl new file mode 100644 index 0000000..76f8520 --- /dev/null +++ b/fp1/week2/camil/VectorOverloading.dcl @@ -0,0 +1,14 @@ +definition module VectorOverloading
+
+import StdEnv
+
+:: Vector2 a = {x0 :: a, x1 :: a}
+
+instance == (Vector2 a) | == a
+instance zero (Vector2 a) | zero a
+instance one (Vector2 a) | one a
+instance ~ (Vector2 a) | ~ a
+instance + (Vector2 a) | + a
+instance - (Vector2 a) | - a
+instance * (Vector2 a) | * a
+instance / (Vector2 a) | / a
diff --git a/fp1/week2/camil/VectorOverloading.icl b/fp1/week2/camil/VectorOverloading.icl new file mode 100644 index 0000000..4c9c84a --- /dev/null +++ b/fp1/week2/camil/VectorOverloading.icl @@ -0,0 +1,37 @@ +/**
+ * Mart Lubbers, s4109503
+ * Camil Staps, s4498062
+ */
+
+implementation module VectorOverloading
+
+import StdEnv
+
+:: Vector2 a = {x0 :: a, x1 :: a}
+
+instance == (Vector2 a) | == a where
+ == a b = a.x0 == b.x0 && a.x1 == b.x1
+instance zero (Vector2 a) | zero a where
+ zero = {x0 = zero, x1 = zero}
+instance one (Vector2 a) | one a where
+ one = {x0 = one, x1 = one}
+instance ~ (Vector2 a) | ~ a where
+ ~ a = {x0 = ~a.x0, x1 = ~a.x1}
+instance + (Vector2 a) | + a where
+ + a b = {x0 = a.x0 + b.x0, x1 = a.x1 + b.x1}
+instance - (Vector2 a) | - a where
+ - a b = {x0 = a.x0 - b.x0, x1 = a.x1 - b.x1}
+instance * (Vector2 a) | * a where
+ * a b = {x0 = a.x0 * b.x0, x1 = a.x1 * b.x1}
+instance / (Vector2 a) | / a where
+ / a b = {x0 = a.x0 / b.x0, x1 = a.x1 / b.x1}
+
+Start = test {x0=1,x1=2}
+
+test a = ( zero + a == a && a == a + zero
+ , a - zero == a && a == ~ (zero - a)
+ , one * a == a && a == a * one
+ , zero * a == zero && zero == a * zero
+ , a / one == a
+ , ~ (~ a) == a
+ )
diff --git a/fp1/week2/mart/Makefile b/fp1/week2/mart/Makefile new file mode 100644 index 0000000..a35595b --- /dev/null +++ b/fp1/week2/mart/Makefile @@ -0,0 +1,21 @@ +PATHS=-I ~/downloads/clean/lib/StdLib -I ~/downloads/clean/lib/MersenneTwister/ -I ~/downloads/usr/lib64/clean/Gast/ -I ~/downloads/clean/lib/Generics/ +FLAGS=-v + +all: tuple vector stdtime + +tuple: TupleOverloading.icl TupleOverloading.dcl + clm $(FLAGS) $(PATHS) TupleOverloadingTest -o TupleOverloadingTest + +vector: VectorOverloading.icl VectorOverloading.dcl + clm $(FLAGS) $(PATHS) VectorOverloadingTest -o VectorOverloadingTest + +stdtime: StdT.icl StdT.dcl + clm $(FLAGS) $(PATHS) StdTTest -o StdTTest + +testall: + ./StdTTest + ./TupleOverloadingTest + ./VectorOverloadingTest + +clean: + $(RM) -r Clean\ System\ Files a.out TupleOverloadingTest VectorOverloadingTest StdTTest diff --git a/fp1/week2/mart/StdT.dcl b/fp1/week2/mart/StdT.dcl new file mode 100644 index 0000000..f4f0d75 --- /dev/null +++ b/fp1/week2/mart/StdT.dcl @@ -0,0 +1,18 @@ +definition module StdT
+
+import StdOverloaded
+
+:: T
+
+instance == T
+instance < T
+
+instance zero T
+instance + T
+instance - T
+
+instance toInt T
+instance fromInt T
+
+instance toString T
+instance fromString T
diff --git a/fp1/week2/mart/StdT.icl b/fp1/week2/mart/StdT.icl new file mode 100644 index 0000000..01bee7d --- /dev/null +++ b/fp1/week2/mart/StdT.icl @@ -0,0 +1,35 @@ +implementation module StdT
+
+import StdEnv
+
+:: T = {m :: Int, s :: Int}
+
+instance == T where
+ == a b = a.m == b.m && a.s == b.s
+instance < T where
+ < a b = a.m < b.m || a.s == b.s && a.s < b.s
+
+instance zero T where
+ zero = {m=zero, s=zero}
+instance + T where
+ + a b = fromInt (toInt a + toInt b)
+instance - T where
+ - a b = fromInt (toInt a - toInt b)
+
+instance toInt T where
+ toInt a = a.m*60 + a.s
+instance fromInt T where
+ fromInt a
+ | a<0 = zero
+ | otherwise = {m=a/60, s=a rem 60}
+
+instance toString T where
+ toString {m=ms, s=0} = toString ms +++ ":00"
+ toString {m=ms, s=ss}
+ | ss < 10 = toString ms +++ ":0" +++ toString ss
+ | otherwise = toString ms +++ ":" +++ toString ss
+
+instance fromString T where
+ fromString a
+ | a.[size a - 3] == ':' = {m = toInt (a % (0, (size a) - 4)), s = toInt (a % ((size a) - 2, size a))}
+ | otherwise = zero
diff --git a/fp1/week2/mart/StdTTest.icl b/fp1/week2/mart/StdTTest.icl new file mode 100644 index 0000000..6af64fc --- /dev/null +++ b/fp1/week2/mart/StdTTest.icl @@ -0,0 +1,45 @@ +module StdTTest
+
+/* Test module StdTTest
+ Voor werken met Gast:
+ (*) gebruik Environment 'Gast'
+ (*) zet Project Options op 'Basic Values Only'
+*/
+
+import StdT
+import StdEnv
+import gast
+
+Start
+ = testn 1000
+ (\ i ->
+ gelijkheid_is_symmetrisch i /\
+ ordening_is_monotoon i /\
+ negatieve_tijd_bestaat_niet i /\
+ omzetten_naar_Int_is_consistent i /\
+ parse_print_is_consistent i /\
+ True
+ )
+
+t :: Int -> T
+t x = fromInt x
+
+gelijkheid_is_symmetrisch :: Int -> Property
+gelijkheid_is_symmetrisch i = name "gelijkheid_is_symmetrisch"
+ (t i == t i)
+
+ordening_is_monotoon :: Int -> Property
+ordening_is_monotoon i = name "ordening_is_monotoon"
+ ((i <= i+1) ==> t i <= t (i+1))
+
+negatieve_tijd_bestaat_niet :: Int -> Property
+negatieve_tijd_bestaat_niet i = name "negatieve_tijd_bestaat_niet"
+ ((i + 1 >= i) ==> t i - t (i+1) == zero)
+
+omzetten_naar_Int_is_consistent :: Int -> Property
+omzetten_naar_Int_is_consistent i = name "omzetten_naar_Int_is_consistent"
+ ((abs i >= 0) ==> toInt (t (abs i)) == abs i)
+
+parse_print_is_consistent :: Int -> Property
+parse_print_is_consistent i = name "parse_print_is_consistent"
+ (fromString (toString (t i)) == t i)
diff --git a/fp1/week2/mart/TupleOverloading.dcl b/fp1/week2/mart/TupleOverloading.dcl new file mode 100644 index 0000000..6831948 --- /dev/null +++ b/fp1/week2/mart/TupleOverloading.dcl @@ -0,0 +1,25 @@ +definition module TupleOverloading
+
+import StdEnv
+
+instance + (a,b) | + a & + b
+instance + (a,b,c) | + a & + b & + c
+
+
+instance - (a,b) | - a & - b
+instance - (a,b,c) | - a & - b & - c
+
+instance * (a,b) | * a & * b
+instance * (a,b,c) | * a & * b & * c
+
+instance / (a,b) | / a & / b
+instance / (a,b,c) | / a & / b & / c
+
+instance zero (a,b) | zero a & zero b
+instance zero (a,b,c) | zero a & zero b & zero c
+
+instance one (a,b) | one a & one b
+instance one (a,b,c) | one a & one b & one c
+
+instance ~ (a,b) | ~ a & ~ b
+instance ~ (a,b,c) | ~ a & ~ b & ~ c
diff --git a/fp1/week2/mart/TupleOverloading.icl b/fp1/week2/mart/TupleOverloading.icl new file mode 100644 index 0000000..2995fbd --- /dev/null +++ b/fp1/week2/mart/TupleOverloading.icl @@ -0,0 +1,49 @@ +implementation module TupleOverloading
+
+import StdEnv
+
+instance + (a,b) | + a & + b where
+ + (a,b) (c,d) = (a+c,b+d)
+instance + (a,b,c) | + a & + b & + c where
+ + (a,b,c) (d,e,f) = (a+d,b+e,c+f)
+
+
+instance - (a,b) | - a & - b where
+ - (a,b) (c,d) = (a-c,b-d)
+instance - (a,b,c) | - a & - b & - c where
+ - (a,b,c) (d,e,f) = (a-d,b-e,c-f)
+
+instance * (a,b) | * a & * b where
+ * (a,b) (c,d) = (a*c,b*d)
+instance * (a,b,c) | * a & * b & * c where
+ * (a,b,c) (d,e,f) = (a*d,b*e,c*f)
+
+instance / (a,b) | / a & / b where
+ / (a,b) (c,d) = (a/c,b/d)
+instance / (a,b,c) | / a & / b & / c where
+ / (a,b,c) (d,e,f) = (a/d,b/e,c/f)
+
+instance zero (a,b) | zero a & zero b where
+ zero = (zero,zero)
+instance zero (a,b,c) | zero a & zero b & zero c where
+ zero = (zero,zero,zero)
+
+instance one (a,b) | one a & one b where
+ one = (one,one)
+instance one (a,b,c) | one a & one b & one c where
+ one = (one,one,one)
+
+instance ~ (a,b) | ~ a & ~ b where
+ ~ (a,b) = (~a,~b)
+instance ~ (a,b,c) | ~ a & ~ b & ~ c where
+ ~ (a,b,c) = (~a,~b,~c)
+
+Start = (test (1,2), test (1,2,3))
+
+test a = ( zero + a == a && a == a + zero
+ , a - zero == a && a == ~ (zero - a)
+ , one * a == a && a == a * one
+ , zero * a == zero && zero == a * zero
+ , a / one == a
+ , ~ (~ a) == a
+ )
diff --git a/fp1/week2/mart/TupleOverloadingTest.icl b/fp1/week2/mart/TupleOverloadingTest.icl new file mode 100644 index 0000000..91417f7 --- /dev/null +++ b/fp1/week2/mart/TupleOverloadingTest.icl @@ -0,0 +1,64 @@ +module TupleOverloadingTest + +/* Test module VectorOverloading + Voor werken met Gast: + (*) gebruik Environment 'Gast' + (*) zet Project Options op 'Basic Values Only' +*/ + +import TupleOverloading +import StdEnv +import gast + +Start + = testn 1000 + (\v -> + zero_is_neutral_for_addition v /\ + zero_is_neutral_for_subtraction v /\ + one_is_neutral_for_multiplication v /\ + one_is_neutral_for_division v /\ + negation_is_idempotent v /\ + add_then_subtract_yields_identity v /\ + subtract_then_add_yields_identity v /\ + True + ) + +:: Vector2 a :== (a,a) +:: BaseType + :== Int +// :== Real + +zero_is_neutral_for_addition :: (Vector2 BaseType) -> Property +zero_is_neutral_for_addition a = name "zero_is_neutral_for_addition" + (zero + a == a && a == a + zero) + +zero_is_neutral_for_subtraction :: (Vector2 BaseType) -> Property +zero_is_neutral_for_subtraction a = name "zero_is_neutral_for_subtraction" + (a - zero == a && a == ~ (zero - a)) + +one_is_neutral_for_multiplication :: (Vector2 BaseType) -> Property +one_is_neutral_for_multiplication a = name "one_is_neutral_for_multiplication" + (one * a == a && a == a * one) + +zero_is_zero_for_multiplication :: (Vector2 BaseType) -> Property +zero_is_zero_for_multiplication a = name "zero_is_zero_for_multiplication" + (zero * a == zero && zero == a * zero) + +one_is_neutral_for_division :: (Vector2 BaseType) -> Property +one_is_neutral_for_division a = name "one_is_neutral_for_division" + (a / one == a) + +negation_is_idempotent :: (Vector2 BaseType) -> Property +negation_is_idempotent a = name "negation_is_idempotent" + (~ (~ a) == a) + + +add_then_subtract_yields_identity :: (Vector2 BaseType) -> Property +add_then_subtract_yields_identity a = name "add then subtract" ((a + a) - a == a) + +subtract_then_add_yields_identity :: (Vector2 BaseType) -> Property +subtract_then_add_yields_identity a = name "subtract then add" ((zero - a - a) + a + a == zero) + +//derive genShow (,) +//derive ggen (,) +derive bimap [] diff --git a/fp1/week2/mart/VectorOverloading.dcl b/fp1/week2/mart/VectorOverloading.dcl new file mode 100644 index 0000000..76f8520 --- /dev/null +++ b/fp1/week2/mart/VectorOverloading.dcl @@ -0,0 +1,14 @@ +definition module VectorOverloading
+
+import StdEnv
+
+:: Vector2 a = {x0 :: a, x1 :: a}
+
+instance == (Vector2 a) | == a
+instance zero (Vector2 a) | zero a
+instance one (Vector2 a) | one a
+instance ~ (Vector2 a) | ~ a
+instance + (Vector2 a) | + a
+instance - (Vector2 a) | - a
+instance * (Vector2 a) | * a
+instance / (Vector2 a) | / a
diff --git a/fp1/week2/mart/VectorOverloading.icl b/fp1/week2/mart/VectorOverloading.icl new file mode 100644 index 0000000..74f6f69 --- /dev/null +++ b/fp1/week2/mart/VectorOverloading.icl @@ -0,0 +1,22 @@ +implementation module VectorOverloading
+
+import StdEnv
+
+:: Vector2 a = {x0 :: a, x1 :: a}
+
+instance == (Vector2 a) | == a where
+ == a b = a.x0 == b.x0 && a.x1 == b.x1
+instance zero (Vector2 a) | zero a where
+ zero = {x0=zero, x1=zero}
+instance one (Vector2 a) | one a where
+ one = {x0=one, x1=one}
+instance ~ (Vector2 a) | ~ a where
+ ~ a = {x0= ~a.x0, x1= ~a.x1}
+instance + (Vector2 a) | + a where
+ + a b = {x0=a.x0+b.x0, x1=a.x1+b.x1}
+instance - (Vector2 a) | - a where
+ - a b = {x0=a.x0-b.x0, x1=a.x1-b.x1}
+instance * (Vector2 a) | * a where
+ * a b = {x0=a.x0*b.x0, x1=a.x1*b.x1}
+instance / (Vector2 a) | / a where
+ / a b = {x0=a.x0/b.x0, x1=a.x1/b.x1}
diff --git a/fp1/week2/mart/VectorOverloadingTest.icl b/fp1/week2/mart/VectorOverloadingTest.icl new file mode 100644 index 0000000..e5571bb --- /dev/null +++ b/fp1/week2/mart/VectorOverloadingTest.icl @@ -0,0 +1,62 @@ +module VectorOverloadingTest
+
+/* Test module VectorOverloading
+ Voor werken met Gast:
+ (*) gebruik Environment 'Gast'
+ (*) zet Project Options op 'Basic Values Only'
+*/
+
+import VectorOverloading
+import StdEnv
+import gast
+
+Start
+ = testn 1000
+ (\v ->
+ zero_is_neutral_for_addition v /\
+ zero_is_neutral_for_subtraction v /\
+ one_is_neutral_for_multiplication v /\
+ one_is_neutral_for_division v /\
+ negation_is_idempotent v /\
+ add_then_subtract_yields_identity v /\
+ subtract_then_add_yields_identity v /\
+ True
+ )
+
+:: BaseType
+ :== Int
+// :== Real
+
+zero_is_neutral_for_addition :: (Vector2 BaseType) -> Property
+zero_is_neutral_for_addition a = name "zero_is_neutral_for_addition"
+ (zero + a == a && a == a + zero)
+
+zero_is_neutral_for_subtraction :: (Vector2 BaseType) -> Property
+zero_is_neutral_for_subtraction a = name "zero_is_neutral_for_subtraction"
+ (a - zero == a && a == ~ (zero - a))
+
+one_is_neutral_for_multiplication :: (Vector2 BaseType) -> Property
+one_is_neutral_for_multiplication a = name "one_is_neutral_for_multiplication"
+ (one * a == a && a == a * one)
+
+zero_is_zero_for_multiplication :: (Vector2 BaseType) -> Property
+zero_is_zero_for_multiplication a = name "zero_is_zero_for_multiplication"
+ (zero * a == zero && zero == a * zero)
+
+one_is_neutral_for_division :: (Vector2 BaseType) -> Property
+one_is_neutral_for_division a = name "one_is_neutral_for_division"
+ (a / one == a)
+
+negation_is_idempotent :: (Vector2 BaseType) -> Property
+negation_is_idempotent a = name "negation_is_idempotent"
+ (~ (~ a) == a)
+
+add_then_subtract_yields_identity :: (Vector2 BaseType) -> Property
+add_then_subtract_yields_identity a = name "add then subtract" ((a + a) - a == a)
+
+subtract_then_add_yields_identity :: (Vector2 BaseType) -> Property
+subtract_then_add_yields_identity a = name "subtract then add" ((zero - a - a) + a + a == zero)
+
+derive genShow Vector2
+derive ggen Vector2
+derive bimap []
diff --git a/fp1/week2/week2.tar.gz b/fp1/week2/week2.tar.gz Binary files differnew file mode 100644 index 0000000..93c0467 --- /dev/null +++ b/fp1/week2/week2.tar.gz diff --git a/fp1/week3/camil/.gitignore b/fp1/week3/camil/.gitignore new file mode 100644 index 0000000..341d5f8 --- /dev/null +++ b/fp1/week3/camil/.gitignore @@ -0,0 +1,2 @@ +/Clean System Files/ +StdStack diff --git a/fp1/week3/camil/StdSortList.dcl b/fp1/week3/camil/StdSortList.dcl new file mode 100644 index 0000000..556dfc0 --- /dev/null +++ b/fp1/week3/camil/StdSortList.dcl @@ -0,0 +1,18 @@ +definition module StdSortList
+
+import StdClass
+
+:: SortList a
+
+newSortList :: SortList a | zero a // lege gesorteerde lijst
+memberSort :: a (SortList a) -> Bool | Eq, Ord a // is element van
+insertSort :: a (SortList a) -> SortList a | Ord a // voeg element toe
+removeFirst :: a (SortList a) -> SortList a | Eq, Ord, zero a // verwijder eerste voorkomen
+removeAll :: a (SortList a) -> SortList a | Eq, Ord, zero a // verwijder alle voorkomens
+elements :: (SortList a) -> [a] // geef alle elementen
+count :: (SortList a) -> Int // aantal elementen
+
+minimum :: (SortList a) -> a // huidige minimum waarde
+maximum :: (SortList a) -> a // huidige maximum waarde
+
+mergeSortList :: (SortList a) (SortList a) -> SortList a | Eq, Ord, zero a // meng gesorteerde lijsten
diff --git a/fp1/week3/camil/StdSortList.icl b/fp1/week3/camil/StdSortList.icl new file mode 100644 index 0000000..21778bd --- /dev/null +++ b/fp1/week3/camil/StdSortList.icl @@ -0,0 +1,64 @@ +// Ik kreeg het alleen werkend door de .dcl ook aan te passen.
+// Met een record dat het maximum bijhoudt moet je er namelijk vanuit kunnen gaan dat zero gedefinieerd is voor type a.
+
+implementation module StdSortList
+
+import StdEnv
+
+:: SortList a = {list :: [a], max :: a}
+
+newSortList :: (SortList a) | zero a
+newSortList = {list=[], max=zero}
+
+memberSort :: a (SortList a) -> Bool | Eq, Ord a // is element van
+memberSort _ {list=[],max=_} = False
+memberSort m l
+ | minimum l == m = True
+ | minimum l > m = False
+ | otherwise = memberSort m {list=(tl l.list),max=l.max}
+
+insertSort :: a (SortList a) -> SortList a | Ord a // voeg element toe
+insertSort m l = insertSort` {list=[],max=l.max} m l
+where
+ insertSort` :: (SortList a) a (SortList a) -> (SortList a) | Ord a
+ insertSort` l1 m l2
+ | count l2 == 0 = {list=l1.list ++ [m], max=m}
+ | minimum l2 >= m = {list=l1.list ++ [m] ++ l2.list, max=l2.max}
+ | otherwise = insertSort` {list=l1.list ++ [hd l2.list], max=hd l2.list} m {list=(tl l2.list), max=l2.max}
+
+removeFirst :: a (SortList a) -> SortList a | Eq, Ord, zero a // verwijder eerste voorkomen
+removeFirst m l = removeFirst` newSortList m l
+where
+ removeFirst` :: (SortList a) a (SortList a) -> (SortList a) | Eq, Ord a
+ removeFirst` l1 m l2
+ | count l2 == 0 = l1
+ | minimum l2 > m = {list=l1.list ++ l2.list, max=l2.max}
+ | minimum l2 == m && count l2 == 1 = {list=l1.list ++ tl l2.list, max=l1.max}
+ | minimum l2 == m = {list=l1.list ++ tl l2.list, max=l2.max}
+ | otherwise = removeFirst` {list=(l1.list ++ [hd l2.list]),max=hd l2.list} m {list=(tl l2.list), max=l2.max}
+
+removeAll :: a (SortList a) -> SortList a | Eq, Ord, zero a // verwijder alle voorkomens
+removeAll m l = removeAll` newSortList m l
+where
+ removeAll` :: (SortList a) a (SortList a) -> (SortList a) | Eq, Ord a
+ removeAll` l1 m l2
+ | count l2 == 0 = l1
+ | minimum l2 > m = {list=l1.list ++ l2.list, max=l2.max}
+ | minimum l2 == m = removeAll` l1 m {list=tl l2.list, max=l2.max}
+ | otherwise = removeAll` {list=l1.list ++ [hd l2.list], max=hd l2.list} m {list=tl l2.list,max=l2.max}
+
+elements :: (SortList a) -> [a] // geef alle elementen
+elements l = l.list
+
+count :: (SortList a) -> Int // aantal elementen
+count l = length l.list
+
+minimum :: (SortList a) -> a // huidige minimum waarde
+minimum l = hd l.list
+
+maximum :: (SortList a) -> a // huidige maximum waarde
+maximum l = l.max
+
+mergeSortList :: (SortList a) (SortList a) -> SortList a | Eq, Ord, zero a // meng gesorteerde lijsten
+mergeSortList l1 {list=[],max=_} = l1
+mergeSortList l1 l2 = mergeSortList (insertSort (hd l2.list) l1) {list=tl l2.list,max=l2.max}
diff --git a/fp1/week3/camil/StdSortListTest.icl b/fp1/week3/camil/StdSortListTest.icl new file mode 100644 index 0000000..411f7ca --- /dev/null +++ b/fp1/week3/camil/StdSortListTest.icl @@ -0,0 +1,107 @@ +module StdSortListTest
+
+/* Test module StdSortList
+ Voor werken met Gast:
+ (*) gebruik Environment 'Gast'
+ (*) zet Project Options op 'Basic Values Only' en '16M' Maximum Heap Size.
+*/
+
+import gast
+import GenLexOrd
+import StdSortList
+
+Start = testn 10000
+ (\n` n2` m -> let n = lst2slst (cast [A,B,C] n` )
+ n2 = lst2slst (cast [A,B,C] n2`)
+ in
+ leeg_is_leeg /\
+ count_matches_elems n /\
+ is_sorted_elems n /\
+ member_is_member n m /\
+ member_na_insert n m /\
+ member_na_remove n m /\
+ insert_remove_invariant n m /\
+ minimum_property n /\
+ maximum_property n /\
+ merge_additive n n2 /\
+ merge_member n n2 m /\
+ True
+ )
+
+:: Enum = A | B | C
+
+derive bimap []
+derive ggen Enum
+derive genShow Enum
+derive gEq Enum
+derive gLexOrd Enum
+instance == Enum where (==) x y = gEq{|*|} x y
+instance < Enum where (<) x y = gEq{|*|} (gLexOrd{|*|} x y) LT
+
+// clean should have something like this!
+cast :: a a -> a
+cast _ x = x
+
+leeg_is_leeg :: Property
+leeg_is_leeg
+ = name "leeg_is_leeg"
+ (count newSortList == 0)
+
+count_matches_elems :: (SortList a) -> Property | Eq, Ord a
+count_matches_elems n
+ = name "count_matches_elems"
+ (length (elements n) == count n)
+
+is_sorted_elems :: (SortList a) -> Property | Eq, Ord a
+is_sorted_elems n
+ = name "is_sorted_elems"
+ (isSorted (elements n))
+ where isSorted lst = and [ x<=y \\ x<-lst & y<-tl lst ]
+
+member_is_member :: (SortList a) a -> Property | Eq, Ord a
+member_is_member lst e
+ = name "member_is_member"
+ ((isMember e (elements lst)) <==> (memberSort e lst))
+
+member_na_insert :: (SortList a) a -> Property | Eq, Ord a
+member_na_insert lst e
+ = name "member_na_insert"
+ (memberSort e (insertSort e lst))
+
+member_na_remove :: (SortList a) a -> Property | Eq, Ord a
+member_na_remove lst e
+ = name "member_na_remove"
+ (not (memberSort e (removeAll e lst)))
+
+insert_remove_invariant :: (SortList a) a -> Property | Eq, Ord a
+insert_remove_invariant lst e
+ = name "insert_remove_invariant"
+ (memberSort e lst <==> memberSort e lst`)
+ where lst` = removeFirst e (insertSort e lst)
+
+minimum_property :: (SortList a) -> Property | Eq,Ord a
+minimum_property n
+ = name "minimum_property"
+ (count n > 0 ==> (memberSort min n /\ all ((<=) min) (elements n)))
+ where min = minimum n
+
+maximum_property :: (SortList a) -> Property | Eq,Ord a
+maximum_property n
+ = name "maximum_property"
+ (count n > 0 ==> (memberSort max n /\ all ((>=) max) (elements n)))
+ where max = maximum n
+
+merge_member :: (SortList a) (SortList a) a -> Property | Eq,Ord a
+merge_member n m e
+ = name "merge_member"
+ (memberSort e nm <==> (memberSort e n \/ memberSort e m))
+ where nm = mergeSortList n m
+
+merge_additive :: (SortList a) (SortList a) -> Property | Eq,Ord a
+merge_additive n m
+ = name "merge_additive"
+ (count n + count m == count nm)
+ where nm = mergeSortList n m
+
+lst2slst :: [a] -> SortList a | Eq,Ord a
+lst2slst xs = seq (map insertSort xs) newSortList
diff --git a/fp1/week3/camil/StdStack.dcl b/fp1/week3/camil/StdStack.dcl new file mode 100644 index 0000000..8c861a1 --- /dev/null +++ b/fp1/week3/camil/StdStack.dcl @@ -0,0 +1,13 @@ +definition module StdStack
+
+:: Stack a
+
+newStack :: Stack a // lege stack
+push :: a (Stack a) -> Stack a // plaats nieuw element bovenop de stack
+pushes :: [a] (Stack a) -> Stack a // plaats elementen achtereenvolgens bovenop stack
+pop :: (Stack a) -> Stack a // haal top element van stack
+popn :: Int (Stack a) -> Stack a // haal bovenste $n$ top elementen van stack
+top :: (Stack a) -> a // geef top element van stack
+topn :: Int (Stack a) -> [a] // geef bovenste $n$ top elementen van stack
+elements :: (Stack a) -> [a] // geef alle elementen van stack
+count :: (Stack a) -> Int // tel aantal elementen in stack
diff --git a/fp1/week3/camil/StdStack.icl b/fp1/week3/camil/StdStack.icl new file mode 100644 index 0000000..dd51a94 --- /dev/null +++ b/fp1/week3/camil/StdStack.icl @@ -0,0 +1,66 @@ +implementation module StdStack
+
+import StdEnv
+import StdList
+
+:: Stack a :== [a]
+
+newStack :: (Stack a)
+newStack = []
+
+push :: a (Stack a) -> (Stack a)
+push a s = [a] ++ s
+
+pop :: (Stack a) -> (Stack a)
+pop [a:s] = s
+pop [] = []
+
+popn :: Int (Stack a) -> (Stack a)
+popn 0 s = s
+popn n s = popn (n-1) (pop s)
+
+pushes :: [a] (Stack a) -> (Stack a)
+pushes [] s = s
+pushes a s = pushes (tl a) (push (hd a) s)
+
+top :: (Stack a) -> a
+top [] = abort "`top s` with s = []"
+top s = hd s
+
+topn :: Int (Stack a) -> [a]
+topn n s
+ | n > length s = abort "`topn n s` with n > length s"
+ | otherwise = take n s
+
+count :: (Stack a) -> Int
+count s = length s
+
+elements :: (Stack a) -> [a]
+elements s = s
+
+Start = ( "s0 = newStack = ", s0,'\n'
+ , "s1 = push 1 s0 = ", s1,'\n'
+ , "s2 = pushes [2..5] s1 = ",s2,'\n'
+ , "s3 = pop s2 = ", s3,'\n'
+ , "s4 = popn 3 s3 = ", s4,'\n'
+ , "s5 = top s4 = ", s5,'\n'
+ , "s6 = topn 3 s2 = ", s6,'\n'
+ , "s7 = elements s2 = ", s7,'\n'
+// , "s8 = push 10 s1 = ", s8,'\n'
+// , "s9 = popn 10 s8 = ", s9,'\n'
+// , "sa = topn 5 s4 = ", sa,'\n'
+// , "sb = top s0 = ", sb,'\n'
+ )
+where
+ s0 = newStack
+ s1 = push 1 s0
+ s2 = pushes [2..5] s1
+ s3 = pop s2
+ s4 = popn 3 s3
+ s5 = top s4
+ s6 = topn 3 s2
+ s7 = elements s2
+// s8 = push 10 s1
+// s9 = popn 10 s8
+// sa = topn 5 s4
+// sb = top s0
diff --git a/fp1/week3/camil/StdStackTest.icl b/fp1/week3/camil/StdStackTest.icl new file mode 100644 index 0000000..8127f53 --- /dev/null +++ b/fp1/week3/camil/StdStackTest.icl @@ -0,0 +1,60 @@ +module StdStackTest
+
+/* Test module StdStack
+ Voor werken met Gast:
+ (*) gebruik Environment 'Gast'
+ (*) zet Project Options op 'Basic Values Only' en '2M' Maximum Heap Size
+*/
+
+import gast
+import StdStack
+
+Start
+ = testn 1000
+ (\x n ->
+ newStack_is_empty /\
+ stack_is_reverse n /\
+ pop_empty_is_ok /\
+ top_na_push n x /\
+ pop_na_push x /\
+ count_counts n x /\
+ pop_maakt_stack_korter n /\
+ True
+ )
+
+newStack_is_empty :: Property
+newStack_is_empty = name "newStack_is_empty" (isEmpty (elements empty))
+
+stack_is_reverse :: Int -> Property
+stack_is_reverse n = name "stack_is_reverse"
+ (elements (pushes [1..n`] newStack) == reverse [1..n`])
+where n` = min (abs n) 100
+
+pop_empty_is_ok :: Property
+pop_empty_is_ok = name "pop_empty_is_ok" (count (pop empty) == 0)
+
+top_na_push :: Int Int -> Property
+top_na_push x n = name "top_na_push"
+ (top (push x (pushes [1..n`] newStack)) == x)
+where n` = min (abs n) 100
+
+pop_na_push :: Int -> Property
+pop_na_push a = name "pop_na_push"
+ (top (pop (pop (pushes [a,b,c] newStack))) == a)
+where b = a + a + one
+ c = b + a + one
+
+count_counts :: Int Int -> Property
+count_counts n x = name "count_counts"
+ (length (elements stack) == count stack)
+where stack = pushes [1..n`] newStack
+ n` = min (abs n) 100
+
+pop_maakt_stack_korter :: Int -> Property
+pop_maakt_stack_korter n = name "pop_maakt_stack_korter"
+ (count stack == 0 || count (pop stack) == count stack - 1)
+where stack = pushes [1..n`] newStack
+ n` = min (abs n) 100
+
+empty :: Stack Int
+empty = newStack
diff --git a/fp1/week3/mart/StdSortList.dcl b/fp1/week3/mart/StdSortList.dcl new file mode 100644 index 0000000..46bd238 --- /dev/null +++ b/fp1/week3/mart/StdSortList.dcl @@ -0,0 +1,18 @@ +definition module StdSortList
+
+import StdClass
+
+:: SortList a
+
+newSortList :: SortList a // lege gesorteerde lijst
+memberSort :: a (SortList a) -> Bool | Eq, Ord a // is element van
+insertSort :: a (SortList a) -> SortList a | Ord a // voeg element toe
+removeFirst :: a (SortList a) -> SortList a | Eq, Ord a // verwijder eerste voorkomen
+removeAll :: a (SortList a) -> SortList a | Eq, Ord a // verwijder alle voorkomens
+elements :: (SortList a) -> [a] // geef alle elementen
+count :: (SortList a) -> Int // aantal elementen
+
+minimum :: (SortList a) -> a // huidige minimum waarde
+maximum :: (SortList a) -> a // huidige maximum waarde
+
+mergeSortList :: (SortList a) (SortList a) -> SortList a | Eq, Ord a // meng gesorteerde lijsten
diff --git a/fp1/week3/mart/StdSortList.icl b/fp1/week3/mart/StdSortList.icl new file mode 100644 index 0000000..db71a36 --- /dev/null +++ b/fp1/week3/mart/StdSortList.icl @@ -0,0 +1,50 @@ +implementation module StdSortList
+
+import StdEnv
+
+:: SortList a :== ([a], a)
+
+newSortList :: SortList a
+newSortList = ([], abort "Empty list")
+
+memberSort :: a (SortList a) -> Bool | Eq, Ord a
+memberSort e ([], y) = y
+memberSort e ([x:xs], y)
+| e == x = True
+| e > x = False
+| otherwise = memberSort e (xs, y)
+
+insertSort :: a (SortList a) -> SortList a | Ord a
+insertSort e ([], y) = ([e], e)
+insertSort e ([x:xs], y)
+| e <= x = ([e:x:xs], y)
+| otherwise = ([x:fst result], snd result)
+ where result = insertSort e (xs, y)
+
+removeFirst :: a (SortList a) -> SortList a | Eq, Ord a
+removeFirst e ([], y) = y
+removeFirst e ([e], e) = newSortList
+removeFirst e ([x:xs], y)
+| e == x = ([xs], y)
+removeFirst _ _ = abort ""
+
+removeAll :: a (SortList a) -> SortList a | Eq, Ord a
+removeAll _ _ = abort ""
+
+elements :: (SortList a) -> [a]
+elements _ = abort ""
+
+count :: (SortList a) -> Int
+count _ = abort ""
+
+minimum :: (SortList a) -> a
+minimum _ = abort ""
+
+maximum :: (SortList a) -> a
+maximum _ = abort ""
+
+mergeSortList :: (SortList a) (SortList b) -> (SortList a)
+mergeSortList _ _ = abort ""
+
+Start :: String
+Start = newSortList
diff --git a/fp1/week3/mart/StdStack.dcl b/fp1/week3/mart/StdStack.dcl new file mode 100644 index 0000000..8c861a1 --- /dev/null +++ b/fp1/week3/mart/StdStack.dcl @@ -0,0 +1,13 @@ +definition module StdStack
+
+:: Stack a
+
+newStack :: Stack a // lege stack
+push :: a (Stack a) -> Stack a // plaats nieuw element bovenop de stack
+pushes :: [a] (Stack a) -> Stack a // plaats elementen achtereenvolgens bovenop stack
+pop :: (Stack a) -> Stack a // haal top element van stack
+popn :: Int (Stack a) -> Stack a // haal bovenste $n$ top elementen van stack
+top :: (Stack a) -> a // geef top element van stack
+topn :: Int (Stack a) -> [a] // geef bovenste $n$ top elementen van stack
+elements :: (Stack a) -> [a] // geef alle elementen van stack
+count :: (Stack a) -> Int // tel aantal elementen in stack
diff --git a/fp1/week3/mart/StdStack.icl b/fp1/week3/mart/StdStack.icl new file mode 100644 index 0000000..13220e1 --- /dev/null +++ b/fp1/week3/mart/StdStack.icl @@ -0,0 +1,57 @@ +implementation module StdStack
+
+import StdEnv
+
+:: Stack a = Stack [a]
+
+newStack :: Stack a
+newStack = Stack []
+
+push :: a (Stack a) -> Stack a
+push x (Stack xs) = Stack [x:xs]
+
+pushes :: [a] (Stack a) -> Stack a
+pushes [] (Stack s) = Stack s
+pushes [x:xs] (Stack s) = pushes xs (push x (Stack s))
+
+pop :: (Stack a) -> Stack a
+pop (Stack []) = abort "Can't pop from empty stack..."
+pop (Stack [x:xs]) = Stack xs
+
+popn :: Int (Stack a) -> Stack a
+popn 0 s = s
+popn n s = popn (n-1) (pop s)
+
+top :: (Stack a) -> a
+top (Stack []) = abort "Can't give top of empty stack..."
+top (Stack [x:_]) = x
+
+topn :: Int (Stack a) -> [a]
+topn 0 _ = []
+topn n x = [top x:topn (n-1) (pop x)]
+
+elements :: (Stack a) -> [a]
+elements (Stack s) = s
+
+count :: (Stack a) -> Int
+count (Stack []) = 0
+count (Stack [_:xs]) = 1 + count (Stack xs)
+
+Start = ( "s0 = newStack = ", s0,'\n'
+ , "s1 = push 1 s0 = ", s1,'\n'
+ , "s2 = pushes [2..5] s1 = ",s2,'\n'
+ , "s3 = pop s2 = ", s3,'\n'
+ , "s4 = popn 3 s3 = ", s4,'\n'
+ , "s5 = top s4 = ", s5,'\n'
+ , "s6 = topn 3 s2 = ", s6,'\n'
+ , "s7 = elements s2 = ", s7,'\n'
+ )
+where
+ s0 = newStack
+ s1 = push 1 s0
+ s2 = pushes [2..5] s1
+ s3 = pop s2
+ s4 = popn 3 s3
+ s5 = top s4
+ s6 = topn 3 s2
+ s7 = elements s2
diff --git a/fp1/week4/camil/5.4 b/fp1/week4/camil/5.4 new file mode 100644 index 0000000..accd855 --- /dev/null +++ b/fp1/week4/camil/5.4 @@ -0,0 +1,5 @@ +1. Optelling in de gehele getallen is commutatief, dit maakt dus niet uit. +2. Het verschil tussen 4-2=2 en 2-4=-2. + Algemeen: het verschill tussen (-) a b = a-b en flip (-) a b = b-a, dus (-) a b = - flip (-) a b +3. Vermenigvuldiging in de gehele getallen is commutatief, dit maakt dus niet uit. +3. Het verschil tussen 4/2=2 en 2/4=0. diff --git a/fp1/week4/camil/StdSet.dcl b/fp1/week4/camil/StdSet.dcl new file mode 100644 index 0000000..6cad7f1 --- /dev/null +++ b/fp1/week4/camil/StdSet.dcl @@ -0,0 +1,25 @@ +definition module StdSet
+
+import StdClass
+
+:: Set a
+
+toSet :: [a] -> Set a | Eq a
+fromSet :: (Set a) -> [a]
+
+isEmptySet :: (Set a) -> Bool
+isDisjoint :: (Set a) (Set a) -> Bool | Eq a
+isSubset :: (Set a) (Set a) -> Bool | Eq a
+isStrictSubset :: (Set a) (Set a) -> Bool | Eq a
+memberOfSet :: a (Set a) -> Bool | Eq a
+union :: (Set a) (Set a) -> Set a | Eq a
+intersection :: (Set a) (Set a) -> Set a | Eq a
+nrOfElements :: (Set a) -> Int
+without :: (Set a) (Set a) -> Set a | Eq a
+
+product :: (Set a) (Set b) -> Set (a,b)
+
+instance zero (Set a)
+instance == (Set a) | Eq a
+
+powerSet :: (Set a) -> Set (Set a)
diff --git a/fp1/week4/camil/StdSet.icl b/fp1/week4/camil/StdSet.icl new file mode 100644 index 0000000..651c869 --- /dev/null +++ b/fp1/week4/camil/StdSet.icl @@ -0,0 +1,64 @@ +implementation module StdSet
+
+import StdEnv
+import StdClass
+
+:: Set a :== [a]
+
+toSet :: [a] -> Set a | Eq a
+toSet l = toSet` l []
+where
+ toSet` [] s = s
+ toSet` [x:xs] s = toSet` xs (join x s)
+ where
+ join :: a (Set a) -> Set a | Eq a
+ join e s
+ | memberOfSet e s = s
+ | otherwise = s ++ [e]
+
+fromSet :: (Set a) -> [a]
+fromSet s = s
+
+isEmptySet :: (Set a) -> Bool
+isEmptySet [] = True
+isEmptySet _ = False
+
+isDisjoint :: (Set a) (Set a) -> Bool | Eq a
+isDisjoint s1 s2 = length (intersection s1 s2) == 0
+
+isSubset :: (Set a) (Set a) -> Bool | Eq a
+isSubset s1 s2 = nrOfElements (intersection s1 s2) == nrOfElements s1
+
+isStrictSubset :: (Set a) (Set a) -> Bool | Eq a
+isStrictSubset s1 s2 = isSubset s1 s2 && s1 <> s2
+
+memberOfSet :: a (Set a) -> Bool | Eq a
+memberOfSet e [] = False
+memberOfSet e [x:xs]
+ | e == x = True
+ | otherwise = memberOfSet e xs
+
+union :: (Set a) (Set a) -> Set a | Eq a
+union s1 s2 = toSet (s1 ++ s2)
+
+intersection :: (Set a) (Set a) -> Set a | Eq a
+intersection s1 s2 = [e \\ e <- s1 | memberOfSet e s2]
+
+nrOfElements :: (Set a) -> Int
+nrOfElements s = length (fromSet s)
+
+without :: (Set a) (Set a) -> Set a | Eq a
+without s1 s2 = [e \\ e <- s1 | (memberOfSet e s2) == False]
+
+product :: (Set a) (Set b) -> Set (a,b)
+product s1 s2 = [(e1,e2) \\ e1 <- s1, e2 <- s2]
+
+instance zero (Set a)
+where zero = []
+
+instance == (Set a) | Eq a
+where (==) s1 s2 = isSubset s1 s2 && isSubset s2 s1
+
+powerSet :: (Set a) -> Set (Set a)
+powerSet [] = [zero]
+powerSet [e:es] = map ((++) [e]) (powerSet es) ++ powerSet es
\ No newline at end of file diff --git a/fp1/week4/mart/5.4.txt b/fp1/week4/mart/5.4.txt new file mode 100644 index 0000000..50521d3 --- /dev/null +++ b/fp1/week4/mart/5.4.txt @@ -0,0 +1,4 @@ +1. 4+2 en 2+4. Dit geeft zelfde uitkomst ivm commutativiteit van + +2. 4-2 en 2-4. Dit geeft 2 en -2. - is niet commutitatief. +3. 4*2 en 2*4. Dit geeft zelfde uitkomst ivm commutativiteit van * +4. 4/2 en 2/4. Dit geeft 2 en 0. / is niet commutitatief. diff --git a/fp1/week4/mart/StdSet.dcl b/fp1/week4/mart/StdSet.dcl new file mode 100644 index 0000000..0c702ca --- /dev/null +++ b/fp1/week4/mart/StdSet.dcl @@ -0,0 +1,25 @@ +definition module StdSet
+
+import StdClass
+
+:: Set a
+
+toSet :: [a] -> Set a | Eq a
+fromSet :: (Set a) -> [a]
+
+isEmptySet :: (Set a) -> Bool
+isDisjoint :: (Set a) (Set a) -> Bool | Eq a
+isSubset :: (Set a) (Set a) -> Bool | Eq a
+isStrictSubset :: (Set a) (Set a) -> Bool | Eq a
+memberOfSet :: a (Set a) -> Bool | Eq a
+union :: (Set a) (Set a) -> Set a | Eq a
+intersection :: (Set a) (Set a) -> Set a | Eq a
+nrOfElements :: (Set a) -> Int
+without :: (Set a) (Set a) -> Set a | Eq a
+
+product :: (Set a) (Set b) -> Set (a,b)
+
+instance zero (Set a)
+instance == (Set a) | Eq a
+
+powerSet :: (Set a) -> Set (Set a) | Eq a
diff --git a/fp1/week4/mart/StdSet.icl b/fp1/week4/mart/StdSet.icl new file mode 100644 index 0000000..ecb2e60 --- /dev/null +++ b/fp1/week4/mart/StdSet.icl @@ -0,0 +1,54 @@ +implementation module StdSet
+
+import StdEnv
+import StdClass
+
+:: Set a = Set [a]
+
+toSet :: [a] -> Set a | Eq a
+toSet s = Set (removeDup s)
+
+fromSet :: (Set a) -> [a]
+fromSet (Set s) = s
+
+isEmptySet :: (Set a) -> Bool
+isEmptySet s = isEmpty (fromSet s)
+
+isDisjoint :: (Set a) (Set a) -> Bool | Eq a
+isDisjoint s1 s2 = nrOfElements (intersection s1 s2) == 0
+
+isSubset :: (Set a) (Set a) -> Bool | Eq a
+isSubset s1 s2 = nrOfElements s1 == nrOfElements (intersection s1 s2)
+
+isStrictSubset :: (Set a) (Set a) -> Bool | Eq a
+isStrictSubset s1 s2 = isSubset s1 s2 && nrOfElements s1 < nrOfElements s2
+
+memberOfSet :: a (Set a) -> Bool | Eq a
+memberOfSet a (Set []) = False
+memberOfSet a (Set [x:xs]) = a == x || memberOfSet a (Set xs)
+
+union :: (Set a) (Set a) -> Set a | Eq a
+union (Set s1) (Set s2) = toSet (s1 ++ s2)
+
+intersection :: (Set a) (Set a) -> Set a | Eq a
+intersection (Set s1) s2 = Set [e \\ e <- s1 | memberOfSet e s2]
+
+nrOfElements :: (Set a) -> Int
+nrOfElements s = length (fromSet s)
+
+without :: (Set a) (Set a) -> Set a | Eq a
+without (Set s1) s2 = Set [e \\ e <- s1 | not (memberOfSet e s2)]
+
+product :: (Set a) (Set b) -> Set (a,b)
+product (Set s1) (Set s2) = Set [(e1, e2) \\ e1 <- s1, e2 <- s2]
+
+instance zero (Set a)
+where zero = Set []
+
+instance == (Set a) | Eq a
+where (==) s1 s2 = isSubset s1 s2 && isSubset s2 s1
+
+powerSet :: (Set a) -> Set (Set a) | Eq a
+powerSet (Set []) = Set [(Set [])]
+powerSet (Set [e:xs]) = union (powerSet (Set xs))
+ (Set [union (Set [e]) x \\ x <- fromSet (powerSet (Set xs))])
diff --git a/fp1/week4/week4.tar.gz b/fp1/week4/week4.tar.gz Binary files differnew file mode 100644 index 0000000..0258701 --- /dev/null +++ b/fp1/week4/week4.tar.gz diff --git a/fp1/week5/camil/Origami.icl b/fp1/week5/camil/Origami.icl new file mode 100644 index 0000000..74362a9 --- /dev/null +++ b/fp1/week5/camil/Origami.icl @@ -0,0 +1,24 @@ +module Origami
+
+import StdEnv
+
+Start = and
+ [ sum` [1 .. 5] == sum [1 .. 5]
+ , prod` [1 .. 5] == prod [1 .. 5]
+ , flatten` [[],[1],[1,2],[1,2,3]] == flatten [[],[1],[1,2],[1,2,3]]
+ , reverse` [1 .. 5] == reverse [1 .. 5]
+ , takeWhile` ((<>) 0) [1,2,3,0,4,5,6] == takeWhile ((<>) 0) [1,2,3,0,4,5,6]
+ , maxList` [1 .. 5] == maxList [1 .. 5]
+ ]
+
+sum` = foldr (+) 0
+prod` = foldr (*) 1
+flatten` = foldr (++) []
+length` = foldl (\l e = l + 1) 0
+reverse` = foldl (\xs x = [x:xs]) []
+takeWhile` _ [] = []
+takeWhile` p xs
+ | p (xs!!0) = take (maxList [i \\ i <- [0..length xs-1] | foldr (&&) True [p (xs!!j) \\ j <- [0..i]]] + 1) xs
+ | otherwise = []
+maxList` [] = undef
+maxList` [x:xs] = foldr max x xs
diff --git a/fp1/week5/mart/Origami.icl b/fp1/week5/mart/Origami.icl new file mode 100644 index 0000000..180a119 --- /dev/null +++ b/fp1/week5/mart/Origami.icl @@ -0,0 +1,16 @@ +/**
+ * Mart Lubbers, s4109503
+ * Camil Staps, s4498062
+ */
+
+module Origami
+
+import StdEnv
+
+sum` = foldr (+) 0
+prod` = foldr (*) 1
+flatten` = foldr (++) []
+length` = foldr (\x l=l+1) 0
+reverse` = foldl (\xs x=[x:xs]) []
+takeWhile` p = foldr (\x xs=if (p x) [x:xs] []) []
+maxList` [x:xs] = foldr max x xs
diff --git a/fp1/week6/camil/BewijsMapFlatten.icl b/fp1/week6/camil/BewijsMapFlatten.icl new file mode 100644 index 0000000..7f2474e --- /dev/null +++ b/fp1/week6/camil/BewijsMapFlatten.icl @@ -0,0 +1,83 @@ +// Mart Lubbers, s4109503
+// Camil Staps, s4498062
+
+Zij gegeven:
+
+(++) :: [a] [a] -> [a]
+(++) [] xs = xs (1)
+(++) [y:ys] xs = [y : ys ++ xs] (2)
+
+map :: (a -> b) [a] -> [b]
+map f [] = [] (3)
+map f [x:xs] = [f x : map f xs] (4)
+
+flatten :: [[a]] -> [a]
+flatten [] = [] (5)
+flatten [x:xs] = x ++ (flatten xs) (6)
+
+1.
+Te bewijzen:
+ voor iedere functie f, eindige lijst as en bs:
+
+ map f (as ++ bs) = (map f as) ++ (map f bs)
+
+Bewijs:
+Met inductie over as.
+
+Inductiebasis:
+Stel as = []. Dan hebben we:
+
+ map f (as ++ bs) // aanname as = []
+ = map f ([] ++ bs) // definitie van ++, regel 1
+ = map f bs // definitie van ++, regel 1
+ = [] ++ (map f bs) // definitie van map, regel 3
+ = (map f []) ++ (map f bs) // aanname as = []
+ = (map f as) ++ (map f bs).
+
+Inductiestap:
+Stel map f (as ++ bs) = (map f as) ++ (map f bs) voor zekere as en elke bs (inductiehypothese). Dan hebben we:
+
+ map f ([a:as] ++ bs) // definitie van ++, regel 2
+ = map f [a:as ++ bs] // definitie van map, regel 4
+ = [f a : map f (as ++ bs)] // inductiehypothese: map f (as ++ bs) = (map f as) ++ (map f bs)
+ = [f a : (map f as) ++ (map f bs)] // lijst herschrijven
+ = [f a : map f as] ++ (map f bs) // definitie van map, regel 4
+ = (map f [a:as]) ++ (map f bs).
+
+Uit het principe van volledige inductie volgt nu dat voor iedere functie f, eindige lijst as en bs:
+
+ map f (as ++ bs) = (map f as) ++ (map f bs) (9.4.1)
+
+2.
+Te bewijzen:
+ voor iedere functie f, voor iedere eindige lijst xs:
+
+ flatten (map (map f) xs) = map f (flatten xs)
+
+Bewijs:
+Met inductie over xs.
+
+Inductiebasis:
+Stel xs = []. Dan hebben we:
+
+ flatten (map (map f) xs) // aanname xs = []
+ = flatten (map (map f) []) // definitie van map, regel 3
+ = flatten [] // definitie van flatten, regel 5
+ = [] // definitie van map, regel 3
+ = map f [] // definitie van flatten, regel 5
+ = map f (flatten []) // aanname xs = []
+ = map f (flatten xs).
+
+Inductiestap:
+Stel flatten (map (map f) xs) = map f (flatten xs) voor een zekere eindige lijst xs (inductiehypothese). Dan hebben we:
+
+ flatten (map (map f) [x:xs]) // definitie van map, regel 4
+ = flatten [map f x : map (map f) xs] // definitie van flatten, regel 6
+ = (map f x) ++ flatten (map (map f) xs) // inductiehypothese: flatten (map (map f) xs) = map f (flatten xs)
+ = (map f x) ++ (map f (flatten xs)) // 9.4.1
+ = map f (x ++ (flatten xs)) // definitie van flatten, regel 6
+ = map f (flatten [x:xs]).
+
+Uit het principe van volledige inductie volgt nu dat voor iedere functie f en eindige lijst xs geldt:
+
+ flatten (map (map f) xs) = map f (flatten xs)
diff --git a/fp1/week6/mart/BewijsMapFlatten.icl b/fp1/week6/mart/BewijsMapFlatten.icl new file mode 100644 index 0000000..59fa5bc --- /dev/null +++ b/fp1/week6/mart/BewijsMapFlatten.icl @@ -0,0 +1,97 @@ +Zij gegeven:
+
+(++) :: [a] [a] -> [a]
+(++) [] xs = xs (1)
+(++) [y:ys] xs = [y : ys ++ xs] (2)
+
+map :: (a -> b) [a] -> [b]
+map f [] = [] (3)
+map f [x:xs] = [f x : map f xs] (4)
+
+flatten :: [[a]] -> [a]
+flatten [] = [] (5)
+flatten [x:xs] = x ++ (flatten xs) (6)
+
+1.
+Te bewijzen:
+ voor iedere functie f, eindige lijst as en bs:
+
+ map f (as ++ bs) = (map f as) ++ (map f bs)
+
+Bewijs:
+ met inductie naar de lengte van as.
+
+ Basis:
+ aanname: as = [].
+
+ map f ([] ++ bs) = (map f []) ++ (map f bs) basis
+ ********
+ => map f (bs) = (map f []) ++ (map f bs) (1)
+ ********
+ => map f (bs) = [] ++ (map f bs) (3)
+ ****************
+ => map f bs = map f bs (1)
+
+ Inductiestap:
+ aanname: stelling geldt voor zekere as, ofwel:
+ map f (as ++ bs) = (map f as) ++ (map f bs) (IH)
+
+ Te bewijzen: stelling geldt ook voor as, ofwel:
+ map f ([a:as] ++ bs) = (map f [a:as]) ++ (map f bs)
+
+ map f ([a:as] ++ bs) = (map f [a:as]) ++ (map f bs) basis
+ ************
+ => map f [a:as ++ bs] = (map f [a:as]) ++ (map f bs) (2)
+ ******************
+ => [f a : map f (as ++ bs)] = (map f [a:as]) ++ (map f bs) (4)
+ ************
+ => [f a : map f (as ++ bs)] = [f a : map f as] ++ (map f bs) (4)
+ ****************************
+ => [f a : map f (as ++ bs)] = [f a : (map f as) ++ (map f bs)] (4)
+ **************** ************************
+ => map f (as ++ bs) = (map f as) ++ (map f bs) (IH)
+
+ Dus: basis + inductiestap => stelling bewezen.
+
+2.
+Te bewijzen:
+ voor iedere functie f, voor iedere eindige lijst xs:
+
+ flatten (map (map f) xs) = map f (flatten xs)
+
+Bewijs:
+ met inductio van de lengte van xs
+
+ Basis:
+ aanname: xs = [].
+
+ flatten (map (map f) []) = map f (flatten []) basis
+ **************
+ = flatten [] = map f (flatten []) (3)
+ **********
+ = flatten [] = map f [] (5)
+ **********
+ = [] = map f [] (5)
+ *****
+ = [] = [] (3)
+
+ Inductiestap:
+ aanname: stelling geldt voor zekere xs, ofwel:
+ flatten (map (map f) xs) = map f (flatten xs)
+
+ Te bewijzen: stelling geldt ook voor xs, ofwel:
+ flatten (map (map f) [x:xs]) = map f (flatten [x:xs])
+
+ flatten (map (map f) [x:xs]) = map f (flatten [x:xs]) basis
+ ******************
+ => flatten [map f x: map (map f) xs] = map f (flatten [x:xs]) (4)
+ *********************************
+ => (map f x) ++ (flatten (map (map f) xs)) = map f (flatten [x:xs]) (6)
+ **************
+ => (map f x) ++ (flatten (map (map f) xs)) = map f (x ++ (flatten xs)) (6)
+ *************************
+ => (map f x) ++ (flatten (map (map f) xs)) = (map f x) ++ (map f (flatten xs)) (9.4.1)
+ ************************ ****************
+ => flatten (map (map f) xs) = map f (flatten xs) (IH)
+
+ Dus: basis + inductiestap => stelling bewezen.
diff --git a/fp1/week7/camil/BewijsMeppenEnTippen.icl b/fp1/week7/camil/BewijsMeppenEnTippen.icl new file mode 100644 index 0000000..ca5e396 --- /dev/null +++ b/fp1/week7/camil/BewijsMeppenEnTippen.icl @@ -0,0 +1,82 @@ +// Mart Lubbers, s4109503
+// Camil Staps, s4498062
+
+Zij gegeven:
+
+:: BTree a = Tip a | Bin (BTree a) (BTree a)
+
+map :: (a -> b) [a] -> [b]
+map f [] = [] (1.)
+map f [x:xs] = [f x : map f xs] (2.)
+
+mapbtree :: (a -> b) (BTree a) -> BTree b
+mapbtree f (Tip a) = Tip (f a) (3.)
+mapbtree f (Bin t1 t2) = Bin (mapbtree f t1) (mapbtree f t2) (4.)
+
+foldbtree :: (a a -> a) (BTree a) -> a
+foldbtree f (Tip x) = x (5.)
+foldbtree f (Bin t1 t2) = f (foldbtree f t1) (foldbtree f t2) (6.)
+
+tips :: (BTree a) -> [a]
+tips t = foldbtree (++) (mapbtree unit t) (7.)
+
+unit :: a -> [a]
+unit x = [x] (8.)
+
+
+Te bewijzen:
+ voor alle functies f, voor alle eindige bomen t:
+
+ map f (tips t) = tips (mapbtree f t)
+
+Bewijs:
+ Met inductie over t.
+
+ Inductiebasis: stel t = Tip a.
+ Dan hebben we:
+
+ map f (tips t) // definitie tips (7)
+ = map f (foldbtree (++) (mapbtree unit t)) // aanname t = Tip a
+ = map f (foldbtree (++) (mapbtree unit (Tip a))) // definitie mapbtree (3)
+ = map f (foldbtree (++) (Tip unit a)) // definitie foldbtree (5)
+ = map f (unit a) // definitie unit (8)
+ = map f [a] // herschrijven lijst
+ = map f [a:[]] // definitie map (2)
+ = [f a : map f []] // definitie map (1)
+ = [f a : []] // herschrijven lijst
+ = [f a] // definitie unit (8)
+ = unit (f a) // definitie foldbtree (5)
+ = foldbtree (++) (Tip (unit (f a))) // definitie mapbtree (3)
+ = foldbtree (++) (mapbtree unit (Tip (f a))) // definitie tips (7)
+ = tips (Tip (f a)) // definitie mapbtree (3)
+ = tips (mapbtree f (Tip a)) // aanname t = Tip a
+ = tips (mapbtree f t)
+
+ Dus de stelling geldt voor t = Tip a.
+
+ Inductiestap: laten we aannemen dat
+ map f (tips t) = tips (mapbtree f t)
+ voor alle f en zekere t=t1,t=t2 (inductiehypothese).
+ Dan hebben we:
+
+ map f (tips (Bin t1 t2)) // definitie tips (7)
+ = map f (foldbtree (++) (mapbtree unit (Bin t1 t2))) // definitie mapbtree (4)
+ = map f (foldbtree (++) (Bin (mapbtree unit t1) (mapbtree unit t2))) // definitie foldbtree (6)
+ = map f ((++) (foldbtree (++) (mapbtree unit t1)) (foldbtree (++) (mapbtree unit t2))) // definitie tips (7)
+ = map f ((++) (tips t1) (tips t2)) // 9.4.1
+ = (map f (tips t1)) ++ (map f (tips t2)) // inductiehypothese
+ = (tips (mapbtree f t1)) ++ (tips (mapbtree f t2)) // definitie tips (7)
+ = (foldbtree (++) (mapbtree unit (f t1))) ++ (foldbtree (++) (mapbtree unit (f t2))) // herschrijven infixnotatie
+ = (++) (foldbtree (++) (mapbtree unit (f t1))) (foldbtree (++) (mapbtree unit (f t2))) // definitie foldbtree (6)
+ = foldbtree (++) (Bin (mapbtree unit (f t1)) (mapbtree unit (f t2))) // definitie mapbtree (4)
+ = foldbtree (++) (mapbtree unit (Bin (mapbtree f t1) (mapbtree f t2))) // definitie tips (7)
+ = tips (Bin (mapbtree f t1) (mapbtree f t2)) // definitie mapbtree (4)
+ = tips (mapbtree f (Bin t1 t2))
+
+ Conclusie:
+ We hebben laten zien dat de stelling geldt voor elke f met t = Tip a. Vervolgens hebben we laten zien dat als de stelling geldt voor elke f met t=t1 of t=t2, de stelling óók geldt voor elke f met t = Bin t1 t2.
+ Met het principe van inductie volgt nu
+
+ map f (tips t) = tips (mapbtree f t)
+
+ voor alle functies f en alle eindige bomen t.
\ No newline at end of file diff --git a/fp1/week7/camil/BinSearchTree.dcl b/fp1/week7/camil/BinSearchTree.dcl new file mode 100644 index 0000000..696b065 --- /dev/null +++ b/fp1/week7/camil/BinSearchTree.dcl @@ -0,0 +1,7 @@ +definition module BinSearchTree
+
+import StdClass
+import BinTree
+
+is_geordend :: (Tree a) -> Bool | Ord a // meest algemene type
+is_gebalanceerd :: (Tree a) -> Bool | Ord a // meest algemene type
diff --git a/fp1/week7/camil/BinSearchTree.icl b/fp1/week7/camil/BinSearchTree.icl new file mode 100644 index 0000000..559846b --- /dev/null +++ b/fp1/week7/camil/BinSearchTree.icl @@ -0,0 +1,177 @@ +// Mart Lubbers, s4109503 +// Camil Staps, s4498062 + +implementation module BinSearchTree + +import StdEnv +import BinTree + +z0 = Leaf +// Leaf + +z1 = insertTree 50 z0 +// 50 +// | +// ------------- +// | | +// Leaf Leaf + +z2 = insertTree 10 z1 +// 50 +// | +// ------------- +// | | +// 10 Leaf +// | +// --------- +// | | +// Leaf Leaf + +z3 = insertTree 75 z2 +// 50 +// | +// --------------- +// | | +// 10 75 +// | | +// --------- --------- +// | | | | +// Leaf Leaf Leaf Leaf + +z4 = insertTree 80 z3 +// 50 +// | +// --------------- +// | | +// 10 75 +// | | +// --------- --------- +// | | | | +// Leaf Leaf Leaf 80 +// | +// --------- +// | | +// Leaf Leaf + +z5 = insertTree 77 z4 +// 50 +// | +// --------------- +// | | +// 10 75 +// | | +// --------- --------- +// | | | | +// Leaf Leaf Leaf 77 +// | +// --------- +// | | +// Leaf 80 +// | +// --------- +// | | +// Leaf Leaf + +z6 = insertTree 10 z5 +// 50 +// | +// --------------- +// | | +// 10 75 +// | | +// --------- --------- +// | | | | +// 10 Leaf Leaf 77 +// | | +// --------- --------- +// | | | | +// Leaf Leaf Leaf 80 +// | +// --------- +// | | +// Leaf Leaf + +z7 = insertTree 75 z6 +// 50 +// | +// ---------------- +// | | +// 10 75 +// | | +// --------- ----------- +// | | | | +// 10 Leaf 75 77 +// | | | +// --------- ------ ------- +// | | | | | | +// Leaf Leaf Leaf Leaf Leaf 80 +// | +// --------- +// | | +// Leaf Leaf + +z8 = deleteTree 50 z7 +// 10 +// | +// ---------------- +// | | +// 10 75 +// | | +// --------- ----------- +// | | | | +// Leaf Leaf 75 77 +// | | +// ------ ------- +// | | | | +// Leaf Leaf Leaf 80 +// | +// --------- +// | | +// Leaf Leaf + +// Uit het diktaat, blz. 73: +insertTree :: a (Tree a) -> Tree a | Ord a +insertTree e Leaf = Node e Leaf Leaf +insertTree e (Node x le ri) +| e <= x = Node x (insertTree e le) ri +| e > x = Node x le (insertTree e ri) + +deleteTree :: a (Tree a) -> (Tree a) | Eq, Ord a +deleteTree e Leaf = Leaf +deleteTree e (Node x le ri) +| e < x = Node x (deleteTree e le) ri +| e == x = join le ri +| e > x = Node x le (deleteTree e ri) +where + join :: (Tree a) (Tree a) -> (Tree a) + join Leaf b2 = b2 + join b1 b2 = Node x b1` b2 + where + (x,b1`) = largest b1 + + largest :: (Tree a) -> (a,(Tree a)) + largest (Node x b1 Leaf) = (x,b1) + largest (Node x b1 b2) = (y,Node x b1 b2`) + where + (y,b2`) = largest b2 + + +is_geordend :: (Tree a) -> Bool | Ord a // meest algemene type +is_geordend Leaf = True +is_geordend (Node x le ri) = (foldr (&&) True (map ((>) x) (members le))) && (foldr (&&) True (map ((<=) x) (members ri))) && is_geordend le && is_geordend ri +where + members :: (Tree a) -> [a] + members Leaf = [] + members (Node x le ri) = [x:(members le) ++ (members ri)] + +//Start = map is_geordend [t0,t1,t2,t3,t4,t5,t6,t7] + +is_gebalanceerd :: (Tree a) -> Bool | Ord a // meest algemene type +is_gebalanceerd Leaf = True +is_gebalanceerd (Node x le ri) = abs ((depth le) - (depth ri)) <= 1 && is_gebalanceerd le && is_gebalanceerd ri +where + depth :: (Tree a) -> Int + depth Leaf = 0 + depth (Node x le ri) = max (depth le) (depth ri) + 1 + +//Start = map is_gebalanceerd [t0,t1,t2,t3,t4,t5,t6,t7] diff --git a/fp1/week7/camil/BinTree.dcl b/fp1/week7/camil/BinTree.dcl new file mode 100644 index 0000000..7774ece --- /dev/null +++ b/fp1/week7/camil/BinTree.dcl @@ -0,0 +1,16 @@ +definition module BinTree
+
+:: Tree a = Node a (Tree a) (Tree a) | Leaf
+
+t0 :: Tree Int
+t1 :: Tree Int
+t2 :: Tree Int
+t3 :: Tree Int
+t4 :: Tree Int
+t5 :: Tree Int
+t6 :: Tree Int
+t7 :: Tree Int
+
+//nodes :: // meest algemene type
+//leaves :: // meest algemene type
+//diepte :: // meest algemene type
diff --git a/fp1/week7/camil/BinTree.icl b/fp1/week7/camil/BinTree.icl new file mode 100644 index 0000000..601efcc --- /dev/null +++ b/fp1/week7/camil/BinTree.icl @@ -0,0 +1,38 @@ +implementation module BinTree
+
+import StdEnv
+
+:: Tree a = Node a (Tree a) (Tree a) | Leaf
+
+t0 :: Tree Int
+t0 = Leaf
+t1 :: Tree Int
+t1 = Node 4 t0 t0
+t2 :: Tree Int
+t2 = Node 2 t0 t1
+t3 :: Tree Int
+t3 = Node 5 t2 t0
+t4 :: Tree Int
+t4 = Node 5 t2 t2
+t5 :: Tree Int
+t5 = Node 1 Leaf (Node 2 Leaf (Node 3 Leaf (Node 4 Leaf Leaf)))
+t6 :: Tree Int
+t6 = Node 1 (Node 2 (Node 3 (Node 4 Leaf Leaf) Leaf) Leaf) Leaf
+t7 :: Tree Int
+t7 = Node 4 (Node 1 Leaf Leaf) (Node 5 (Node 2 Leaf Leaf) Leaf)
+
+// 2.
+//nodes :: // meest algemene type
+//nodes ...
+
+//Start = map nodes [t0,t1,t2,t3,t4,t5,t6,t7]
+
+//leaves :: // meest algemene type
+//leaves ...
+
+//Start = map leaves [t0,t1,t2,t3,t4,t5,t6,t7]
+
+//diepte :: // meest algemene type
+//diepte ...
+
+//Start = map diepte [t0,t1,t2,t3,t4,t5,t6,t7]
diff --git a/fp1/week7/mart/BewijsMeppenEnTippen.icl b/fp1/week7/mart/BewijsMeppenEnTippen.icl new file mode 100644 index 0000000..720ff4d --- /dev/null +++ b/fp1/week7/mart/BewijsMeppenEnTippen.icl @@ -0,0 +1,29 @@ +Zij gegeven:
+
+:: BTree a = Tip a | Bin (BTree a) (BTree a)
+
+map :: (a -> b) [a] -> [b]
+map f [] = [] (1.)
+map f [x:xs] = [f x : map f xs] (2.)
+
+mapbtree :: (a -> b) (BTree a) -> BTree b
+mapbtree f (Tip a) = Tip (f a) (3.)
+mapbtree f (Bin t1 t2) = Bin (mapbtree f t1) (mapbtree f t2) (4.)
+
+foldbtree :: (a a -> a) (BTree a) -> a
+foldbtree f (Tip x) = x (5.)
+foldbtree f (Bin t1 t2) = f (foldbtree f t1) (foldbtree f t2) (6.)
+
+tips :: (BTree a) -> [a]
+tips t = foldbtree (++) (mapbtree unit t) (7.)
+
+unit :: a -> [a]
+unit x = [x] (8.)
+
+
+Te bewijzen:
+ voor alle functies f, voor alle eindige bomen t:
+
+ map f (tips t) = tips (mapbtree f t)
+
+Bewijs:
diff --git a/fp1/week7/mart/BinSearchTree.dcl b/fp1/week7/mart/BinSearchTree.dcl new file mode 100644 index 0000000..2e480bb --- /dev/null +++ b/fp1/week7/mart/BinSearchTree.dcl @@ -0,0 +1,7 @@ +definition module BinSearchTree
+
+import StdClass
+import BinTree
+
+is_geordend :: // meest algemene type
+is_gebalanceerd :: // meest algemene type
diff --git a/fp1/week7/mart/BinSearchTree.icl b/fp1/week7/mart/BinSearchTree.icl new file mode 100644 index 0000000..8f9f05c --- /dev/null +++ b/fp1/week7/mart/BinSearchTree.icl @@ -0,0 +1,141 @@ +implementation module BinSearchTree
+
+import StdEnv
+import BinTree
+
+
+z0
+ Leaf
+z1
+ 50
+ |
+ ----------
+ | |
+ Leaf Leaf
+z2
+ 50
+ |
+ ----------
+ | |
+ 10 Leaf
+ |
+ ------
+ | |
+ Leaf Leaf
+z3
+ 50
+ |
+ ----------
+ | |
+ 10 75
+ | |
+ ------ ------
+ | | | |
+ Leaf Leaf Leaf Leaf
+z4
+ 50
+ |
+ ----------
+ | |
+ 10 75
+ | |
+ ------ ------
+ | | | |
+ Leaf Leaf Leaf 80
+ |
+ ------
+ | |
+ Leaf Leaf
+z5
+ 50
+ |
+ ----------
+ | |
+ 10 75
+ | |
+ ------ ------
+ | | | |
+ Leaf Leaf Leaf 77
+ |
+ ------
+ | |
+ Leaf 80
+ |
+ ------
+ | |
+ Leaf Leaf
+z6
+ 50
+ |
+ ----------
+ | |
+ 10 75
+ | |
+ ------ ------
+ | | | |
+ 10 Leaf Leaf 77
+ | |
+ ------ ------
+ | | | |
+Leaf Leaf Leaf 80
+ |
+ ------
+ | |
+ Leaf Leaf
+z7
+ 50
+ |
+ ----------
+ | |
+ 10 75
+ | |
+ ------ -----------
+ | | | |
+ 10 Leaf 75 77
+ | | |
+ ------ ------ ------
+ | | | | | |
+Leaf Leaf Leaf Leaf Leaf 80
+ |
+ ------
+ | |
+ Leaf Leaf
+z8
+
+// Uit het diktaat, blz. 73:
+insertTree :: a (Tree a) -> Tree a | Ord a
+insertTree e Leaf = Node e Leaf Leaf
+insertTree e (Node x le ri)
+| e <= x = Node x (insertTree e le) ri
+| e > x = Node x le (insertTree e ri)
+
+deleteTree :: a (Tree a) -> (Tree a) | Eq, Ord a
+deleteTree e Leaf = Leaf
+deleteTree e (Node x le ri)
+| e < x = Node x (deleteTree e le) ri
+| e == x = join le ri
+| e > x = Node x le (deleteTree e ri)
+where
+ join :: (Tree a) (Tree a) -> (Tree a)
+ join Leaf b2 = b2
+ join b1 b2 = Node x b1` b2
+ where
+ (x,b1`) = largest b1
+
+ largest :: (Tree a) -> (a,(Tree a))
+ largest (Node x b1 Leaf) = (x,b1)
+ largest (Node x b1 b2) = (y,Node x b1 b2`)
+ where
+ (y,b2`) = largest b2
+
+
+is_geordend :: // meest algemene type
+is_geordend ...
+
+Start = map is_geordend [t0,t1,t2,t3,t4,t5,t6,t7]
+
+
+is_gebalanceerd :: // meest algemene type
+is_gebalanceerd ...
+
+//Start = map is_gebalanceerd [t0,t1,t2,t3,t4,t5,t6,t7]
|