home *** CD-ROM | disk | FTP | other *** search
/ ftp.ee.pdx.edu / 2014.02.ftp.ee.pdx.edu.tar / ftp.ee.pdx.edu / pub / users / Harry / cse509 / Tree-Morphic.st < prev    next >
Text File  |  2002-01-23  |  12KB  |  452 lines

  1. Object subclass: #Tree2
  2.     instanceVariableNames: 'label leftChild rightChild parent '
  3.     classVariableNames: 'NodeIcon '
  4.     poolDictionaries: ''
  5.     category: 'Tree-Morphic'!
  6. !Tree2 commentStamp: '<historical>' prior: 0!
  7. Instances of this class are used to represent nodes in a binary tree.  Each instance points to its parent, children and label.
  8.  
  9. label        <a String>    This is the label on this node.
  10. leftChild    <a Tree>        This is a pointer to the left sub-tree, or nil if none.
  11. rightChild    <a Tree>        This is a pointer to the right sub-tree, or nil if none.
  12. parent        <a Tree>        This is a pointer to the parent of this node, or nil if none.!
  13.  
  14.  
  15. !Tree2 methodsFor: 'access' stamp: 'HHP 1/23/2002 13:17'!
  16. label
  17.  
  18.     ^label! !
  19.  
  20. !Tree2 methodsFor: 'access' stamp: 'HHP 1/23/2002 13:17'!
  21. label: aString
  22.  
  23.     label _ aString.! !
  24.  
  25. !Tree2 methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  26. leftChild
  27.  
  28.     ^leftChild! !
  29.  
  30. !Tree2 methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  31. leftChild: aTree
  32.  
  33.     leftChild _ aTree! !
  34.  
  35. !Tree2 methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  36. parent
  37.  
  38.     ^parent! !
  39.  
  40. !Tree2 methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  41. parent: aTree
  42.  
  43.     parent _ aTree! !
  44.  
  45. !Tree2 methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  46. rightChild
  47.  
  48.     ^rightChild! !
  49.  
  50. !Tree2 methodsFor: 'access' stamp: 'HHP 1/22/2001 14:01'!
  51. rightChild: aTree
  52.  
  53.     rightChild _ aTree! !
  54.  
  55.  
  56. !Tree2 methodsFor: 'testing' stamp: 'HHP 1/22/2001 14:02'!
  57. contains: aString
  58.  
  59. "This method answers the question: Does the sub-tree rooted at the receiver contain a node labeled with aString?  It returns a boolean."
  60.  
  61.     (label = aString) ifTrue: [^true].
  62.     (rightChild isNil & leftChild isNil) ifTrue: [^false].
  63.     (leftChild isNil) ifTrue: [^rightChild contains: aString].
  64.     (rightChild isNil) ifTrue: [^leftChild contains: aString].
  65.     ^(leftChild contains: aString) | (rightChild contains: aString)! !
  66.  
  67. !Tree2 methodsFor: 'testing'!
  68. height
  69.  
  70. "Return the height of this sub-tree."
  71.  
  72.     | left right |
  73.  
  74.     left _ leftChild isNil
  75.         ifTrue: [0]
  76.         ifFalse: [leftChild height].
  77.     right _ rightChild isNil
  78.         ifTrue: [0]
  79.         ifFalse: [rightChild height].
  80.     ^ 1 + (left max: right)! !
  81.  
  82. !Tree2 methodsFor: 'testing' stamp: 'HHP 1/22/2001 14:02'!
  83. isLeaf
  84.  
  85. "Is this node a leaf?  Return true or false."
  86.  
  87.     ^ leftChild isNil & rightChild isNil! !
  88.  
  89. !Tree2 methodsFor: 'testing'!
  90. numberOfNodes
  91.  
  92. "This method returns the number of nodes in this sub-tree."
  93.  
  94.     ^ 1
  95.         + (leftChild isNil ifTrue: [0] ifFalse: [leftChild numberOfNodes])
  96.         + (rightChild isNil ifTrue: [0] ifFalse: [rightChild numberOfNodes])! !
  97.  
  98.  
  99. !Tree2 methodsFor: 'tree functions'!
  100. addLeftChild: aTree
  101.  
  102. "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the left child of the receiver."
  103.  
  104.     (leftChild notNil) ifTrue: [
  105.         leftChild remove
  106.     ].
  107.     (aTree notNil) ifTrue: [
  108.         aTree remove.
  109.         aTree parent: self
  110.     ].
  111.     leftChild _ aTree! !
  112.  
  113. !Tree2 methodsFor: 'tree functions'!
  114. addRightChild: aTree
  115.     
  116. "This method first removes aTree from whatever tree it is already in (if any) and then it adds it as the right child of the receiver."
  117.  
  118.     (rightChild notNil) ifTrue: [
  119.         rightChild remove
  120.     ].
  121.     (aTree notNil) ifTrue: [
  122.         aTree remove.
  123.         aTree parent: self
  124.     ].
  125.     rightChild _ aTree! !
  126.  
  127. !Tree2 methodsFor: 'tree functions'!
  128. remove
  129.  
  130. "This method removes the receiver from whatever tree it is in (if any)."
  131.  
  132.     (parent notNil) ifTrue: [
  133.         (parent leftChild = self) ifTrue: [
  134.             parent leftChild: nil
  135.         ].
  136.         (parent rightChild = self) ifTrue: [
  137.             parent rightChild: nil
  138.         ]
  139.     ].
  140.     parent _ nil! !
  141.  
  142. !Tree2 methodsFor: 'tree functions'!
  143. remove: aLabel
  144.  
  145. "Search the tree whose root is the receiver for a node labelled with aLabel and remove that node.  Return the modified tree's new root."
  146.  
  147.     ^ self  "Unimplemented..."! !
  148.  
  149. !Tree2 methodsFor: 'tree functions'!
  150. removeNode: aNode
  151.  
  152. "This method is passed aNode.  It searches the sub-tree self for the node and removes it.  (It does not remove the children of aNode.)  If the tree contains aNode, it returns the modified sub-tree, otherwise it returns 'false'."
  153.  
  154.     | gotIt |
  155.  
  156.     (self = aNode) ifTrue: [
  157.         ^ self removeRoot
  158.     ].
  159.     leftChild notNil ifTrue: [
  160.         gotIt _ leftChild removeNode: aNode.
  161.         (gotIt ~~ false) ifTrue: [^ self]
  162.     ].
  163.     rightChild notNil ifTrue: [
  164.         gotIt _ rightChild removeNode: aNode.
  165.         (gotIt ~~ false) ifTrue: [^ self]
  166.     ].
  167.     ^false! !
  168.  
  169. !Tree2 methodsFor: 'tree functions'!
  170. removeRoot
  171.  
  172. "This method returns a sub-tree containing all the nodes in the tree whose root is the receiver, except the root node.  If the left sub-tree is nil, it just returns the right sub-tree.  Otherwise, it adds the right sub-tree as the right child of the left sub-tree's right-most descendent and returns the modified left sub-tree."
  173.  
  174.     | newRoot |
  175.  
  176.     ((leftChild isNil) & (rightChild isNil)) ifTrue: [
  177.         self remove.
  178.         ^ nil
  179.     ].
  180.     newRoot _ (leftChild isNil)
  181.                     ifTrue: [rightChild]
  182.                     ifFalse: [leftChild rightMostDescendent addRightChild: rightChild. leftChild].
  183.     (parent isNil) ifTrue: [
  184.         ^ (newRoot parent: nil)
  185.     ].
  186.     (parent leftChild == self) ifTrue: [
  187.         parent addLeftChild: newRoot.
  188.         ^ newRoot
  189.     ].
  190.     (parent rightChild == self) ifTrue: [
  191.         parent addRightChild: newRoot.
  192.         ^ newRoot
  193.     ].
  194.     self error: 'Ill-formed tree within removeRoot'! !
  195.  
  196. !Tree2 methodsFor: 'tree functions' stamp: 'HHP 1/23/2002 10:55'!
  197. rightMostDescendent
  198.  
  199. "Return the right-most descendent of the receiver."
  200.  
  201.     | aTree |
  202.     aTree _ self.
  203.     [aTree rightChild isNil]
  204.         whileFalse: [aTree _ aTree rightChild].
  205.     ^ aTree! !
  206.  
  207.  
  208. !Tree2 methodsFor: 'printing' stamp: 'HHP 1/23/2002 13:35'!
  209. printOn: aStream
  210.  
  211. "This method prints a textual representation of the sub-tree rooted at the receiver on aStream."
  212.  
  213.     "PRINT THE CLASS NAME."
  214.     aStream nextPutAll: self class name.
  215.     aStream nextPutAll: ' '.
  216.  
  217.     "PRINT THE LABEL OF THIS NODE."
  218.     label printOn: aStream.
  219.     self isLeaf ifTrue: [^ 'xxx'].
  220.  
  221.     "PRINT THE LEFT CHILD."
  222.     aStream nextPutAll: ' ('.
  223.     (leftChild isNil) ifTrue: [
  224.         aStream nextPutAll: 'nil'
  225.     ] ifFalse: [
  226.         leftChild printOn: aStream
  227.     ].
  228.  
  229.     "PRINT THE RIGHT CHILD."
  230.     aStream nextPutAll: ', '.
  231.     (rightChild isNil) ifTrue: [
  232.         aStream nextPutAll: 'nil'
  233.     ] ifFalse: [
  234.         rightChild printOn: aStream
  235.     ].
  236.     aStream nextPutAll: ')'.
  237. ! !
  238.  
  239. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  240.  
  241. Tree2 class
  242.     instanceVariableNames: ''!
  243.  
  244. !Tree2 class methodsFor: 'instance-creation' stamp: 'HHP 1/23/2002 13:16'!
  245. withLabel: aString
  246.         "This method returns a new Tree2 with its label initialized to aString and with no children."
  247.         | tree |
  248.         tree _ self new.
  249.         tree label: aString copy.
  250.         ^ tree! !
  251.  
  252. !Tree2 class methodsFor: 'instance-creation' stamp: 'HHP 1/23/2002 13:16'!
  253. withLabel: aLabel withLeft: left withRight: right
  254.         "Create a node with aLabel.  Left and right should be either sub-trees or nil.  Add them as children to this node.  Return the result."
  255.         | tree |
  256.         tree _ self new.
  257.         tree label: aLabel copy.
  258.         tree addLeftChild: left.
  259.         tree addRightChild: right.
  260.         ^ tree! !
  261.  
  262.  
  263. !Tree2 class methodsFor: 'Initialization' stamp: 'HHP 1/13/2001 11:18'!
  264. initialize
  265.  
  266.     "This method initializes the class variable NodeIcon to contain a Form suitable for use
  267.         in displaying an individual Node."
  268.     "Tree initialize."
  269.  
  270.     | aCircle |
  271.  
  272.     NodeIcon _ Form extent: 25 @ 25.
  273.     aCircle _ Circle new.
  274.     aCircle radius: 13.
  275.     aCircle center: 12@12.
  276.     aCircle displayOn: NodeIcon.
  277. ! !
  278.  
  279.  
  280. Morph subclass: #TreeMorph
  281.     instanceVariableNames: 'tree '
  282.     classVariableNames: ''
  283.     poolDictionaries: ''
  284.     category: 'Tree-Morphic'!
  285.  
  286. !TreeMorph methodsFor: 'accessing' stamp: 'HHP 1/23/2002 11:53'!
  287. tree
  288.     ^ tree! !
  289.  
  290. !TreeMorph methodsFor: 'accessing' stamp: 'HHP 1/23/2002 13:23'!
  291. tree: aTree
  292.     tree _ aTree! !
  293.  
  294.  
  295. !TreeMorph methodsFor: 'menus' stamp: 'HHP 1/23/2002 13:24'!
  296. addCustomMenuItems: aCustomMenu hand: aHandMorph
  297.     super addCustomMenuItems: aCustomMenu hand: aHandMorph.
  298.     aCustomMenu add: 'rename root' action: #renameRoot.
  299. ! !
  300.  
  301. !TreeMorph methodsFor: 'menus' stamp: 'HHP 1/23/2002 13:24'!
  302. renameRoot
  303.     tree label: 'newName'.
  304.     self changed.! !
  305.  
  306.  
  307. !TreeMorph methodsFor: 'drawing' stamp: 'HHP 1/23/2002 12:35'!
  308. drawOn: aCanvas
  309.  
  310.     aCanvas
  311.         frameAndFillRectangle: (self position extent: self extent)
  312.         fillColor: Color lightBlue
  313.         borderWidth: 2
  314.         topLeftColor: Color black
  315.         bottomRightColor: Color black.
  316.     self
  317.         drawSubtree: tree
  318.         on: aCanvas
  319.         at: self position + (150@4)
  320.         xIncr: 50
  321.         yIncr: 50.
  322. ! !
  323.  
  324. !TreeMorph methodsFor: 'drawing' stamp: 'HHP 1/23/2002 13:25'!
  325. drawSubtree: aTree on: aCanvas at: aPoint xIncr: xIncr yIncr: yIncr
  326.  
  327. "Draw this sub-tree on the given canvas.  It displays edges leading down to its sub-trees and then it calls itself recursively to obtain a display of its sub-trees."
  328.  
  329.     | bottomPoint leftPoint rightPoint |
  330.  
  331.     "DEBUGGING: DISPLAY A BLUE RECTANGLE WHOSE UPPER CORNER IS AT aPoint."
  332.     "aCanvas fillRectangle: (aPoint extent: 50@50) color: Color blue."
  333.  
  334.     "DISPLAY THE OVAL AND THE LABEL TEXT."
  335.     aCanvas fillOval: (aPoint-(20@0) extent: 40@25) color: Color yellow borderWidth: 1 borderColor: Color black.
  336.     aCanvas text: aTree label at: (aPoint x - 13) @ (aPoint y + 5) font: nil color: Color black.
  337.  
  338.     "DISPLAY THE LEFT SUB-TREE AND A LINE DOWN TO IT."
  339.     bottomPoint _ (aPoint x ) @ (aPoint y + 24).
  340.     leftPoint _ (aPoint x - xIncr) @ (aPoint y + yIncr).
  341.     (aTree leftChild) notNil ifTrue: [
  342.         aCanvas line: bottomPoint to: leftPoint color: Color black.
  343.         self
  344.             drawSubtree: aTree leftChild
  345.             on: aCanvas at: leftPoint
  346.             xIncr: xIncr//2
  347.             yIncr: yIncr
  348.     ].
  349.  
  350.     "DISPLAY THE RIGHT SUB-TREE AND A LINE DOWN TO IT."
  351.     rightPoint _ (aPoint x + xIncr) @ (aPoint y + yIncr).
  352.     (aTree rightChild) notNil ifTrue: [
  353.         aCanvas line: bottomPoint to: rightPoint color: Color black.
  354.         self
  355.             drawSubtree: aTree rightChild
  356.             on: aCanvas at: rightPoint
  357.             xIncr: xIncr//2
  358.             yIncr: yIncr
  359.     ]! !
  360.  
  361. !TreeMorph methodsFor: 'drawing' stamp: 'HHP 1/23/2002 12:28'!
  362. extent: aPoint
  363.     super extent: aPoint! !
  364.  
  365. !TreeMorph methodsFor: 'drawing' stamp: 'HHP 1/23/2002 13:37'!
  366. findNodeIn: aTree containingPoint: mousePoint whenDisplayedAt: aPoint clippingBox: clipBox xIncr: xIncr yIncr: yIncr
  367.  
  368. "Imagine that we are displaying this tree, but do not display anything.  Instead, ask which node would contain mousePoint within its oval and return that node.  Return nil if no node contains mousePoint."
  369.  
  370.     | whereWouldBeDisplayed leftPoint ans rightPoint |
  371.  
  372.     self error: 'This message is not tested'.
  373.  
  374.     "SEE WHERE WE WOULD HAVE DISPLAYED THE OVAL AND SEE IF IT CONTAINS mousePoint."
  375.     whereWouldBeDisplayed _ 
  376.                     (aPoint-(20@0) extent: 40@25)
  377.                             intersect: clipBox.
  378.     (whereWouldBeDisplayed containsPoint: mousePoint) ifTrue: [^self].
  379.  
  380.     "OTHERWISE, CHECK TO SEE IF THE LEFT SUB-TREE CONTAINS mousePoint."
  381.     (aTree leftChild notNil) ifTrue: [
  382.         leftPoint _ (aPoint x - xIncr) @ (aPoint y + yIncr).
  383.         ans _ self findNodeIn: aTree leftChild
  384.                 containingPoint: mousePoint
  385.                 whenDisplayedAt: leftPoint
  386.                 clippingBox: clipBox
  387.                 xIncr: xIncr//2
  388.                 yIncr: yIncr.
  389.         (ans notNil) ifTrue: [^ ans]
  390.     ].
  391.  
  392.     "OTHERWISE, CHECK TO SEE IF THE RIGHT SUB-TREE CONTAINS mousePoint."
  393.     (aTree rightChild notNil) ifTrue: [
  394.         rightPoint _ (aPoint x + xIncr) @ (aPoint y + yIncr).
  395.         ans _ self findNodeIn: aTree rightChild
  396.                 containingPoint: mousePoint
  397.                 whenDisplayedAt: rightPoint
  398.                 clippingBox: clipBox
  399.                 xIncr: xIncr//2
  400.                 yIncr: yIncr.
  401.         (ans notNil) ifTrue: [^ ans]
  402.     ].
  403.  
  404.     "OTHERWISE, RETURN nil."
  405.     ^ nil! !
  406.  
  407.  
  408. !TreeMorph methodsFor: 'printing' stamp: 'HHP 1/23/2002 11:58'!
  409. printOn: aStream
  410.  
  411.     aStream nextPutAll: 'TreeMorph ('.
  412.     (tree isNil) ifTrue: [
  413.         aStream nextPutAll: 'nil'
  414.     ] ifFalse: [
  415.         tree printOn: aStream
  416.     ].
  417.     aStream nextPutAll: ')'.
  418. ! !
  419.  
  420. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  421.  
  422. TreeMorph class
  423.     instanceVariableNames: ''!
  424.  
  425. !TreeMorph class methodsFor: 'instance-creation' stamp: 'HHP 1/23/2002 13:30'!
  426. withTree: aTree
  427.  
  428.     | tm |
  429.  
  430.     tm _ self new.
  431.     tm tree: aTree.
  432.     tm extent: 300@300.
  433.     ^ tm! !
  434.  
  435.  
  436. !TreeMorph class methodsFor: 'examples' stamp: 'HHP 1/23/2002 13:44'!
  437. example
  438.  
  439.     "TreeMorph example"
  440.  
  441.     | t u w v s tm |
  442.  
  443.     t _ Tree2 withLabel: 'ttt'.
  444.     u _ Tree2  withLabel: 'uuu'.
  445.     w _ Tree2  withLabel: 'www' withLeft: u withRight: nil.
  446.     v _ Tree2  withLabel: 'vvv' withLeft: nil withRight: w.
  447.     s _ Tree2  withLabel: 'sss' withLeft: t withRight: v.
  448.     tm _ TreeMorph withTree: s.
  449.     tm openInWorld
  450. ! !
  451.  
  452. Tree2 initialize!