hoi

5 files changed, 182 insertions, 0 deletions

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]