From 6921fbf125bf330eed2fb1d6e8b5f928a7be146c Mon Sep 17 00:00:00 2001 From: Charlie Gerhardus Date: Sun, 6 Sep 2015 19:34:21 +0200 Subject: [PATCH] mijn uitwerking --- a1/charlie/skeleton1.icl | 213 +++++++++++++++++++++++++++++++++++++++ 1 file changed, 213 insertions(+) create mode 100755 a1/charlie/skeleton1.icl diff --git a/a1/charlie/skeleton1.icl b/a1/charlie/skeleton1.icl new file mode 100755 index 0000000..3a5e8d4 --- /dev/null +++ b/a1/charlie/skeleton1.icl @@ -0,0 +1,213 @@ +/* assignment 1 + * + * Charlie Gerhardus, s3050009 + * Mart Lubbers s4109503 + */ + +module skeleton1 + +/* + Course I00032 Advanced Programming 2014 + Skeleton for assignment 1 + Pieter Koopman +*/ + +import StdEnv + +/**************** Prelude: *******************************/ +// Example types +:: Color = Red | Yellow | Blue +:: Tree a = Tip | Bin a (Tree a) (Tree a) +:: Rose a = Rose a [Rose a] + +// Binary sums and products (in generic prelude) +:: UNIT = UNIT +:: PAIR a b = PAIR a b +:: EITHER a b = LEFT a | RIGHT b + +// Generic type representations +:: RoseG a :== PAIR a [Rose a] + +// Conversions +fromRose :: (Rose a) -> RoseG a +fromRose (Rose a l) = PAIR a l + +// Oerdering + +:: Ordering = Smaller | Equal | Bigger + +class (><) infix 4 a :: !a !a -> Ordering + +instance >< Int where // Standard ordering for Int + (><) x y + | x < y = Smaller + | x > y = Bigger + | otherwise = Equal + +instance >< Char where // Standard ordering for Char + (><) x y + | x < y = Smaller + | x > y = Bigger + | otherwise = Equal + +instance >< String where // Standard lexicographical ordering + (><) x y + | x < y = Smaller + | x > y = Bigger + | otherwise = Equal + +instance >< Bool where // False is smaller than True + (><) False True = Smaller + (><) True False = Bigger + (><) _ _ = Equal + +/**************** End Prelude *************************/ + +/* compare ordering */ +instance == Ordering where + (==) Equal Equal = True + (==) Smaller Smaller = True + (==) Bigger Bigger = True + (==) _ _ = False + +/* color to rgb encoding + * + * Blue = 0x0000FF + * Red = 0xFF0000 + * Yellow = 0xFFFF00 + */ +color2RGB :: Color -> Int +color2RGB Blue = 0x0000FF +color2RGB Red = 0xFF0000 +color2RGB Yellow = 0xFFFF00 + +/* list operator instance */ +instance >< [a] | >< a where + (><) [] [] = Equal + (><) _ [] = Bigger + (><) [] _ = Smaller + (><) [x:xs] [y:ys] + | ( (x >< y) == Equal ) = xs >< ys + | otherwise = x >< y + +/* tuple operator */ +instance >< (a, b) | >< a & >< b where + (><) (x1, y1) (x2, y2) + | ( (x1 >< x2) == Equal ) = y1 >< y2 + | otherwise = x1 >< x2 + +/* color comparison */ +instance >< Color where + (><) x y = color2RGB x >< color2RGB y + +/* tree comparison */ +instance >< (Tree a) | >< a where + (><) Tip Tip = Equal + (><) _ Tip = Bigger + (><) Tip _ = Smaller + (><) (Bin x xl xr) (Bin y yl yr) + | ( (x >< y) == Equal ) = (xl, xr) >< (yl, yr) + | otherwise = x >< y + +/* rose comparison */ +instance >< (Rose a) | >< a where + (><) (Rose x xs) (Rose y ys) = (x, xs) >< (y , ys) + +/* we take >-< as the generic ordering operator */ +class (>-<) infix 4 a :: !a !a -> Ordering + +/* instances for Int, Char, String and Bool + * + * instance >-< Int Char String Bool where + * (>-<) x y = x >< y + * + * not possible? + */ +instance >-< Int where + (>-<) x y = x >< y +instance >-< Char where + (>-<) x y = x >< y +instance >-< String where + (>-<) x y = x >< y +instance >-< Bool where + (>-<) x y = x >< y + +/* for unit */ +instance >-< UNIT where + (>-<) UNIT UNIT = Equal + +/* for pair */ +instance >-< (PAIR a b) | >-< a & >-< b where + (>-<) (PAIR x1 x2) (PAIR y1 y2) + | ( (x1 >-< y1) == Equal ) = x2 >-< y2 + | otherwise = x1 >-< y1 + +/* for either */ +instance >-< (EITHER a b) | >-< a & >-< b where + (>-<) (LEFT x) (LEFT y) = x >-< y + (>-<) (RIGHT x) (RIGHT y) = x >-< y + (>-<) (LEFT _) (RIGHT _) = Bigger + (>-<) (RIGHT _) (LEFT _) = Smaller + +/* generic representations */ +:: ColorG :== EITHER (EITHER UNIT UNIT) UNIT +:: ListG a :== EITHER (PAIR a [a]) UNIT +:: TupleG a b :== PAIR a b +:: TreeG a :== EITHER ( PAIR a ( TupleG (Tree a) (Tree a) ) ) UNIT + +/* convert color to generic representation */ +fromColor :: Color -> ColorG +fromColor Yellow = LEFT (LEFT UNIT) +fromColor Red = LEFT (RIGHT UNIT) +fromColor Blue = RIGHT UNIT + +/* convert list to generatic representation */ +fromList :: [a] -> ListG a +fromList [] = RIGHT UNIT +fromList [x:xs] = LEFT (PAIR x xs) + +/* convert tuple to generic representation */ +fromTuple :: (a, b) -> TupleG a b +fromTuple (x, y) = PAIR x y + +/* convert tree to generic representation */ +fromTree :: (Tree a) -> TreeG a +fromTree Tip = RIGHT UNIT +fromTree (Bin x l r) = LEFT ( PAIR x ( fromTuple (l, r) ) ) + +/* generic conversion for >-< operator */ +instance >-< Color where + (>-<) x y = fromColor x >-< fromColor y + +instance >-< (a, b) | >-< a & >-< b where + (>-<) x y = fromTuple x >-< fromTuple y + +instance >-< [a] | >-< a where + (>-<) x y = fromList x >-< fromList y + +instance >-< (Rose a) | >-< a where + (>-<) x y = fromRose x >-< fromRose y + +instance >-< (Tree a) | >-< a where + (>-<) x y = fromTree x >-< fromTree y + +/* test trees */ +tree1 :: Tree Int +tree1 = Bin 1 (Bin 5 Tip Tip) (Bin 6 Tip Tip) +tree2 :: Tree Int +tree2 = Bin 1 (Bin 5 Tip Tip) (Bin 8 Tip Tip) + +/* test roses */ +rose1 :: Rose Int +rose1 = Rose 2 [ Rose 1 [], Rose 2 [], Rose 5 [] ] +rose2 :: Rose Int +rose2 = Rose 2 [ Rose 1 [], Rose 2 [], Rose 8 [] ] + +/* our two comparison lists */ +cmp1 :: [Ordering] +cmp1 = [[1..3] >< [1..2], [1..2] >< [1..5], (1,2) >< (1,2), (1,3) >-< (1,2), Red >< Yellow, Yellow >< Blue, tree1 >< tree1, tree1 >< tree2, tree2 >< tree1, rose1 >< rose1, rose1 >< rose2, rose2 >< rose1] +cmp2 :: [Ordering] +cmp2 = [[1..3] >-< [1..2], [1..2] >-< [1..5], (1,2) >-< (1,2), (1,3) >-< (1,2), Red >-< Yellow, Yellow >-< Blue, tree1 >-< tree1, tree1 >-< tree2, tree2 >-< tree1, rose1 >-< rose1, rose1 >-< rose2, rose2 >-< rose1] + +/* entry point */ +Start = ([cmp1, cmp2], cmp1 == cmp2) -- 2.20.1