tests/digraph.slate

   1
   2 testing UnitTests define: #Digraph &parents: {TestCase}.
   3
   4 tc@(UnitTests Digraph traits) newNode: obj
   5 [
   6   Digraph Node new `>> [object: obj. ]
   7 ].
   8
   9 tc@(UnitTests Digraph traits) generatingBlockBetween: lower and: upper
  10 [
  11   [| :node obj |
  12     obj: node object.
  13     obj > lower /\ [obj < upper]
  14       ifTrue: [{obj - 1. obj + 1}]
  15       ifFalse: [
  16         obj > lower ifTrue: [{obj - 1}]
  17                     ifFalse: [{obj + 1}]]]
  18 ].
  19
  20 tc@(UnitTests Digraph traits) testCreationByNonGeneratingBlock
  21 [| node graph |
  22   node: (tc newNode: 5).
  23   graph: (Digraph newFrom: node walking: [| :n | {}]).
  24   tc assert: graph allNodes = (Set newWith: node)
  25     description: 'Method #newFrom:walking: failed for non-generative block.'.
  26 ].
  27
  28 tc@(UnitTests Digraph traits) testCreationByWalkingWithABlock
  29 [| nodes graph |
  30   nodes: ({1. 2. 3. 4. 5. 6. 7. 8. 9} as: Set).
  31   graph: (Digraph newFrom: (tc newNode: 5)
  32                   walking: (tc generatingBlockBetween: 1 and: 9)).
  33   tc assert: nodes = (graph allNodes collect: [| :e | e object])
  34     description: 'Method #newFrom:walking: failed (symmetric generation).'.
  35 ].
  36
  37 tc@(UnitTests Digraph traits) testAsymmetricCreationByWalkingWithABlock
  38 [| nodes graph block |
  39   nodes: ({1. 2. 3. 4. 5. 6} as: Set).
  40   block: (tc generatingBlockBetween: 1 and: 6).
  41   graph: (Digraph newFrom: (tc newNode: 1)  walking: block).
  42   tc assert: nodes = (graph allNodes collect: [| :e | e object])
  43     description: 'Method #newFrom:walking: failed (asymmetric generation 1).'.
  44   graph: (Digraph newFrom: (tc newNode: 6)  walking: block).
  45   tc assert: nodes = (graph allNodes collect: [| :e | e object])
  46     description: 'Method #newFrom:walking: failed (asymmetric generation 2).'.
  47
  48 ].
  49
  50 tc@(UnitTests Digraph traits) suite
  51 [
  52   tc suiteForSelectors: {
  53     #testCreationByNonGeneratingBlock.
  54     #testCreationByWalkingWithABlock.
  55     #testAsymmetricCreationByWalkingWithABlock
  56   }
  57 ].
  58
  59 testing UnitTests define: #KeyedDigraph &parents: {UnitTests Digraph}.
  60
  61 tc@(UnitTests KeyedDigraph traits) newNode: obj
  62 [
  63   KeyedDigraph Node new `>> [object: obj. ]
  64 ].
  65
  66 tc@(UnitTests KeyedDigraph traits) keysBetween: lower and: upper
  67 [| answer |
  68   answer: SortedSet new.
  69   lower upTo: upper do: [| :i | answer add: i].
  70   answer
  71 ].
  72
  73 tc@(UnitTests KeyedDigraph traits) testNodeTransitionMatching
  74 [| node1 node2 targets upperBound |
  75   node1: (tc newNode: 1).
  76   node2: (tc newNode: 2).
  77   targets: {tc newNode: 3. tc newNode: 4. tc newNode: 5}.
  78 "  tc assert: (node1 transitionsMatch: node2) = False
  79     description: 'Unrelated nodes should not match.'."
  80   upperBound: 2.
  81   targets do: [| :targetNode |
  82     node1 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
  83     node2 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
  84     upperBound: upperBound + 1].
  85   tc assert: (node1 transitionsMatch: node2) = True
  86     description: 'Nodes with same targets and transitions should match'.
  87   node1 transitions do: [| :edge | edge keys add: 4].
  88   tc assert: (node1 transitionsMatch: node2) = False
  89     description: 'Nodes with differently keyed transitions should not match.'.
  90   node2 transitions do: [| :edge | edge keys add: 4].
  91   node1 addEdgeTo: node2 keys: (tc keysBetween: 1 and: 5).
  92   node2 addEdgeTo: node1 keys: (tc keysBetween: 1 and: 5).
  93   tc assert: (node1 transitionsMatch: node2) = True
  94     description: 'Nodes with symmetric transitions should match.'.
  95 ].
  96
  97 tc@(UnitTests KeyedDigraph traits) testCommutativityOFNodeTransitionMatching
  98 [| node1 node2 targets upperBound |
  99   node1: (tc newNode: 1).
 100   node2: (tc newNode: 2).
 101   targets: {tc newNode: 3. tc newNode: 4. tc newNode: 5}.
 102   upperBound: 2.
 103   targets do: [| :targetNode |
 104     node1 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
 105     node2 addEdgeTo: targetNode keys: (tc keysBetween: 1 and: upperBound).
 106     upperBound: upperBound + 1].
 107   tc assert: (node1 transitionsMatch: node2) = (node2 transitionsMatch: node1)
 108     description: 'Node transition matching should be commutative (both True).'.
 109   node1 transitions do: [| :edge | edge keys add: 4].
 110   tc assert: (node1 transitionsMatch: node2) = (node2 transitionsMatch: node1)
 111     description: 'Node transition matching should be commutative (both False).'.
 112   node2 transitions do: [| :edge | edge keys add: 4].
 113   node1 addEdgeTo: node2 keys: (tc keysBetween: 1 and: 5).
 114   node2 addEdgeTo: node1 keys: (tc keysBetween: 1 and: 5).
 115   tc assert: (node1 transitionsMatch: node2) = (node2 transitionsMatch: node1)
 116     description: 'Node transition matching should be commutative (both True.'.
 117 ].
 118
 119 tc@(UnitTests KeyedDigraph traits) testEdgeMerging
 120 [| startNode endNode mergedKeys |
 121   startNode: (tc newNode: 'start').
 122   endNode: (tc newNode: 'end').
 123   startNode addEdgeTo: endNode keys: (tc keysBetween: 1 and: 3).
 124   startNode addEdgeTo: endNode keys: (tc keysBetween: 4 and: 7).
 125   mergedKeys: (tc keysBetween: 1 and: 7).
 126   startNode mergeTransitions.
 127   tc assert: startNode transitions size = 1
 128               /\ [(startNode transitions detect: [| :edge | edge keys = mergedKeys])
 129                     ifNil: [False]
 130                     ifNotNil: [True]]
 131     description: 'Edges should have been merged.'.
 132 ].
 133
 134 tc@(UnitTests KeyedDigraph traits) testDuplicateDeletion
 135 [| startNode intermediate dupl1 dupl2 endNode mergedKeys |
 136   startNode: (tc newNode: 'start').
 137   intermediate: (tc newNode: 'intermediate').
 138   dupl1: (tc newNode: 'first').
 139   dupl2: (tc newNode: 'second').
 140   endNode: (tc newNode: 'end').
 141   startNode addEdgeTo: intermediate keys: (tc keysBetween: 1 and: 3).
 142   startNode addEdgeTo: intermediate keys: (tc keysBetween: 4 and: 7).
 143   intermediate addEdgeTo: dupl1 keys: (tc keysBetween: 8 and: 9).
 144   startNode addEdgeTo: dupl2 keys: (tc keysBetween: 3 and: 5).
 145   dupl1 addEdgeTo: endNode keys: (tc keysBetween: 2 and: 4).
 146   dupl2 addEdgeTo: endNode keys: (tc keysBetween: 2 and: 4).
 147   startNode removeDuplicateNodes.
 148   tc assert: dupl1 == dupl2
 149     description: 'Duplicate removal should make duplicates the same object.'.
 150 ].
 151
 152 tc@(UnitTests KeyedDigraph traits) suite
 153 [
 154   tc suiteForSelectors: {
 155     #testNodeTransitionMatching.
 156     #testCommutativityOFNodeTransitionMatching.
 157     #testEdgeMerging.
 158     #testDuplicateDeletion
 159   }
 160 ].