From 1b073db9c8d3666bf4bd5615120d37eb881dab07 Mon Sep 17 00:00:00 2001 From: Mart Lubbers Date: Fri, 29 May 2015 14:50:30 +0200 Subject: [PATCH] hoi --- fp2/week6/mart/BinSearchTree.dcl | 8 +++ fp2/week6/mart/BinSearchTree.icl | 49 ++++++++++++++++++ fp2/week6/mart/BinSearchTreeImage.icl | 71 +++++++++++++++++++++++++++ fp2/week6/mart/BinTree.dcl | 16 ++++++ fp2/week6/mart/BinTree.icl | 38 ++++++++++++++ 5 files changed, 182 insertions(+) create mode 100755 fp2/week6/mart/BinSearchTree.dcl create mode 100755 fp2/week6/mart/BinSearchTree.icl create mode 100755 fp2/week6/mart/BinSearchTreeImage.icl create mode 100755 fp2/week6/mart/BinTree.dcl create mode 100755 fp2/week6/mart/BinTree.icl diff --git a/fp2/week6/mart/BinSearchTree.dcl b/fp2/week6/mart/BinSearchTree.dcl new file mode 100755 index 0000000..460dcf1 --- /dev/null +++ b/fp2/week6/mart/BinSearchTree.dcl @@ -0,0 +1,8 @@ +definition module BinSearchTree + +import StdClass +import BinTree + +is_geordend :: (BTree a) -> Bool | Ord a // meest algemene type +is_gebalanceerd :: (BTree a) -> Bool | Ord a // meest algemene type +insertTree :: a (BTree a) -> BTree a | Ord a \ No newline at end of file diff --git a/fp2/week6/mart/BinSearchTree.icl b/fp2/week6/mart/BinSearchTree.icl new file mode 100755 index 0000000..83ca73b --- /dev/null +++ b/fp2/week6/mart/BinSearchTree.icl @@ -0,0 +1,49 @@ +// Mart Lubbers, s4109503 +// Camil Staps, s4498062 + +implementation module BinSearchTree + +import StdEnv +import BinTree + +insertTree :: a (BTree a) -> BTree a | Ord a +insertTree e BLeaf = BNode e BLeaf BLeaf +insertTree e (BNode x le ri) +| e <= x = BNode x (insertTree e le) ri +| e > x = BNode x le (insertTree e ri) + +deleteTree :: a (BTree a) -> (BTree a) | Eq, Ord a +deleteTree e BLeaf = BLeaf +deleteTree e (BNode x le ri) +| e < x = BNode x (deleteTree e le) ri +| e == x = join le ri +| e > x = BNode x le (deleteTree e ri) +where + join :: (BTree a) (BTree a) -> (BTree a) + join BLeaf b2 = b2 + join b1 b2 = BNode x b1` b2 + where + (x,b1`) = largest b1 + + largest :: (BTree a) -> (a,(BTree a)) + largest (BNode x b1 BLeaf) = (x,b1) + largest (BNode x b1 b2) = (y,BNode x b1 b2`) + where + (y,b2`) = largest b2 + + +is_geordend :: (BTree a) -> Bool | Ord a // meest algemene type +is_geordend BLeaf = True +is_geordend (BNode x le ri) = (foldr (&&) True (map ((>) x) (members le))) && (foldr (&&) True (map ((<=) x) (members ri))) && is_geordend le && is_geordend ri +where + members :: (BTree a) -> [a] + members BLeaf = [] + members (BNode x le ri) = [x:(members le) ++ (members ri)] + +is_gebalanceerd :: (BTree a) -> Bool | Ord a // meest algemene type +is_gebalanceerd BLeaf = True +is_gebalanceerd (BNode x le ri) = abs ((depth le) - (depth ri)) <= 1 && is_gebalanceerd le && is_gebalanceerd ri +where + depth :: (BTree a) -> Int + depth BLeaf = 0 + depth (BNode x le ri) = max (depth le) (depth ri) + 1 \ No newline at end of file diff --git a/fp2/week6/mart/BinSearchTreeImage.icl b/fp2/week6/mart/BinSearchTreeImage.icl new file mode 100755 index 0000000..9b93810 --- /dev/null +++ b/fp2/week6/mart/BinSearchTreeImage.icl @@ -0,0 +1,71 @@ +module BinSearchTreeImage + +/* Instructions: + +(1) copy BinTree.(i/d)cl and BinSearchTree.(i/d)cl from Practicum to + {iTasks-SDK}\Experiments\SVG_tests\ + +(2) in these modules change the type + + :: Tree a = Node a (Tree a) (Tree a) | Leaf + + to + + :: BTree a = BLeaf | BNode a (BTree a) (BTree a) // ORDER OF DATACONSTRUCTORS IS ESSENTIAL!! + + and adapt the corresponding function definitions. + +(3) this main file (BinSearchTreeImage.icl) must be in the same folder: + {iTasks-SDK}\Experiments\SVG_tests\ + +(4) create a new project and set de environment to 'iTasks' + +(5) Bring-Up-To-Date and start generated application + +(6) Open a browser and navigate to localhost. + The application creates two tasks: + (a) The task on the left allows you to enter subsequent elements that are inserted in the tree, one after another. + (b) The task on the right must be finished by you by writing the function treeImage. This function must render the tree structure in such a way + that Nodes of the same depth have the same y-coordinate, and the root having the smallest y-coordinate. +*/ + +import iTasks // de algemene iTask API +import iTasks.API.Extensions.SVG.SVGlet // specialiseer task editors +from StdFunc import flip + +import BinSearchTree // type definition of Tree and sample trees z0 .. z8 +derive class iTask BTree + +Start :: *World -> *World +Start world = startEngine [publish "/" (WebApp []) (\_ -> task)] world + +task :: Task [Int] +task = withShared [] (\sharedList -> + ( (updateSharedInformation (Title "Edit list") [] sharedList <<@ ArrangeHorizontal) + -||- + (viewSharedInformation (Title "Tree view") [imageView treeImage` (\_ _ -> Nothing)] sharedList <<@ ArrangeHorizontal) + ) <<@ ArrangeHorizontal + ) <<@ FullScreen + +font = normalFontDef "Courier New" fonthoogte +fonthoogte = 14.0 + +treeImage` :: [Int] *TagSource -> Image m +treeImage` nrs tags = fst(treeImage (foldl (flip insertTree) BLeaf nrs) tags) + +TMargin = 10.0 + +treeImage :: (BTree Int) *TagSource -> (Image m, *TagSource) +treeImage BLeaf ts = (margin (px TMargin) (circle (px fonthoogte)), ts) +treeImage (BNode x t1 t2) [(tg1, utg1),(tg2, utg2):ts] += (above (repeat AtMiddleX) [] [textbox, lines, subtrees] Nothing, ts2) + where + (i1, ts1) = treeImage t1 ts + (i2, ts2) = treeImage t2 ts1 + subtrees = beside (repeat AtTop) [] [tag utg1 i1, tag utg2 i2] Nothing + box = rect (textxspan font (toString x)) (px fonthoogte) <@< {fill=toSVGColor "none"} + textbox = overlay (repeat (AtMiddleX, AtMiddleY)) [] [box, text font (toString x)] Nothing + lines = beside (repeat AtBottom) [] [ + line Nothing Slash ((imagexspan tg1) /. 2) (px TMargin), + line Nothing Backslash ((imagexspan tg2) /. 2) (px TMargin)] Nothing + diff --git a/fp2/week6/mart/BinTree.dcl b/fp2/week6/mart/BinTree.dcl new file mode 100755 index 0000000..93d8ed8 --- /dev/null +++ b/fp2/week6/mart/BinTree.dcl @@ -0,0 +1,16 @@ +definition module BinTree + +:: BTree a = BNode a (BTree a) (BTree a) | BLeaf + +t0 :: BTree Int +t1 :: BTree Int +t2 :: BTree Int +t3 :: BTree Int +t4 :: BTree Int +t5 :: BTree Int +t6 :: BTree Int +t7 :: BTree Int + +//nodes :: // meest algemene type +//leaves :: // meest algemene type +//diepte :: // meest algemene type diff --git a/fp2/week6/mart/BinTree.icl b/fp2/week6/mart/BinTree.icl new file mode 100755 index 0000000..7b14e1e --- /dev/null +++ b/fp2/week6/mart/BinTree.icl @@ -0,0 +1,38 @@ +implementation module BinTree + +import StdEnv + +:: BTree a = BNode a (BTree a) (BTree a) | BLeaf + +t0 :: BTree Int +t0 = BLeaf +t1 :: BTree Int +t1 = BNode 4 t0 t0 +t2 :: BTree Int +t2 = BNode 2 t0 t1 +t3 :: BTree Int +t3 = BNode 5 t2 t0 +t4 :: BTree Int +t4 = BNode 5 t2 t2 +t5 :: BTree Int +t5 = BNode 1 BLeaf (BNode 2 BLeaf (BNode 3 BLeaf (BNode 4 BLeaf BLeaf))) +t6 :: BTree Int +t6 = BNode 1 (BNode 2 (BNode 3 (BNode 4 BLeaf BLeaf) BLeaf) BLeaf) BLeaf +t7 :: BTree Int +t7 = BNode 4 (BNode 1 BLeaf BLeaf) (BNode 5 (BNode 2 BLeaf BLeaf) BLeaf) + +// 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] -- 2.20.1