diff options
| author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
|---|---|---|
| committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
| commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
| tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/struct/graph/tests | |
| parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
| parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
| download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 | |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/struct/graph/tests')
86 files changed, 12122 insertions, 0 deletions
diff --git a/tcllib/modules/struct/graph/tests/XOpsControl b/tcllib/modules/struct/graph/tests/XOpsControl new file mode 100644 index 0000000..3c9f73a --- /dev/null +++ b/tcllib/modules/struct/graph/tests/XOpsControl @@ -0,0 +1,60 @@ +# -*- tcl -*- +# graph.testsuite: tests for the graph operations. +# +# Copyright (c) 2008-2009 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# +# RCS: @(#) $Id: XOpsControl,v 1.22 2009/09/24 19:30:11 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +set SELF [file dirname [info script]] + +# ------------------------------------------------------------------------- + +source ${SELF}/Xsetup +source ${SELF}/Xsupport +source ${SELF}/XOpsSetup + +source ${SELF}/ops/adjmatrix.test ; # Adjacency matrix +source ${SELF}/ops/kruskal.test ; # Minimum spanning tree/forest by Kruskal +source ${SELF}/ops/prim.test ; # Minimum spanning tree/forest by Prim +source ${SELF}/ops/bipartite.test ; # Compute bi-partitions. +## source ${SELF}/ops/maxmatching.test ; # Compute maximal matching from bipartitions. +source ${SELF}/ops/tarjan.test ; # Compute SCCs via Tarjan. +source ${SELF}/ops/components.test ; # Compute connected components. +source ${SELF}/ops/componentof.test ; # Compute connected components II. +source ${SELF}/ops/connected.test ; # Graph connected ? +source ${SELF}/ops/cutvertex.test ; # Node a cut vertex? +source ${SELF}/ops/bridge.test ; # Arc a bridge? +source ${SELF}/ops/eulertour.test ; # Eulerian graphs +source ${SELF}/ops/eulerpath.test ; # Semi-eulerian graphs +source ${SELF}/ops/dijkstra.test ; # Node distances by Dijkstra + +source ${SELF}/ops/distance.test ; # Node distances +source ${SELF}/ops/eccentricity.test ; # Node eccentricity +source ${SELF}/ops/radius.test ; # Graph radius +source ${SELF}/ops/diameter.test ; # Graph diameter + +source ${SELF}/ops/adjlist.test ; # Adjacency lists +source ${SELF}/ops/bellmanford.test ; # Distances by Bellman-Ford +source ${SELF}/ops/bfs.test ; # Breadth-First Searching. +source ${SELF}/ops/busackergowen.test; # Minimum-Cost Maximum-Flow by Busacker-Gowen +source ${SELF}/ops/christofides.test ; # mTSP by Christofides, 3/2-approximation algorithm +source ${SELF}/ops/dinicblockingflow.test ; # Blocking-Flow by Dinic +source ${SELF}/ops/dinicmaximumflow.test ; # Maximum-Flow by Dinic +source ${SELF}/ops/edmondskarp.test ; # Maximum-Flow by Edmonds-Karp +source ${SELF}/ops/floydwarshall.test; # Distances by Floyd-Warshall +source ${SELF}/ops/johnsons.test ; # Distances by Johnsons +source ${SELF}/ops/kcenter.test ; # Metric K-Center, 2-approximation algorithm +source ${SELF}/ops/maxcut.test ; # Maximum Cut, 2-approximation algorithm +source ${SELF}/ops/mdst.test ; # Minimum Diameter/Degree Spanning Trees +source ${SELF}/ops/metrictsp.test ; # Metric Travelling Salesman Problem (mTSP) +# # 2-approximation algorithm. +source ${SELF}/ops/mkmblockingflow.test ; # Blocking Flow by Malhotra, Kumar and Maheshwari +source ${SELF}/ops/tspheuristics.test; # Heuristics of local searching for TSP +# # 2- and 3-approximation algorithms +source ${SELF}/ops/verticescover.test; # Vertex Cover, 2-approximation algorithm +source ${SELF}/ops/weightedkcenter.test ; # Weighted Metric K-Center, 3-approximation algorithm + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/XOpsSetup b/tcllib/modules/struct/graph/tests/XOpsSetup new file mode 100644 index 0000000..ddf46fe --- /dev/null +++ b/tcllib/modules/struct/graph/tests/XOpsSetup @@ -0,0 +1,2750 @@ +# -*- tcl -*- +# graphops.testsuite.setup: Setting up implementation specific definitions. +# +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# +# RCS: @(#) $Id: XOpsSetup,v 1.13 2009/11/03 17:38:30 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +# Place holder for future setup / helper actions. + + +proc SETUP_A {} { + # Used by kruskal, prim tests + + struct::graph mygraph + mygraph node insert 'node0' + mygraph node insert 'node1' + mygraph node insert 'node2' + mygraph node insert 'node3' + mygraph node insert 'node4' + mygraph node insert 'node5' + mygraph node insert 'node6' + + mygraph arc insert 'node0' 'node1' 'arc0_1' + mygraph arc insert 'node0' 'node3' 'arc0_3' + mygraph arc insert 'node1' 'node3' 'arc1_3' + mygraph arc insert 'node1' 'node4' 'arc1_4' + mygraph arc insert 'node2' 'node0' 'arc2_0' + mygraph arc insert 'node2' 'node5' 'arc2_5' + mygraph arc insert 'node3' 'node4' 'arc3_4' + mygraph arc insert 'node3' 'node6' 'arc3_6' + mygraph arc insert 'node3' 'node2' 'arc3_2' + mygraph arc insert 'node3' 'node5' 'arc3_5' + mygraph arc insert 'node4' 'node6' 'arc4_6' + mygraph arc insert 'node6' 'node5' 'arc6_5' + + mygraph arc setweight 'arc0_1' 2 + mygraph arc setweight 'arc0_3' 1 + mygraph arc setweight 'arc1_3' 3 + mygraph arc setweight 'arc1_4' 10 + mygraph arc setweight 'arc2_0' 4 + mygraph arc setweight 'arc2_5' 5 + mygraph arc setweight 'arc3_4' 2 + mygraph arc setweight 'arc3_6' 4 + mygraph arc setweight 'arc3_2' 2 + mygraph arc setweight 'arc3_5' 8 + mygraph arc setweight 'arc4_6' 6 + mygraph arc setweight 'arc6_5' 1 + + # 2 --/4/--> 0 --/2/--> 1 + # |^ | /| + # - \ - / - + # 5 -|2|- 1 -/3/- 10 + # - \ - / - + # | \ | / | + # V \VV V + # 5 <--/8/-- 3 --/2/--> 4 + # ^ | / + # \ - / + # -|1|- 4 -/6/- + # \ - / + # \ | / + # \VV + # 6 + + return +} + +proc SETUP_A2 {} { + SETUP_A + mygraph arc insert 'node0' 'node2' 'arc0_2' + mygraph arc insert 'node0' 'node4' 'arc0_4' + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_B {} { + # Predefined Graph for testing on: + # - isConnected? + # - connectedComponents + # - prim + # - isEulerian? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + # Graph's nodes definition + mygraph node insert S + mygraph node insert A + mygraph node insert B + mygraph node insert C + mygraph node insert D + mygraph node insert E + + # setup arcs and it's weights + mygraph arc insert S A S_A ; mygraph arc setweight S_A 3 + mygraph arc insert A C A_C ; mygraph arc setweight A_C 2 + mygraph arc insert S B S_B ; mygraph arc setweight S_B 1 + mygraph arc insert A B A_B ; mygraph arc setweight A_B 1 + mygraph arc insert B C B_C ; mygraph arc setweight B_C 3 + mygraph arc insert B D B_D ; mygraph arc setweight B_D 5 + mygraph arc insert C D C_D ; mygraph arc setweight C_D 1 + mygraph arc insert D E D_E ; mygraph arc setweight D_E 1 + mygraph arc insert C E C_E ; mygraph arc setweight C_E 3 + + # S --/3/--> A --/2/--> C --/3/--> E + # \ | /^| /-^ + # \ - / - / + # -|1| 1 -|3|- 1 -|1|- + # \ - / - / + # \ V/ V/ + # > B --/5/--> D + # + + return +} + +proc SETUP_B2 {} { + struct::graph mygraph + + mygraph node insert A B C D E F G + + mygraph arc insert A B + mygraph arc insert A E + mygraph arc insert B D + mygraph arc insert B F + mygraph arc insert C A + mygraph arc insert D C + mygraph arc insert E B + mygraph arc insert E F + mygraph arc insert F A + mygraph arc insert F G + mygraph arc insert G E + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_C {} { + # Predefined Graph for testing on: + # - isConnected? + # - isEulerian? + # - isBipartite? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + mygraph node insert A + mygraph node insert B + mygraph node insert C + mygraph node insert D + mygraph node insert E + mygraph node insert F + + mygraph arc insert A B A_B + mygraph arc insert B D B_D + mygraph arc insert D C D_C + mygraph arc insert C A C_A + mygraph arc insert A E A_E + mygraph arc insert E F E_F + + mygraph arc setweight A_B 9 + mygraph arc setweight B_D 10 + mygraph arc setweight D_C 4 + mygraph arc setweight C_A 3 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_D {} { + # Predefined Graph for testing on: + # - isConnected? + # - isEulerian? + # - isBipartite? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + mygraph node insert a + mygraph node insert b + mygraph node insert c + mygraph node insert d + + mygraph node insert f + mygraph node insert g + mygraph node insert h + + mygraph node insert i + mygraph node insert j + + mygraph arc insert d f + mygraph arc insert h j + mygraph arc insert i j + mygraph arc insert f g + mygraph arc insert g h + mygraph arc insert h f + mygraph arc insert a b + mygraph arc insert b c + mygraph arc insert c d + mygraph arc insert d a + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_E {} { + # Predefined Graph for testing on: + # - isBipartite? + # - maxMatching + # - isEulerian? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + mygraph node insert 1w + mygraph node insert 1b + mygraph node insert 2w + mygraph node insert 2b + mygraph node insert 3w + mygraph node insert 3b + mygraph node insert 4w + mygraph node insert 4b + mygraph node insert 5w + mygraph node insert 5b + mygraph node insert 6w + mygraph node insert 6b + mygraph node insert 7w + mygraph node insert 7b + mygraph node insert 8w + mygraph node insert 8b + + mygraph arc insert 1b 1w + mygraph arc insert 1b 2w + mygraph arc insert 2b 1w + mygraph arc insert 2b 2w + mygraph arc insert 2b 3w + mygraph arc insert 2b 4w + mygraph arc insert 3b 2w + mygraph arc insert 3b 3w + mygraph arc insert 3b 5w + mygraph arc insert 3w 4b + mygraph arc insert 4b 3w + mygraph arc insert 4b 4w + mygraph arc insert 4b 6w + mygraph arc insert 4w 5b + mygraph arc insert 4w 7b + mygraph arc insert 5b 5w + mygraph arc insert 5b 6w + mygraph arc insert 5w 6b + mygraph arc insert 6b 6w + mygraph arc insert 6w 7b + mygraph arc insert 6w 8b + mygraph arc insert 7b 7w + mygraph arc insert 7w 8b + mygraph arc insert 8b 8w + mygraph arc insert 8w 7b + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_F {} { + # Predefined Graph for testing on: + # - isBipartite? + # - maxMatching + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + struct::graph mygraph + + mygraph node insert 1w + mygraph node insert 1b + mygraph node insert 2w + mygraph node insert 2b + mygraph node insert 3w + mygraph node insert 3b + mygraph node insert 4w + mygraph node insert 4b + + mygraph arc insert 1b 2w + mygraph arc insert 1b 3w + mygraph arc insert 1b 4w + mygraph arc insert 1w 3b + mygraph arc insert 2b 1w + mygraph arc insert 2b 3w + mygraph arc insert 3b 2w + mygraph arc insert 3w 4b + mygraph arc insert 4b 1w + mygraph arc insert 4b 2w + mygraph arc insert 4w 2b + mygraph arc insert 4w 3b + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_G {} { + # Predefined Graph for testing on: + # - isBipartite? + # - maxMatching + # - isBridge? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + + mygraph node insert 1w + mygraph node insert 1b + mygraph node insert 2w + mygraph node insert 2b + mygraph node insert 3w + mygraph node insert 3b + mygraph node insert 4w + mygraph node insert 4b + mygraph node insert 5w + mygraph node insert 5b + + mygraph arc insert 1b 5w bridge1 + mygraph arc insert 2b 4w + mygraph arc insert 2w 4b + mygraph arc insert 2w 5b + mygraph arc insert 3b 4w + mygraph arc insert 3w 4b + mygraph arc insert 3w 5b + mygraph arc insert 4b 4w bridge2 + mygraph arc insert 5b 1w bridge3 + mygraph arc insert 5w 2b + mygraph arc insert 5w 3b nobridge + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_H {} { + # Predefined Graph for testing on: + # - isConnected? + # - isEulerian? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + mygraph node insert A + mygraph node insert B + mygraph node insert C + mygraph node insert D + mygraph node insert E + + mygraph arc insert A B A_B ; mygraph arc setweight A_B 10 + mygraph arc insert B C B_C ; mygraph arc setweight B_C 8 + mygraph arc insert D C D_C ; mygraph arc setweight D_C 2 + mygraph arc insert B D B_D ; mygraph arc setweight B_D 7 + mygraph arc insert C D C_D ; mygraph arc setweight C_D 1 + mygraph arc insert D E D_E ; mygraph arc setweight D_E 6 + mygraph arc insert E A E_A ; mygraph arc setweight E_A 4 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_I {} { + # Predefined Graph for testing on: + # isConnected? + # isEulerian? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + + mygraph node insert N1 + mygraph node insert N2 + mygraph node insert N3 + mygraph node insert N4 + mygraph node insert N5 + + mygraph arc insert N1 N5 N1_N5 + mygraph arc insert N2 N5 N2_N5 + mygraph arc insert N3 N5 N3_N5 + mygraph arc insert N4 N5 N4_N5 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_J {} { + # Predefined Graph for testing on: + # isConnected? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + + mygraph node insert 1 + mygraph node insert 2 + mygraph node insert 3 + mygraph node insert 4 + mygraph node insert 5 + mygraph node insert 6 + mygraph node insert 7 + + mygraph arc insert 7 6 + mygraph arc insert 6 7 + mygraph arc insert 1 4 + mygraph arc insert 4 5 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_K {} { + # Predefined Graph for testing on: + # isConnected? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + + mygraph node insert No1 + mygraph node insert No2 + mygraph node insert No3 + mygraph node insert No4 + mygraph node insert No5 + + mygraph arc insert No1 No2 a + mygraph arc insert No2 No3 b + mygraph arc insert No3 No4 c + mygraph arc insert No4 No2 d + + mygraph arc insert No5 No5 e + return +} + +proc SETUP_K2 {} { + SETUP_K + mygraph arc insert No5 No1 f + mygraph arc insert No5 No2 g + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_L {} { + # Koenigsberg. + + struct::graph mygraph + mygraph node insert a b c d + mygraph arc insert a c + mygraph arc insert a d + mygraph arc insert b a + mygraph arc insert b c + mygraph arc insert c a + mygraph arc insert d a + mygraph arc insert d b + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_M {} { + # penta-hex-something + + struct::graph mygraph + mygraph node insert 1 2 3 4 5 6 + mygraph arc insert 1 2 + mygraph arc insert 2 3 + mygraph arc insert 3 4 + mygraph arc insert 4 5 + mygraph arc insert 5 1 + mygraph arc insert 1 6 + mygraph arc insert 6 2 + mygraph arc insert 2 5 + mygraph arc insert 5 6 + mygraph arc insert 6 3 + mygraph arc insert 3 1 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_N {} { + # Predefined Graph for testing on: + # isConnected? + # Author: Alejandro Eduardo Cruz Paz + # 28 August 2008 + + struct::graph mygraph + + mygraph node insert 0 1 2 a b c d e f + mygraph arc insert 0 1 + mygraph arc insert 1 2 + mygraph arc insert 2 0 + + mygraph arc insert a b + mygraph arc insert b 0 + mygraph arc insert 0 a + + mygraph arc insert c d + mygraph arc insert d 1 + mygraph arc insert 1 c + + mygraph arc insert e f + mygraph arc insert f 2 + mygraph arc insert 2 e + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BELLMANFORD_1 {} { + #Graph for testing Bellman's Ford algorithm (and also other pathfinding algorithms) + #Used for: + #Bellman's-Ford + #Floyd-Warshall's + #Basic test + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node2 edge12 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node3 node4 edge34 + mygraph arc insert node4 node1 edge41 + + mygraph arc setunweighted 1 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BELLMANFORD_2 {} { + #Graph for testing Bellman-Ford's Algorithm + #More complex test case + #Used by: + #Bellman-Ford's Algorithm + #Floyd-Warshall's Algorithm + #Shortest Pathfinding by BFS algorithm + #BFS Algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + + mygraph arc insert node1 node2 edge12 + mygraph arc setweight edge12 8 + mygraph arc insert node1 node3 edge13 + mygraph arc setweight edge13 6 + mygraph arc insert node2 node4 edge24 + mygraph arc setweight edge24 -1 + mygraph arc insert node3 node2 edge32 + mygraph arc setweight edge32 3 + mygraph arc insert node3 node5 edge35 + mygraph arc setweight edge35 -2 + mygraph arc insert node4 node3 edge43 + mygraph arc setweight edge43 -2 + mygraph arc insert node4 node6 edge46 + mygraph arc setweight edge46 3 + mygraph arc insert node5 node6 edge56 + mygraph arc setweight edge56 2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_POSITIVEWEIGHTED_K4 {} { + SETUP_UNWEIGHTED_K4 + mygraph arc setunweighted 2 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_NEGATIVECYCLE_1 {} { + #Graph containing cycle with negative sum of weights + #Used for testing: + #Bellman-Ford's Algorithm + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 + mygraph arc insert node1 node2 edge12 + mygraph arc setweight edge12 -1 + mygraph arc insert node2 node3 edge23 + mygraph arc setweight edge23 -2 + mygraph arc insert node3 node1 edge31 + mygraph arc setweight edge31 -3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_NEGATIVECYCLE_2 {} { + #Graph containing cycle with negative sum of weights + #Used for testing: + #Bellman-Ford's Algorithm + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node6 + mygraph arc insert node6 node5 + mygraph arc insert node5 node4 + mygraph arc insert node4 node3 + mygraph arc insert node3 node2 + mygraph arc insert node2 node1 + mygraph arc insert node6 node2 edge62 + mygraph arc setweight edge62 -5 + mygraph arc setunweighted 1 + + return + +} + +# ------------------------------------------------------------------------- + +proc SETUP_NEGATIVECYCLE_3 {} { + #Graph containing cycle with negative sum of weights + #Used for testing: + #Bellman-Ford's Algorithm + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 + mygraph arc insert node1 node2 edge12 + mygraph arc setweight edge12 6 + mygraph arc insert node1 node5 edge15 + mygraph arc setweight edge15 7 + mygraph arc insert node2 node4 edge24 + mygraph arc setweight edge24 -4 + mygraph arc insert node2 node5 edge25 + mygraph arc setweight edge25 2 + mygraph arc insert node3 node2 edge32 + mygraph arc setweight edge32 -2 + mygraph arc insert node4 node3 edge43 + mygraph arc setweight edge43 7 + mygraph arc insert node4 node1 edge41 + mygraph arc setweight edge41 2 + mygraph arc insert node5 node3 edge53 + mygraph arc setweight edge53 -3 + mygraph arc insert node5 node4 edge54 + mygraph arc setweight edge54 9 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_K4 {} { + #Complete graph with 4 nodes + #Here without one edge - test for directed graphs + #Used by: + #For distance searches: Johnson's and Bellman-Ford's + #Vertices Cover + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + + mygraph arc insert node1 node2 edge12 + mygraph arc setweight edge12 1 + mygraph arc insert node1 node3 edge13 + mygraph arc setweight edge13 1 + mygraph arc insert node1 node4 edge14 + mygraph arc setweight edge14 1 + + mygraph arc insert node2 node1 edge21 + mygraph arc setweight edge21 1 + mygraph arc insert node2 node3 edge23 + mygraph arc setweight edge23 1 + mygraph arc insert node2 node4 edge24 + mygraph arc setweight edge24 1 + + mygraph arc insert node3 node1 edge31 + mygraph arc setweight edge31 1 + mygraph arc insert node3 node2 edge32 + mygraph arc setweight edge32 1 + mygraph arc insert node3 node4 edge34 + mygraph arc setweight edge34 1 + + mygraph arc insert node4 node1 edge41 + mygraph arc setweight edge41 2 + mygraph arc insert node4 node2 edge42 + mygraph arc setweight edge42 2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_PARTIALLYCONNECTED_1 {} { + + #Graph where their does not exists a path between each pair of vertices + #Used for testing: + #Bellman-Ford's Algorithm (Causes appearing of Inf values as a result) + #Johnson's Algorithm (Causes appearing of Inf values as a result) + #Metric Travelling Salesman 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 + + mygraph arc insert node1 node5 + mygraph arc insert node2 node5 + mygraph arc insert node3 node5 + mygraph arc insert node4 node5 + + mygraph arc setunweighted 1 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_JOHNSONS_1 {} { + #Graph for testing Johnson's Algorithm + #Used by: + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + # + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 + + mygraph arc insert node1 node3 edge13 + mygraph arc setweight edge13 1 + mygraph arc insert node1 node4 edge14 + mygraph arc setweight edge14 7 + + mygraph arc insert node2 node1 edge21 + mygraph arc setweight edge21 4 + + mygraph arc insert node3 node2 edge32 + mygraph arc setweight edge32 -5 + mygraph arc insert node3 node5 edge35 + mygraph arc setweight edge35 2 + + mygraph arc insert node4 node3 edge43 + mygraph arc setweight edge43 6 + + mygraph arc insert node5 node1 edge51 + mygraph arc setweight edge51 3 + mygraph arc insert node5 node2 edge52 + mygraph arc setweight edge52 8 + mygraph arc insert node5 node4 edge54 + mygraph arc setweight edge54 -4 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_JOHNSONS_2 {} { + #Graph for testing Johnson's Algorithm + #Used by: + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + + mygraph arc insert node1 node2 edge12 + mygraph arc setweight edge12 8 + mygraph arc insert node1 node6 edge16 + mygraph arc setweight edge16 6 + mygraph arc insert node2 node3 edge23 + mygraph arc setweight edge23 -1 + mygraph arc insert node3 node4 edge34 + mygraph arc setweight edge34 3 + mygraph arc insert node3 node6 edge36 + mygraph arc setweight edge36 -2 + mygraph arc insert node5 node4 edge54 + mygraph arc setweight edge54 2 + mygraph arc insert node6 node2 edge62 + mygraph arc setweight edge62 3 + mygraph arc insert node6 node5 edge65 + mygraph arc setweight edge65 -2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_UNWEIGHTED_K4 {} { + #Unweighted directed complete graph K4 + #Used by: + #Bellman's-Ford + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + #Metric Travelling Salesman 2-approximation algorithm + #Christofides Algorithm + #Greedy Maximum Independent Set algorithm + #Unweighted k-center 2-approximation algorithm + #Weighted k-center 3-approximation algorithm + #Greedy Weighted Maximum Independent Set algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + + mygraph arc insert node1 node2 + mygraph arc insert node1 node3 + mygraph arc insert node1 node4 + mygraph arc insert node2 node3 + mygraph arc insert node2 node4 + mygraph arc insert node2 node1 + mygraph arc insert node3 node1 + mygraph arc insert node3 node2 + mygraph arc insert node3 node4 + mygraph arc insert node4 node1 + mygraph arc insert node4 node2 + mygraph arc insert node4 node3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_UNDIRECTED_K4 {} { + #Undirected complete graph K4 + #Used by: + #Metric Travelling Salesman 2-approximation algorithm + #Vertices Cover + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + + mygraph arc insert node1 node2 edge12 + mygraph arc insert node1 node3 edge13 + mygraph arc insert node1 node4 edge14 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node2 node4 edge24 + mygraph arc insert node3 node4 edge34 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_PARTIALLYWEIGHTED_K4 {} { + #complete graph K4 with some weights set on edges + #Used by: + #Bellman's-Ford + #Johnson's Algorithm + SETUP_UNWEIGHTED_K4 + + mygraph arc setweight arc1 1 + mygraph arc setweight arc2 2 + mygraph arc setweight arc3 3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_NOEDGES_1 {} { + #Graph containing only nodes + #Used by: + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + #Metric Travelling Salesman 2-approximation algorithm + #Christofides Algorithm + #Max Cut 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_ZEROWEIGHTED_K4 {} { + #K4 graph with all edge's weights set to 0 + #Used by: + #Bellman's-Ford + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + + SETUP_UNWEIGHTED_K4 + mygraph arc setunweighted + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_PARTIALLYZEROWEIGHTED {} { + #graph with some weights of edges set to 0 (others set to 1) + #Used by: + #Bellman's-Ford + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + + SETUP_BELLMANFORD_1 + + mygraph arc setweight edge12 0 + mygraph arc setweight edge23 0 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_PARTIALLYZEROWEIGHTED_K4 {} { + #K4 graph with some weights of edges set to 0 + #Used by: + #Bellman's-Ford + #Johnson's Algorithm + #Floyd-Warshall's Algorithm + + SETUP_ZEROWEIGHTED_K4 + + mygraph arc setweight arc1 1 + mygraph arc setweight arc2 2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_ADJACENCYLIST_K4 {} { + #special undirected K4 case where we have two arcs between two nodes + #with different sources and targets + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + + mygraph arc insert node1 node2 + mygraph arc insert node1 node3 + mygraph arc insert node1 node4 edge14 + mygraph arc insert node2 node3 + mygraph arc insert node3 node4 + mygraph arc insert node4 node1 edge41 + + return +} +# ------------------------------------------------------------------------- + +proc SETUP_ADJACENCYLIST_K4_WEIGHTED {} { + #weighted version of upper graph + SETUP_ADJACENCYLIST_K4 + + mygraph arc setunweighted 1 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_ADJACENCYLIST_K4_WEIGHTED_DIRECTED {} { + #directed case, with mixed weights at crucial edges + SETUP_ADJACENCYLIST_K4_WEIGHTED + + mygraph arc setweight edge14 2 + mygraph arc setweight edge41 3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_ADJACENCYLIST_1 {} { + #undirected and unweighted graph for Adjacency List Testing + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node2 + mygraph arc insert node1 node6 + mygraph arc insert node2 node3 + mygraph arc insert node3 node6 + mygraph arc insert node4 node5 + mygraph arc insert node4 node6 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TSP_1 {} { + + #Graph object for Metric Travelling Salesman problems testing + #Used by: + #Metric Travelling Salesman 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node2 + mygraph arc insert node2 node3 + mygraph arc insert node3 node4 + mygraph arc insert node4 node5 + mygraph arc insert node5 node1 + mygraph arc insert node6 node1 + mygraph arc insert node6 node2 + mygraph arc insert node6 node3 + mygraph arc insert node6 node4 + mygraph arc insert node6 node5 + mygraph arc setunweighted 1 + mygraph arc insert node1 node3 + mygraph arc insert node1 node4 + mygraph arc insert node2 node4 + mygraph arc insert node2 node5 + mygraph arc insert node3 node5 + mygraph arc setunweighted 2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TSP_2 {} { + + #Graph object for Metric Travelling Salesman problems testing + #Used by: + #Metric Travelling Salesman 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 + mygraph arc insert node1 node2 + mygraph arc insert node2 node3 + mygraph arc insert node3 node4 + mygraph arc insert node4 node1 + mygraph arc insert node5 node1 + mygraph arc insert node5 node2 + mygraph arc insert node5 node3 + mygraph arc insert node5 node4 + mygraph arc setunweighted 1 + mygraph arc insert node2 node4 + mygraph arc insert node1 node3 + mygraph arc setunweighted 2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TSP_3 {} { + + #Graph object for Metric Travelling Salesman problems testing + #Used by: + #Metric Travelling Salesman 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node2 + mygraph arc insert node3 node2 + mygraph arc insert node3 node4 + mygraph arc insert node4 node1 + mygraph arc insert node2 node1 edge21 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node4 node3 edge43 + mygraph arc insert node1 node4 edge14 + mygraph arc setunweighted 1 + mygraph arc insert node1 node3 + mygraph arc insert node2 node4 + mygraph arc setunweighted 3 + mygraph arc setweight edge23 5 + mygraph arc setweight edge21 4 + mygraph arc setweight edge43 6 + mygraph arc setweight edge14 7 + + return +} + + +# ------------------------------------------------------------------------- + +proc SETUP_MAXCUT_1 {} { + #Graph representing Tight Example for Maximum Cut problem + #In this case algorithm should find right solution. + #Used by: + #Max Cut 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node2 edge12 + mygraph arc insert node1 node4 edge14 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node3 node4 edge34 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MAXCUT_2 {} { + #Graph representing Tight Example for Maximum Cut problem + #In this case algorithm should find solution, with maximum aproximation factor : ALG = 2 * OPT + #Used by: + #Max Cut 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node3 edge13 + mygraph arc insert node1 node4 edge14 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node2 node4 edge24 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MAXCUT_3 {} { + + #Used by: + #Max Cut 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node3 + mygraph arc insert node1 node6 + mygraph arc insert node2 node4 + mygraph arc insert node2 node5 + mygraph arc insert node3 node4 + mygraph arc insert node3 node5 + mygraph arc insert node4 node6 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MAXCUT_4 {} { + + #Used by: + #Max Cut 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node2 edge12 + mygraph arc insert node2 node1 edge21 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node3 node2 edge32 + mygraph arc insert node1 node4 edge14 + mygraph arc insert node4 node5 edge45 + mygraph arc insert node5 node4 edge54 + mygraph arc insert node5 node6 edge56 + mygraph arc insert node6 node5 edge65 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MAXCUT_5 {} { + + #Used by: + #Max Cut 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node2 + mygraph arc insert node1 node3 + mygraph arc insert node3 node1 + mygraph arc insert node4 node2 + mygraph arc insert node2 node4 + mygraph arc insert node4 node6 + mygraph arc insert node6 node4 + mygraph arc insert node5 node3 + mygraph arc insert node3 node5 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_COUNTEDGES_1 {U V} { + + #Used by: + #Max Cut 2-approximation algorithm (subprocedure) + + upvar 1 U varU V varV + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node3 + mygraph arc insert node1 node4 + mygraph arc insert node4 node1 + mygraph arc insert node3 node2 + + set varU "node1 node2" + set varV "node3 node4" + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_COUNTEDGES_2 {U V} { + + #Used by: + #Max Cut 2-approximation algorithm (subprocedure) + + upvar 1 U varU V varV + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node3 + mygraph arc insert node1 node4 + mygraph arc insert node4 node1 + mygraph arc insert node3 node2 + mygraph arc insert node1 node1 + mygraph arc insert node1 node2 + mygraph arc insert node4 node3 + + set varU "node1 node2" + set varV "node3 node4" + return +} +# ------------------------------------------------------------------------- + +proc SETUP_COUNTEDGES_3 {U V} { + + #Used by: + #Max Cut 2-approximation algorithm (subprocedure) + + upvar 1 U varU V varV + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node1 + mygraph arc insert node1 node2 + mygraph arc insert node4 node3 + + set varU "node1 node2" + set varV "node3 node4" + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_COUNTEDGES_4 {U V} { + + #Used by: + #Max Cut 2-approximation algorithm (subprocedure) + + upvar 1 U varU V varV + SETUP_COUNTEDGES_2 varU varV + + set varU "node1 node3" + set varV "node2 node4" + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_CUT_1 {U V param} { + + #Used by: + #Max Cut 2-approximation algorithm (subprocedure) + + upvar 1 U varU V varV param varParam + SETUP_MAXCUT_3 + + set varU "node1 node5 node4" + set varV "node2 node3 node6" + set varParam 7 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_CUT_2 {U V param} { + + #Used by: + #Max Cut 2-approximation algorithm (subprocedure) + + upvar 1 U varU V varV param varParam + SETUP_CUT_1 varU varV varParam + + set varU "node1 node3 node5" + set varV "node2 node4 node6" + set varParam 3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_CREATETGRAPH_1 {E} { + + #Graph object for Metric Travelling Salesman problems testing + #Used by: + #Metric Travelling Salesman 2-approximation algorithm + + upvar 1 E edges + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node2 edge12 + mygraph arc setweight edge12 1 + mygraph arc insert node1 node3 edge13 + mygraph arc setweight edge13 2 + mygraph arc insert node1 node4 edge14 + mygraph arc setweight edge14 3 + mygraph arc insert node4 node1 edge41 + mygraph arc setweight edge41 4 + + set edges "edge12 edge14" + return + +} + +# ------------------------------------------------------------------------- + +proc SETUP_CREATETGRAPH_2 {E} { + + #Graph object for Metric Travelling Salesman problems testing + #Used by: + #Metric Travelling Salesman 2-approximation algorithm + + SETUP_NOEDGES_1 + upvar 1 E edges + + set edges "edge1 edge2" + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_CREATETGRAPH_3 {E} { + + #Graph object for Metric Travelling Salesman problems testing + #Used by: + #Metric Travelling Salesman 2-approximation algorithm + + upvar 1 E edges + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 + mygraph arc insert node1 node2 edge12 + mygraph arc setweight edge12 1 + mygraph arc insert node1 node3 edge13 + mygraph arc setweight edge13 2 + mygraph arc insert node1 node4 edge14 + mygraph arc setweight edge14 3 + mygraph arc insert node4 node1 edge41 + mygraph arc setweight edge41 4 + + set edges {edge14 edge41 edge13} + return + +} + +# ------------------------------------------------------------------------- + +proc SETUP_CHRISTO_1 {} { + + #Used by: + #Christofides Algorithm (Tight Example) + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 node7 + mygraph arc insert node1 node2 edge12 + mygraph arc insert node1 node3 edge13 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node2 node4 edge24 + mygraph arc insert node3 node4 edge34 + mygraph arc insert node3 node5 edge35 + mygraph arc insert node4 node5 edge45 + mygraph arc insert node4 node6 edge46 + mygraph arc insert node5 node6 edge56 + mygraph arc insert node5 node7 edge57 + mygraph arc insert node6 node7 edge67 + mygraph arc setunweighted 1 + mygraph arc insert node7 node1 edge71 + mygraph arc setunweighted 3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_VC_1 {} { + + #Used by: + #Vertices Cover + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node2 edge12 + mygraph arc insert node1 node3 edge13 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node3 node4 edge34 + mygraph arc insert node3 node5 edge35 + mygraph arc insert node3 node6 edge36 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_VC_1_2 {} { + + #Used by: + #Vertices Cover + + SETUP_VC_1 + + mygraph arc insert node2 node1 edge21 + mygraph arc insert node3 node1 edge31 + mygraph arc insert node3 node2 edge32 + mygraph arc insert node4 node3 edge43 + mygraph arc insert node5 node3 edge53 + mygraph arc insert node6 node3 edge63 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_VC_1_3 {} { + + #Used by: + #Vertices Cover + + SETUP_VC_1 + + mygraph arc insert node2 node1 edge21 + mygraph arc insert node3 node1 edge31 + mygraph arc insert node3 node2 edge32 + mygraph arc insert node4 node3 edge43 + + return +} +# ------------------------------------------------------------------------- + +proc SETUP_VC_2 {} { + + #Used by: + #Vertices Cover + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node2 edge12 + mygraph arc insert node1 node3 edge13 + mygraph arc insert node2 node3 edge23 + mygraph arc insert node2 node4 edge24 + mygraph arc insert node3 node5 edge35 + mygraph arc insert node4 node5 edge45 + mygraph arc insert node4 node6 edge46 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_C5 {} { + + #Cycle with 5 edges - C5 + #Used by: + #Greedy Maximum Independent Set algorithm + #Greedy Weighted Maximum Independent Set algorithm + #Vertices Cover + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 + mygraph arc insert node1 node2 + mygraph arc insert node2 node3 + mygraph arc insert node3 node4 + mygraph arc insert node4 node5 + mygraph arc insert node5 node1 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_INDEPENDENTSET_1 {} { + + #graph containing 24 nodes for independent set testing + #Reference: http://en.wikipedia.org/wiki/Independent_set_(graph_theory)#Maximal_independent_set + #Used by: + #Greedy Maximum Independent Set algorithm + #Greedy Weighted Maximum Independent Set algorithm + + struct::graph mygraph + + #adding 24 nodes: node1 - node24 + for {set i 1} {$i<=24} {incr i} { + mygraph node insert node$i + } + + #adding external edges: node1 node2, node2 node3.... + for {set i 1} {$i<=12} {incr i} { + set j [ expr { $i%12 } ] + incr j + mygraph arc insert node$i node$j ;#[list node$i node$j] + } + + #adding edges connecting internal nodes with external nodes + for {set i 1} {$i<=12} {incr i} { + mygraph arc insert node$i node[expr {$i+12}] ;#[list node$i node[expr {$i+12}]] + } + + #adding edges between internal nodes + for {set i 13} {$i<=24} {incr i} { + set u [ expr {($i+4)%24} ] + set v [ expr {($i-4)%24} ] + if { $u < 13 } { + if {$u == 0} { + set u 24 + } else { + set u [expr {$u+12}] + } + } + if { $v < 13} { + if {$v == 0} { + set v 24 + } else { + set v [expr {$v+12}] + } + } + + if { ![mygraph arc exists [list node$u node$i]] } { + mygraph arc insert node$i node$u [list node$i node$u] + } + if { ![mygraph arc exists [list node$v node$i]] } { + mygraph arc insert node$i node$v [list node$i node$v] + } + } + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_KCENTER_1 {} { + #Tight Example for unweighted version of K-Center problem + #Used by: + #Unweighted k-center 2-approximation algorithm + #Weighted k-center 3-approximation algorithm + + struct::graph mygraph + mygraph node insert node1 node2 node3 node4 node5 node6 node7 + mygraph arc insert node1 node7 [list node1 node7] + mygraph arc insert node2 node7 [list node2 node7] + mygraph arc insert node3 node7 [list node3 node7] + mygraph arc insert node4 node7 [list node4 node7] + mygraph arc insert node5 node7 [list node5 node7] + mygraph arc insert node6 node7 [list node6 node7] + mygraph arc setunweighted 1 + + for {set i 1} {$i < 7 } { incr i } { + # i in 1..6 + if { ($i+1) < 7 } { + # i in 1..5 + mygraph arc insert node$i node[ expr { $i+1 } ] [list node$i node[ expr { $i+1 } ]] + } elseif { ![mygraph arc exists [list node6 node1]] } { + mygraph arc insert node6 node1 [list node6 node1] + } + + if { ($i+2) < 7 } { + # i in 1..4 + mygraph arc insert node$i node[ expr { $i+2 } ] [list node$i node[ expr { $i+2 } ]] + } elseif { ![mygraph arc exists [list node6 node2]] } { + mygraph arc insert node6 node2 [list node6 node2] + } + } + mygraph arc insert node1 node5 [list node1 node5] + mygraph arc setunweighted 2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_KCENTER_2 {} { + + #Used by: + #Unweighted k-center 2-approximation algorithm + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 node7 node8 + + foreach v [mygraph nodes] { + foreach u [mygraph nodes] { + if { ($u!=$v) && ![mygraph arc exists [list $u $v]] } { + mygraph arc insert $v $u [list $v $u] + } + } + } + foreach x [mygraph nodes -adj node1] { + if { [mygraph arc exists [list $x node1]] } { + mygraph arc setweight [list $x node1] 1 + } else { + mygraph arc setweight [list node1 $x] 1 + } + } + foreach x [mygraph nodes -adj node2] { + if { [mygraph arc exists [list $x node2]] } { + mygraph arc setweight [list $x node2] 1 + } else { + mygraph arc setweight [list node2 $x] 1 + } + } + + mygraph arc setunweighted 2 + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TWOSQUARED_1 {} { + + #Used by: + #createSquaredGraph procedure + #Unweighted k-center 2-approximation algorithm (subprocedure that extends two-squared graphs) + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 node7 node8 + mygraph arc insert node1 node2 "node1 node2" + mygraph arc insert node2 node3 "node2 node3" + mygraph arc insert node2 node4 "node2 node4" + mygraph arc insert node3 node4 "node3 node4" + mygraph arc insert node3 node5 "node3 node5" + mygraph arc insert node5 node6 "node5 node6" + mygraph arc insert node5 node7 "node5 node7" + mygraph arc insert node7 node8 "node7 node8" + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TWOSQUARED_2 {} { + + #Used by: + #createSquaredGraph procedure + #Unweighted k-center 2-approximation algorithm (subprocedure that extends two-squared graphs) + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 + mygraph arc insert node1 node2 "node1 node2" + mygraph arc insert node2 node3 "node2 node3" + mygraph arc insert node3 node4 "node3 node4" + mygraph arc insert node4 node5 "node4 node5" + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TWOSQUARED_3 {} { + + #Used by: + #Unweighted k-center 2-approximation algorithm (subprocedure that extends two-squared graphs) + + struct::graph mygraph2 + + mygraph2 node insert node1 node2 node3 node4 node5 + mygraph2 arc insert node1 node2 "node1 node2" + mygraph2 arc insert node2 node3 "node2 node3" + mygraph2 arc insert node3 node4 "node3 node4" + mygraph2 arc insert node1 node3 "node1 node3" + mygraph2 arc insert node2 node4 "node2 node4" + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TWOSQUARED_4 {} { + + #Used by: + #Unweighted k-center 2-approximation algorithm (subprocedure that extends two-squared graphs) + + struct::graph mygraph2 + + mygraph2 node insert node1 node2 node3 node4 node5 node6 node7 node8 + + mygraph2 arc insert node1 node2 "node1 node2" + mygraph2 arc insert node1 node3 "node1 node3" + mygraph2 arc insert node1 node4 "node1 node4" + mygraph2 arc insert node2 node3 "node2 node3" + mygraph2 arc insert node2 node4 "node2 node4" + mygraph2 arc insert node3 node4 "node3 node4" + + mygraph2 arc insert node5 node6 "node5 node6" + mygraph2 arc insert node5 node7 "node5 node7" + mygraph2 arc insert node5 node8 "node5 node8" + mygraph2 arc insert node6 node7 "node6 node7" + mygraph2 arc insert node7 node8 "node7 node8" + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_WEIGHTEDKCENTER_1 {nodeWeights} { + + #Used by: + #Weighted k-center 3-approximation algorithm + + upvar 1 nodeWeights nW + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 node7 node8 + mygraph arc insert node1 node2 + mygraph arc insert node2 node3 + mygraph arc insert node3 node4 + mygraph arc setunweighted 1 + mygraph arc insert node4 node5 + mygraph arc insert node4 node6 + mygraph arc insert node4 node7 + mygraph arc insert node4 node8 + mygraph arc setunweighted 1.5 + + set nW {{node1 2} {node2 2} {node3 2} {node4 1} {node5 Inf} {node6 Inf} {node7 Inf} {node8 Inf}} + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_WEIGHTEDKCENTER_2 {nodeWeights} { + + #Used by: + #Weighted k-center 3-approximation algorithm + + upvar 1 nodeWeights nW + + struct::graph mygraph + + mygraph node insert node1 node2 node3 node4 node5 node6 + mygraph arc insert node1 node6 + mygraph arc insert node2 node6 + mygraph arc insert node3 node6 + + mygraph arc insert node5 node6 + mygraph arc insert node1 node5 + mygraph arc insert node2 node5 + mygraph arc insert node3 node5 + mygraph arc setunweighted 1 + + mygraph arc insert node4 node5 + mygraph arc setunweighted 3 + mygraph arc insert node4 node6 + mygraph arc setunweighted 2 + + set nW {{node1 2} {node2 2} {node3 2} {node4 3} {node5 2} {node6 1}} + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_WEIGHTEDKCENTER_3 {nodeWeights} { + + #Used by: + #Weighted k-center 3-approximation algorithm + + SETUP_WEIGHTEDKCENTER_2 n + + upvar 1 nodeWeights nW + + set nW {{node1 1} {node2 1} {node3 1} {node4 1} {node5 1} {node6 3}} + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_FORDFULKERSON_1 {} { + + #The flow network with througputs set for each existing (non-zero) link + #Used by: + #Edmond's Karp algorithm + #Create Residual Graph procedure (subprocedure of Edmond's Karp) + #Dinic's Algorithm for maximum flow computation + #Subprocedures of above: MKM and Dinic's algorithms for blocking flow finding + + struct::graph mygraph + + mygraph node insert s v1 v2 v3 v4 t + + mygraph arc insert s v1 {s v1} + mygraph arc set {s v1} throughput 16 + + mygraph arc insert s v2 {s v2} + mygraph arc set {s v2} throughput 13 + + mygraph arc insert v1 v2 {v1 v2} + mygraph arc set {v1 v2} throughput 10 + + mygraph arc insert v2 v1 {v2 v1} + mygraph arc set {v2 v1} throughput 4 + + mygraph arc insert v1 v3 {v1 v3} + mygraph arc set {v1 v3} throughput 12 + + mygraph arc insert v2 v4 {v2 v4} + mygraph arc set {v2 v4} throughput 14 + + mygraph arc insert v3 v2 {v3 v2} + mygraph arc set {v3 v2} throughput 9 + + mygraph arc insert v3 t {v3 t} + mygraph arc set {v3 t} throughput 20 + + mygraph arc insert v4 v3 {v4 v3} + mygraph arc set {v4 v3} throughput 7 + + mygraph arc insert v4 t {v4 t} + mygraph arc set {v4 t} throughput 4 + + return + +} + +# ------------------------------------------------------------------------- + +proc SETUP_FORDFULKERSON_2 {} { + + #The flow network with througputs set for each existing (non-zero) link + #Used by: + #Edmond's Karp algorithm (Tight Example) + #Dinic's Algorithm for maximum flow computation + #Subprocedures of above: MKM and Dinic's algorithms for blocking flow finding + + struct::graph mygraph + + mygraph node insert a b c d + + mygraph arc insert a b ab + mygraph arc set ab throughput 1000000 + mygraph arc insert a c ac + mygraph arc set ac throughput 1000000 + mygraph arc insert b d bd + mygraph arc set bd throughput 1000000 + mygraph arc insert c d cd + mygraph arc set cd throughput 1000000 + mygraph arc insert b c bc + mygraph arc set bc throughput 1 + + return + +} + +# ------------------------------------------------------------------------- + +proc SETUP_FORDFULKERSON_3 {} { + + #The flow network with througputs set for each existing (non-zero) link + #Used by: + #Edmond's Karp algorithm + #Dinic's Algorithm for maximum flow computation + #Subprocedures of above: MKM and Dinic's algorithms for blocking flow finding + + struct::graph mygraph + + mygraph node insert s v1 v2 v3 t + + mygraph arc insert s v1 sv1 + mygraph arc set sv1 throughput 10 + + mygraph arc insert s v2 sv2 + mygraph arc set sv2 throughput 5 + + mygraph arc insert s v3 sv3 + mygraph arc set sv3 throughput 3 + + mygraph arc insert v1 v2 v1v2 + mygraph arc set v1v2 throughput 4 + + mygraph arc insert v2 v1 v2v1 + mygraph arc set v2v1 throughput 2 + + mygraph arc insert v2 v2 v2v3 + mygraph arc set v2v3 throughput 2 + + mygraph arc insert v3 v2 v3v2 + mygraph arc set v3v2 throughput 4 + + mygraph arc insert v1 t v1t + mygraph arc set v1t throughput 3 + + mygraph arc insert v2 t v2t + mygraph arc set v2t throughput 8 + + mygraph arc insert v3 t v3t + mygraph arc set v3t throughput 10 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_FORDFULKERSON_4 {} { + + #The flow network with througputs set for each existing (non-zero) link + #Used by: + #Edmond's Karp algorithm + #Dinic's Algorithm for maximum flow computation + #Subprocedures of above: MKM and Dinic's algorithms for blocking flow finding + + SETUP_FORDFULKERSON_3 + + mygraph arc set v1v2 throughput 1 + mygraph arc set v2v1 throughput 1 + mygraph arc set v2v3 throughput 1 + mygraph arc set v3v2 throughput 1 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_FORDFULKERSON_5 {} { + #The flow network with througputs set for each existing (non-zero) link + #Used by: + #Edmond's Karp algorithm + #Dinic's Algorithm for maximum flow computation + #Subprocedures of above: MKM and Dinic's algorithms for blocking flow finding + + SETUP_FORDFULKERSON_3 + + mygraph arc setweight sv1 10.5 + mygraph arc set sv1 throughput 10.5 + mygraph arc set sv2 throughput 5.5 + mygraph arc set sv3 throughput 3.5 + mygraph arc set v1v2 throughput 4.5 + mygraph arc set v2v1 throughput 2.5 + mygraph arc set v2v3 throughput 2.3 + mygraph arc set v3v2 throughput 4.2 + mygraph arc set v1t throughput 3.1 + mygraph arc set v2t throughput 8.9 + mygraph arc set v3t throughput 10.1 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_FLOWS_0 {mygraph} { + + #Used by: + #Create Residual Graph procedure (subprocedure of Edmond's Karp) + + foreach arc [$mygraph arcs] { + set u [$mygraph arc source $arc] + set v [$mygraph arc target $arc] + dict set f [list $u $v] 0 + dict set f [list $v $u] 0 + } + + return $f +} + +# ------------------------------------------------------------------------- + +proc SETUP_FLOWS_1 {mygraph} { + + #Used by: + #Create Residual Graph procedure (subprocedure of Edmond's Karp) + + set f [SETUP_FLOWS_0 $mygraph] + + dict set f [list s v1] 4 + dict set f [list v1 v3] 4 + dict set f [list v3 v2] 4 + dict set f [list v2 v4] 4 + dict set f [list v4 t] 4 + + return $f +} + +# ------------------------------------------------------------------------- + +proc SETUP_FLOWS_2 {mygraph} { + + #Used by: + #Create Residual Graph procedure (subprocedure of Edmond's Karp) + + set f [SETUP_FLOWS_0 $mygraph] + + dict set f [list s v1] 11 + dict set f [list v1 v3] 4 + dict set f [list v3 v2] 4 + dict set f [list v2 v4] 11 + dict set f [list v4 t] 4 + + dict set f [list v1 v2] 7 + dict set f [list v4 v3] 7 + dict set f [list v3 t] 7 + + + return $f +} + +# ------------------------------------------------------------------------- + +proc SETUP_FLOWS_3 {mygraph} { + + #Used by: + #Create Residual Graph procedure (subprocedure of Edmond's Karp) + + set f [SETUP_FLOWS_0 $mygraph] + + dict set f [list s v1] 11 + dict set f [list s v2] 8 + dict set f [list v2 v1] 1 + dict set f [list v1 v3] 12 + dict set f [list v2 v4] 11 + dict set f [list v3 v2] 4 + dict set f [list v4 v3] 7 + dict set f [list v3 t] 15 + dict set f [list v4 t] 4 + + return $f +} + +# ------------------------------------------------------------------------- + +proc SETUP_FLOWS_4 {mygraph} { + + #Used by: + #Create Residual Graph procedure (subprocedure of Edmond's Karp) + + set f [SETUP_FLOWS_0 $mygraph] + + dict set f [list s v1] 11 + dict set f [list s v2] 12 + dict set f [list v2 v1] 1 + dict set f [list v1 v3] 12 + dict set f [list v2 v4] 11 + dict set f [list v4 v3] 7 + dict set f [list v3 t] 19 + dict set f [list v4 t] 4 + + return $f +} + +# ------------------------------------------------------------------------- + +proc SETUP_AUGMENTINGNETWORK_1 {_f _path} { + + #Used by: + #Create Augmenting Network procedure (subprocedure of Busacker-Gowen's Algorithm) + + upvar 1 $_f f $_path path + + struct::graph mygraph + + mygraph node insert s a b c t + + mygraph arc insert s a [list s a] + mygraph arc set [list s a] throughput 18 + mygraph arc set [list s a] cost 3 + + mygraph arc insert s c [list s c] + mygraph arc set [list s c] throughput 20 + mygraph arc set [list s c] cost 8 + + mygraph arc insert a b [list a b] + mygraph arc set [list a b] throughput 20 + mygraph arc set [list a b] cost 5 + + mygraph arc insert a c [list a c] + mygraph arc set [list a c] throughput 15 + mygraph arc set [list a c] cost 4 + + mygraph arc insert c b [list c b] + mygraph arc set [list c b] throughput 12 + mygraph arc set [list c b] cost 8 + + mygraph arc insert b t [list b t] + mygraph arc set [list b t] throughput 14 + mygraph arc set [list b t] cost 5 + + mygraph arc insert c t [list c t] + mygraph arc set [list c t] throughput 17 + mygraph arc set [list c t] cost 3 + + set path {} + lappend path s a c t + + foreach e [mygraph arcs] { + set u [mygraph arc source $e] + set v [mygraph arc target $e] + dict set f [list $u $v] 0 + dict set f [list $v $u] 0 + } + + dict set f [list s a] 15 + dict set f [list a c] 15 + dict set f [list c t] 15 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_AUGMENTINGNETWORK_2 {_f _path} { + + #Used by: + #Create Augmenting Network procedure (subprocedure of Busacker-Gowen's Algorithm) + + upvar 1 $_f f $_path path + + SETUP_AUGMENTINGNETWORK_1 f path + + #mygraph arc insert s a [list s a] + mygraph arc set [list s a] throughput 3 + mygraph arc set [list s a] cost 3 + + mygraph arc insert a s [list a s] + mygraph arc set [list a s] throughput 15 + mygraph arc set [list a s] cost -3 + + mygraph arc insert c a [list c a] + mygraph arc set [list c a] throughput 15 + mygraph arc set [list c a] cost -4 + + mygraph arc set [list a c] throughput 0 + mygraph arc set [list a c] cost Inf + + #mygraph arc insert c t [list c t] + mygraph arc set [list c t] throughput 2 + mygraph arc set [list c t] cost 3 + + mygraph arc insert t c [list t c] + mygraph arc set [list t c] throughput 15 + mygraph arc set [list t c] cost -3 + + set path {} + lappend path s c t + + dict set f [list s a] 15 + dict set f [list a c] 15 + dict set f [list c t] 17 + dict set f [list s c] 2 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_AUGMENTINGNETWORK_3 {_f _path} { + + #Used by: + #Create Augmenting Network procedure (subprocedure of Busacker-Gowen's Algorithm) + + upvar 1 $_f f $_path path + + SETUP_AUGMENTINGNETWORK_2 f path + + mygraph arc set [list c t] throughput 0 + mygraph arc set [list c t] cost Inf + + mygraph arc set [list t c] throughput 17 + mygraph arc set [list t c] cost -3 + + mygraph arc set [list s c] throughput 18 + mygraph arc set [list s c] cost 8 + + mygraph arc insert c s [list c s] + mygraph arc set [list c s] throughput 2 + mygraph arc set [list c s] cost -8 + + set path {} + lappend path s a b t + + dict set f [list s a] 18 + dict set f [list a c] 15 + dict set f [list c t] 17 + dict set f [list s c] 2 + dict set f [list a b] 3 + dict set f [list b t] 3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BUSACKERGOWEN_1 {} { + + #Used by: + #Busacker Gowen Algorithm + + struct::graph mygraph + + mygraph node insert s a b c t + + mygraph arc insert s a sa + mygraph arc setweight sa 3 + mygraph arc set sa cost 3 + mygraph arc set sa throughput 18 + + mygraph arc insert s c sc + mygraph arc setweight sc 8 + mygraph arc set sc cost 8 + mygraph arc set sc throughput 20 + + mygraph arc insert a b ab + mygraph arc setweight ab 5 + mygraph arc set ab cost 5 + mygraph arc set ab throughput 20 + + mygraph arc insert a c ac + mygraph arc setweight ac 4 + mygraph arc set ac cost 4 + mygraph arc set ac throughput 15 + + mygraph arc insert c b cb + mygraph arc setweight cb 8 + mygraph arc set cb cost 8 + mygraph arc set cb throughput 12 + + mygraph arc insert b t bt + mygraph arc setweight bt 5 + mygraph arc set bt cost 5 + mygraph arc set bt throughput 14 + + mygraph arc insert c t ct + mygraph arc setweight ct 3 + mygraph arc set ct cost 3 + mygraph arc set ct throughput 17 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BUSACKERGOWEN_2 {} { + #graph with not all attributes set + + #Used by: + #Busacker Gowen Algorithm + #Edmond's Karp Algorithm + + struct::graph mygraph + + mygraph node insert s v1 v2 t + mygraph arc insert v1 s v1s + + mygraph arc insert v2 s v2s + mygraph arc insert v1 t v1t + mygraph arc set v1t throughput 20 + mygraph arc set v1t cost 5 + mygraph arc insert v2 t v2t + mygraph arc set v2t throughput 20 + mygraph arc set v2t cost 5 + + return +} +# ------------------------------------------------------------------------- + +proc SETUP_SOURCESINKNOPATHS {} { + #graph where from the start path between source node s and + #sink node t doesn't exist + #Used by Busacker - Gowen + + struct::graph mygraph + + mygraph node insert s v1 v2 t + mygraph arc insert v1 s v1s + mygraph arc set v1s throughput 20 + mygraph arc set v1s cost 5 + mygraph arc insert v2 s v2s + mygraph arc set v2s throughput 20 + mygraph arc set v2s cost 5 + mygraph arc insert v1 t v1t + mygraph arc set v1t throughput 20 + mygraph arc set v1t cost 5 + mygraph arc insert v2 t v2t + mygraph arc set v2t throughput 20 + mygraph arc set v2t cost 5 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MDST_1 {} { + + #Used by: + #Minimum Diameter Spanning Tree Algorithm + #BFS algorithm + + struct::graph mygraph + + mygraph node insert a b c d e f g h i j + + mygraph arc insert a b + mygraph arc insert b c + mygraph arc insert c d + mygraph arc insert d e + mygraph arc insert e f + mygraph arc insert b h + mygraph arc insert c g + mygraph arc insert d h + mygraph arc insert e g + mygraph arc insert g i + mygraph arc insert h j + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MDST_2 {} { + + #Used by: + #Minimum Degree Spanning Tree Tests + + struct::graph mygraph + + mygraph node insert v1 v2 v3 v4 v5 v6 v7 v8 + mygraph arc insert v1 v2 12 + mygraph arc insert v1 v3 13 + mygraph arc insert v2 v4 24 + mygraph arc insert v3 v4 34 + mygraph arc insert v3 v5 35 + mygraph arc insert v4 v5 45 + mygraph arc insert v5 v6 56 + mygraph arc insert v5 v7 57 + mygraph arc insert v7 v8 78 + mygraph arc insert v6 v8 68 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MDST_3 {} { + + #Used by: + #Minimum Diameter Spanning Tree Algorithm + + struct::graph mygraph + + mygraph node insert a b c d e + mygraph arc insert a b ab + mygraph arc insert b c bc + mygraph arc insert c d cd + mygraph arc insert d e de + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MDST_4 {} { + + #Used by: + #Minimum Diameter Spanning Tree Algorithm + + SETUP_MDST_3 + + mygraph node insert f g + mygraph arc insert e f ef + mygraph arc insert f g fg + mygraph arc insert d g dg + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MDST_5 {} { + + #Used by: + #Minimum Diameter Spanning Tree Algorithm + + struct::graph mygraph + mygraph node insert a b c d e + mygraph arc insert a b ab + mygraph arc insert b c bc + mygraph arc insert c d cd + mygraph arc insert d e de + mygraph arc insert a c ac + mygraph arc insert b d bd + mygraph arc insert c e ce + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MDST_6 {} { + + #Used by: + #Minimum Degree Spanning Tree Tests + + struct::graph mygraph + + mygraph node insert a b c d e f g + mygraph arc insert a b ab + mygraph arc insert b c bc + mygraph arc insert c d cd + mygraph arc insert d e de + mygraph arc insert e f ef + mygraph arc insert f a fa + mygraph arc insert g a ga + mygraph arc insert g b gb + mygraph arc insert g c gc + mygraph arc insert g d gd + mygraph arc insert g e ge + mygraph arc insert g f gf + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MDST_7 {} { + + #Used by: + #Minimum Degree Spanning Tree Tests + + struct::graph mygraph + + mygraph node insert a b c d e f + mygraph arc insert a b ab + mygraph arc insert a c ac + mygraph arc insert b d bd + mygraph arc insert c e ce + mygraph arc insert d f df + mygraph arc insert e f ef + mygraph arc insert b e be + mygraph arc insert c d cd + mygraph arc insert a f af + mygraph arc insert f a fa + mygraph arc insert b c bc + mygraph arc insert d e de + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BLOCKINGFLOW_1 {} { + + #Residual graph for blocking flow testing + #Used by: + #Dinic's Blocking Flow Algorithm + #MKM (3 Hindu) Blocking Flow Algorithm + + struct::graph mygraph + + mygraph node insert s v1 v2 v3 v4 v5 v6 v7 t + + mygraph arc insert s v1 sv1 + mygraph arc set sv1 throughput 4 + mygraph arc insert s v3 sv3 + mygraph arc set sv3 throughput 2 + mygraph arc insert v1 v2 v1v2 + mygraph arc set v1v2 throughput 3 + mygraph arc insert v1 v4 v1v4 + mygraph arc set v1v4 throughput 1 + mygraph arc insert v2 v5 v2v5 + mygraph arc set v2v5 throughput 2 + mygraph arc insert v3 v4 v3v4 + mygraph arc set v3v4 throughput 1 + mygraph arc insert v3 v6 v3v6 + mygraph arc set v3v6 throughput 3 + mygraph arc insert v4 v1 v4v1 + mygraph arc set v4v1 throughput 1 + mygraph arc insert v4 v5 v4v5 + mygraph arc set v4v5 throughput 2 + mygraph arc insert v4 v7 v4v7 + mygraph arc set v4v7 throughput 2 + mygraph arc insert v4 v6 v4v6 + mygraph arc set v4v6 throughput 1 + mygraph arc insert v5 v1 v5v1 + mygraph arc set v5v1 throughput 3 + mygraph arc insert v5 t v5t + mygraph arc set v5t throughput 3 + mygraph arc insert v6 v4 v6v4 + mygraph arc set v6v4 throughput 3 + mygraph arc insert v6 v7 v6v7 + mygraph arc set v6v7 throughput 4 + mygraph arc insert v7 t v7t + mygraph arc set v7t throughput 2 + mygraph arc insert t v7 tv7 + mygraph arc set tv7 throughput 3 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BLOCKINGFLOW_2 {} { + + #residual graph for blocking flow testing + #Used by: + #Dinic's Blocking Flow Algorithm + #MKM (3 Hindu) Blocking Flow Algorithm + + struct::graph mygraph + + mygraph node insert s v1 v2 v3 v4 t + + mygraph arc insert s v2 sv2 + mygraph arc set sv2 throughput 6 + mygraph arc insert v2 s v2s + mygraph arc set v2s throughput 4 + mygraph arc insert v1 s v1s + mygraph arc set v1s throughput 10 + mygraph arc insert v1 v2 v1v2 + mygraph arc set v1v2 throughput 2 + mygraph arc insert v1 v4 v1v4 + mygraph arc set v1v4 throughput 2 + mygraph arc insert v2 v4 v2v4 + mygraph arc set v2v4 throughput 5 + mygraph arc insert v3 v1 v3v1 + mygraph arc set v3v1 throughput 4 + mygraph arc insert v3 t v3t + mygraph arc set v3t throughput 6 + mygraph arc insert v4 v1 v4v1 + mygraph arc set v4v1 throughput 6 + mygraph arc insert v4 v2 v4v2 + mygraph arc set v4v2 throughput 4 + mygraph arc insert v4 v3 v4v3 + mygraph arc set v4v3 throughput 6 + mygraph arc insert t v4 tv4 + mygraph arc set tv4 throughput 10 + mygraph arc insert t v3 tv3 + mygraph arc set tv3 throughput 4 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BLOCKINGFLOW_3 {} { + + #residual graph for blocking flow testing + #Used by: + #Dinic's Blocking Flow Algorithm + #MKM (3 Hindu) Blocking Flow Algorithm + + struct::graph mygraph + + mygraph node insert s v1 v2 v3 v4 t + + mygraph arc insert v2 s v2s + mygraph arc set v2s throughput 10 + mygraph arc insert v1 s v1s + mygraph arc set v1s throughput 10 + mygraph arc insert v1 v2 v1v2 + mygraph arc set v1v2 throughput 2 + mygraph arc insert v1 v4 v1v4 + mygraph arc set v1v4 throughput 2 + mygraph arc insert v3 v1 v3v1 + mygraph arc set v3v1 throughput 4 + mygraph arc insert v3 t v3t + mygraph arc set v3t throughput 1 + mygraph arc insert v3 v4 v3v4 + mygraph arc set v3v4 throughput 5 + mygraph arc insert v4 v1 v4v1 + mygraph arc set v4v1 throughput 6 + mygraph arc insert v4 v2 v4v2 + mygraph arc set v4v2 throughput 9 + mygraph arc insert v4 v3 v4v3 + mygraph arc set v4v3 throughput 1 + mygraph arc insert t v4 tv4 + mygraph arc set tv4 throughput 10 + mygraph arc insert t v3 tv3 + mygraph arc set tv3 throughput 9 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_MAXIMUMFLOW_1 {} { + + #Flow network for maximum flow computation problems and generally flow problems. + #Used by: + #Dinic's Maximum Flow Algorithm + #Dinic's Blocking Flow Algorithm + #MKM (3 Hindu) Blocking Flow Algorithm + + struct::graph mygraph + + mygraph node insert s v1 v2 v3 v4 t + + mygraph arc insert s v1 sv1 + mygraph arc set sv1 throughput 10 + mygraph arc insert s v2 sv2 + mygraph arc set sv2 throughput 10 + mygraph arc insert v1 v2 v1v2 + mygraph arc set v1v2 throughput 2 + mygraph arc insert v2 v4 v2v4 + mygraph arc set v2v4 throughput 9 + mygraph arc insert v1 v4 v1v4 + mygraph arc set v1v4 throughput 8 + mygraph arc insert v1 v3 v1v3 + mygraph arc set v1v3 throughput 4 + mygraph arc insert v4 v3 v4v3 + mygraph arc set v4v3 throughput 6 + mygraph arc insert v3 t v3t + mygraph arc set v3t throughput 10 + mygraph arc insert v4 t v4t + mygraph arc set v4t throughput 10 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BFS_1 {} { + + #Used by: + #BFS algorithm + #Shortest Pathfinding by BFS algorithm + + struct::graph mygraph + mygraph node insert s a b c d x + + mygraph arc insert s a sa + mygraph arc setweight sa 4 + mygraph arc insert s x sx + mygraph arc setweight sx 5 + mygraph arc insert a b ab + mygraph arc setweight ab 5 + mygraph arc insert x d xd + mygraph arc setweight xd 7 + mygraph arc insert x a xa + mygraph arc setweight xa -3 + mygraph arc insert b d bd + mygraph arc setweight bd 2 + mygraph arc insert b c bc + mygraph arc setweight bc 6 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_BFS_2 {} { + + #Used by: + #BFS algorithm + #Shortest Pathfinding by BFS algorithm + + struct::graph mygraph + mygraph node insert s a b c d t + + mygraph arc insert s d sd + mygraph arc setweight sd 9 + mygraph arc insert s a sa + mygraph arc setweight sa 15 + mygraph arc insert a c ac + mygraph arc setweight ac 3 + mygraph arc insert a b ab + mygraph arc setweight ab 35 + mygraph arc insert b a ba + mygraph arc setweight ba 16 + mygraph arc insert b c bc + mygraph arc setweight bc 6 + mygraph arc insert b t bt + mygraph arc setweight bt 21 + mygraph arc insert c t ct + mygraph arc setweight ct 7 + mygraph arc insert c d cd + mygraph arc setweight cd 2 + mygraph arc insert d c dc + mygraph arc setweight dc 2 + mygraph arc insert d a da + mygraph arc setweight da 4 + mygraph arc insert t b tb + mygraph arc setweight tb 5 + + return +} + +# ------------------------------------------------------------------------- + +proc SETUP_TSPHEURISTIC_1 {C} { + + #Used by: + #TSP heuristics of local searching - 2 approximation algorithm + upvar $C _C + + struct::graph mygraph + mygraph node insert a b c d e + + mygraph arc insert a b ab + mygraph arc set ab weight 11 + mygraph arc insert a c ac + mygraph arc set ac weight 16 + mygraph arc insert a d ad + mygraph arc set ad weight 28 + mygraph arc insert a e ae + mygraph arc set ae weight 42 + mygraph arc insert b c bc + mygraph arc set bc weight 44 + mygraph arc insert b d bd + mygraph arc set bd weight 31 + mygraph arc insert b e be + mygraph arc set be weight 27 + mygraph arc insert c d cd + mygraph arc set cd weight 6 + mygraph arc insert c e ce + mygraph arc set ce weight 15 + mygraph arc insert d e de + mygraph arc set de weight 21 + + set _C {ab bc cd de ae} + + return +} + +# ------------------------------------------------------------------------- +# Generators for various error messages generated +# by the implementations. + +proc NegativeCycleOccurance { g } { return "Error. Given graph \"mygraph\" contains cycle with negative sum of weights." } +proc UnweightedArcOccurance { } { return "Operation invalid for graph with unweighted arcs." } +proc LackOfEdgesOccurance {G e} { return "Edge \"$e\" doesn't exist in graph \"mygraph\". Set the proper set of edges." } +proc UnconnectedGraphOccurance {G} { return "Error. Given graph \"mygraph\" is not a connected graph." } +proc WrongValueAtInput {x} { return "The \"$x\" value must be an positive integer." } +proc LackOfSinkOrSource {s t} { return "Nodes \"$s\" and \"$t\" should be contained in graph's G set of nodes" } +proc WrongAttributes {args} { + set message "The input network doesn't have all attributes set correctly... Please, check again attributes: " + append message "\"[join $args "\" and \""]\"" + return "$message for input graph." +} diff --git a/tcllib/modules/struct/graph/tests/XOpsSupport b/tcllib/modules/struct/graph/tests/XOpsSupport new file mode 100644 index 0000000..1fb96f8 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/XOpsSupport @@ -0,0 +1,128 @@ +# -*- tcl -*- +# graphops.testsupport: Helper commands for the graph ops testsuite. +# +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# All rights reserved. +# +# RCS: @(#) $Id: XOpsSupport,v 1.6 2009/09/24 19:30:11 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +# Code to generate various graphs to operate on. + +#---------------------------------------------------------------------- + +proc bicanon {bi} { + return [lsort -dict [list [lsort -dict [lindex $bi 0]] [lsort -dict [lindex $bi 1]]]] +} + +proc setsetcanon {s} { + set r {} + foreach item $s { + lappend r [lsort -dict $item] + } + return [lsort -dict $r] +} + +#---------------------------------------------------------------------- + +proc EulerTour {g arcs} { + Euler 1 $g $arcs +} + +proc EulerPath {g arcs} { + Euler 0 $g $arcs +} + +proc Euler {tour g arcs} { + if {[llength [lsort -unique $arcs]] < [llength $arcs]} { + #puts [lsort $arcs] + return dup-arcs + } elseif {![struct::set equal $arcs [$g arcs]]} { + #puts [lsort $arcs] + #puts [lsort [$g arcs] + return missing-arcs + } + set a [lindex $arcs 0] + set first [list [$g arc source $a] [$g arc target $a]] + set last $first + + #puts T=($arcs) + #puts "$a == ($first)" + foreach a [lrange $arcs 1 end] { + set now [list [$g arc source $a] [$g arc target $a]] + set nail [struct::set intersect $last $now] + + #puts -nonewline "$a == ($now) * ($last) = ($nail)" + + if {[struct::set size $nail] < 1} { + return gap + } elseif {[struct::set size $nail] > 1} { + return same + } + + if {[struct::set size $now] > 1} { + set last [struct::set difference $now $nail] + } ; # else: a loop arc has no effect on last. + + #puts " --> ($last)" + } + if {$tour} { + set nail [struct::set intersect $last $first] + if {[struct::set size $nail] < 1} { + return gap + } elseif {[struct::set size $nail] > 1} { + return same + } + } + return ok +} + +#---------------------------------------------------------------------- + +# custom match code. +proc ismaxindependentset {g nodes} { + + # i. all nodes in the set are pair-wise independent (no arcs + # between them). + foreach u $nodes { + set ua [$g arcs -adj $u] + foreach v $nodes { + # ignore u == v + if {$u eq $v} continue + set va [$g arcs -adj $v] + if {![struct::set empty [struct::set intersect $ua $va]]} { + # u, v have arc between them, are not independent. + return 0 + } + } + } + + # ii. all nodes outside of the set in the gaph are dependent on at + # least one node in the set. + foreach v [$g nodes] { + # ignore nodes in the set + if {$v in $nodes} continue + set va [$g arcs -adj $v] + + # node outside the set must have edge to at least one node in + # the set, or it would independent of it and the set would not + # be maximal. + set ok 0 + foreach u $nodes { + set ua [$g arcs -adj $u] + if {![struct::set empty [struct::set intersect $ua $va]]} { + # u, v have an arc between them, are not independent, + # good. + set ok 1 + break + } + } + if {!$ok} { return 0 } + } + return 1 +} + +#---------------------------------------------------------------------- +#---------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/Xcontrol b/tcllib/modules/struct/graph/tests/Xcontrol new file mode 100644 index 0000000..a08c0d0 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/Xcontrol @@ -0,0 +1,72 @@ +# -*- tcl -*- +# graph.testsuite: tests for the graph structure. +# +# This file contains a collection of tests for one or more of the Tcl +# built-in commands. Sourcing this file into Tcl runs the tests and +# generates output for errors. No output means no errors were found. +# +# Copyright (c) 1998-2000 by Ajuba Solutions. +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# +# RCS: @(#) $Id: Xcontrol,v 1.3 2009/09/24 16:23:47 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +set SELF [file dirname [info script]] + +# ------------------------------------------------------------------------- + +source ${SELF}/Xsetup + +source ${SELF}/arcs.test +source ${SELF}/assign.test +source ${SELF}/command.test +source ${SELF}/deserialize.test +source ${SELF}/nodes.test +source ${SELF}/rassign.test +source ${SELF}/serialize.test +source ${SELF}/swap.test +source ${SELF}/walk.test + +source ${SELF}/arc/attr.test +source ${SELF}/arc/delete.test +source ${SELF}/arc/exists.test +source ${SELF}/arc/flip.test +source ${SELF}/arc/insert.test +source ${SELF}/arc/move.test +source ${SELF}/arc/move-source.test +source ${SELF}/arc/move-target.test +source ${SELF}/arc/rename.test +source ${SELF}/arc/source.test +source ${SELF}/arc/target.test +source ${SELF}/arc/nodes.test +source ${SELF}/arc/getweight.test +source ${SELF}/arc/getunweighted.test +source ${SELF}/arc/hasweight.test +source ${SELF}/arc/setunweighted.test +source ${SELF}/arc/setweight.test +source ${SELF}/arc/unsetweight.test +source ${SELF}/arc/weights.test + +source ${SELF}/node/attr.test +source ${SELF}/node/degree.test +source ${SELF}/node/delete.test +source ${SELF}/node/exists.test +source ${SELF}/node/insert.test +source ${SELF}/node/opposite.test +source ${SELF}/node/rename.test + +# Attribute handling, graph, arcs, nodes - mostly identical + +source ${SELF}/attr/Xsetup ; # Implementation independent - Move2 Xsupport? +source ${SELF}/attr/append.test +source ${SELF}/attr/get.test +source ${SELF}/attr/getall.test +source ${SELF}/attr/keyexists.test +source ${SELF}/attr/keys.test +source ${SELF}/attr/lappend.test +source ${SELF}/attr/set.test +source ${SELF}/attr/unset.test + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/Xsetup b/tcllib/modules/struct/graph/tests/Xsetup new file mode 100644 index 0000000..36a696b --- /dev/null +++ b/tcllib/modules/struct/graph/tests/Xsetup @@ -0,0 +1,100 @@ +# -*- tcl -*- +# graph.testsuite.setup: Setting up implementation specific definitions. +# +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# +# RCS: @(#) $Id: Xsetup,v 1.4 2009/11/03 17:38:30 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +# tmWrong - wrong#args generation, missing arguments +# tmTooMany - wrong#args generation, too many arguments +# MY - variable holding the name of the graph instance found in +# error messages. + +# ------------------------------------------------------------------------- + +::tcltest::testConstraint graph_critcl [string equal $impl critcl] + +switch -exact -- $setimpl { + critcl { + proc tmSE {tcl critcl} {return $critcl} + } + tcl { + proc tmSE {tcl critcl} {return $tcl} + } +} + +switch -exact -- $impl { + critcl { + set MY mygraph + + proc tmWrong {m loarg n {xarg {}}} { + return [tcltest::wrongNumArgs "mygraph $m" $loarg $n] + } + + proc tmTooMany {m loarg {xarg {}}} { + return [tcltest::tooManyArgs "mygraph $m" $loarg] + } + + proc tmE {tcl critcl} {return $critcl} + + if {[package vsatisfies [package present Tcl] 8.5]} { + proc tmWrongA {m loarg n {xarg {}}} { + if {[llength $m] > 1} {set m [lindex $m 1]} + return [tcltest::wrongNumArgs "CMD $m" $loarg $n] + } + + proc tmTooManyA {m loarg {xarg {}}} { + if {[llength $m] > 1} {set m [lindex $m 1]} + return [tcltest::tooManyArgs "CMD $m" $loarg] + } + } else { + proc tmWrongA {m loarg n {xarg {}}} { + return [tcltest::wrongNumArgs "mygraph $m" $loarg $n] + } + + proc tmTooManyA {m loarg {xarg {}}} { + return [tcltest::tooManyArgs "mygraph $m" $loarg] + } + } + } + tcl { + set MY ::mygraph + + proc tmWrong {m loarg n {xarg {}}} { + if {$xarg == {}} {set xarg $loarg} + if {$xarg != {}} {set xarg " $xarg"} + if {[llength $m] > 1} {set m _[join $m _]} + incr n + return [tcltest::wrongNumArgs "::struct::graph::_$m" "name$xarg" $n] + } + + proc tmTooMany {m loarg {xarg {}}} { + if {$xarg == {}} {set xarg $loarg} + if {$xarg != {}} {set xarg " $xarg"} + if {[llength $m] > 1} {set m _[join $m _]} + return [tcltest::tooManyArgs "::struct::graph::_$m" "name$xarg"] + } + + proc tmWrongA {m loarg n {xarg {}}} { + if {$xarg == {}} {set xarg $loarg} + if {$xarg != {}} {set xarg " $xarg"} + if {[llength $m] > 1} {set m _[join $m _]} + incr n + return [tcltest::wrongNumArgs "::struct::graph::_$m" "name$xarg" $n] + } + + proc tmTooManyA {m loarg {xarg {}}} { + if {$xarg == {}} {set xarg $loarg} + if {$xarg != {}} {set xarg " $xarg"} + if {[llength $m] > 1} {set m _[join $m _]} + return [tcltest::tooManyArgs "::struct::graph::_$m" "name$xarg"] + } + + proc tmE {tcl critcl} {return $tcl} + } +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/Xsupport b/tcllib/modules/struct/graph/tests/Xsupport new file mode 100644 index 0000000..fe22b48 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/Xsupport @@ -0,0 +1,320 @@ +# -*- tcl -*- +# graph.testsupport: Helper commands for the testsuite. +# +# Copyright (c) 1998-2000 by Ajuba Solutions. +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# +# All rights reserved. +# +# RCS: @(#) $Id: Xsupport,v 1.4 2009/11/03 17:38:30 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +# Validate a serialization against the graph it was generated from. + +proc validate_serial {g serial {nodes {}}} { + # Need a list with length a multiple of 3, plus one. + + if {[llength $serial] % 3 != 1} { + return serial/wrong#elements + } + + set gattr [lindex $serial end] + if {[llength $gattr] % 2} { + return attr/graph/wrong#elements + } + if {![string equal \ + [dictsort $gattr] \ + [dictsort [$g getall]]]} { + return attr/graph/data-mismatch + } + + # Check node attrs and arcs information + array set an {} + array set ne {} + foreach {node attr arcs} [lrange $serial 0 end-1] { + # Must not list nodes outside of origin + if {![$g node exists $node]} { + return node/$node/unknown + } + # Node structure correct ? + if {[llength $attr] % 2} { + return node/$node/attr/wrong#elements + } + # Node attributes matching ? + if {![string equal \ + [dictsort $attr] \ + [dictsort [$g node getall $node]]]} { + return node/$node/attr/data-mismatch + } + # Remember nodes for reverse check. + set ne($node) . + + # Go through the attached arcs. + foreach a $arcs { + # Structure correct ? + if {([llength $a] != 3) && ([llength $a] != 4)} { + return node/$node/arc/wrong#elements + } + # Decode structure + foreach {arc dst aattr} $a break + # Already handled ? + if {[info exists an($arc)]} { + return arc/$arc/duplicate-definition + } + # Must not list arc outside of origin + if {![$g arc exists $arc]} { + return arc/$arc/unknown + } + # Attribute structure correct ? + if {[llength $aattr] % 2} { + return arc/$arc/attr/wrong#elements + } + # Attribute data correct ? + if {![string equal \ + [dictsort $aattr] \ + [dictsort [$g arc getall $arc]]]} { + return arc/$arc/attr/data-mismatch + } + # Arc information, node reference ok ? + if {![string is integer -strict $dst]} { + return arc/$arc/dst/not-an-integer + } + if {$dst < 0} { + return arc/$arc/dst/out-of-bounds + } + if {$dst >= [llength $serial]} { + return arc/$arc/dts/out-of-bounds + } + # Arc information matching origin ? + if {![string equal $node [$g arc source $arc]]} { + return arc/$arc/src/mismatch/$node/[$g arc source $arc] + } + if {![string equal [lindex $serial $dst] [$g arc target $arc]]} { + return arc/$arc/dst/mismatch/$node/[$g arc target $arc] + } + # Arc weight ok? + if {[llength $a] == 4} { + if {![$g arc hasweight $arc]} { + return arc/$arc/weight/mismatch/existence/defined-but-missing + } elseif {[lindex $a end] ne [$g arc getweight $arc]} { + return arc/$arc/weight/mismatch/value/[lindex $a end]/[$g arc getweight $arc]/ + } + } elseif {[$g arc hasweight $arc]} { + return arc/$arc/weight/mismatch/existence/undefined-but-notmissing + } + # Remember for check for multiples + set an($arc) . + } + } + + # Nodes ... All must exist in graph ... + # ... Spanning nodes have to be in serialization + + if {[llength $nodes] == 0} { + set nodes [lsort [$g nodes]] + } else { + set nodes [lsort $nodes] + } + + # Reverse check ... + if {[array size ne] != [llength $nodes]} { + return nodes/mismatch/#nodes + } + if {![string equal [lsort [array names ne]] $nodes]} { + return nodes/mismatch/data + } + + # Arcs ... All must exist in graph ... + # ... src / dst has to exist, has to match data in graph. + # ... All arcs between nodes in 'n' have to be in 'a' + + foreach k [$g arcs] { + set s [$g arc source $k] + set e [$g arc target $k] + if {[info exists ne($s)] && [info exists ne($e)] && ![info exists an($k)]} { + return arc/$k/missing/should-have-been-listed + } + } + + return ok +} + +#---------------------------------------------------------------------- + +proc SETUP {{g mygraph}} { + catch {$g destroy} + struct::graph $g +} + +#---------------------------------------------------------------------- + +proc SETUPx {} { + SETUP + + mygraph node insert %0 %1 %2 %3 %4 %5 + mygraph node set %0 volume 30 + mygraph node set %5 volume 50 + + mygraph arc insert %0 %1 0 ; mygraph arc set 0 volume 30 + mygraph arc insert %0 %2 1 + mygraph arc insert %0 %3 2 + mygraph arc insert %3 %4 3 + mygraph arc insert %4 %5 4 + mygraph arc insert %5 %3 5 ; mygraph arc set 5 volume 50 +} + +#---------------------------------------------------------------------- + +proc SETUPwalk {} { + SETUP + mygraph node insert i ii iii iv v vi vii viii ix + mygraph arc insert i ii 1 + mygraph arc insert ii iii 2 + mygraph arc insert ii iii 3 + mygraph arc insert ii iii 4 + mygraph arc insert iii iv 5 + mygraph arc insert iii iv 6 + mygraph arc insert iv v 7 + mygraph arc insert v vi 8 + mygraph arc insert vi viii 9 + mygraph arc insert viii i 10 + mygraph arc insert i ix 11 + mygraph arc insert ix ix 12 + mygraph arc insert i vii 13 + mygraph arc insert vii vi 14 +} + +#---------------------------------------------------------------------- +# Generators for various error messages generated +# by the implementations. + +proc MissingArc {g a} {return "arc \"$a\" does not exist in graph \"$g\""} +proc MissingNode {g n} {return "node \"$n\" does not exist in graph \"$g\""} + +proc ExistingArc {g a} {return "arc \"$a\" already exists in graph \"$g\""} +proc ExistingNode {g n} {return "node \"$n\" already exists in graph \"$g\""} + +proc MissingKey {e type k} {return "invalid key \"$k\" for $type \"$e\""} + +# Fake for graph attribute tests +proc MissingGraph {args} {return {Bogus missing}} + +#---------------------------------------------------------------------- + +# Helper commands for TSP problems. + +# 1. Generate canonical arc direction for a set of arcs, assuming that +# the arcs are specified as {nodeA nodeB}. Handles plain arc names +# as well, by ignoring them. Works only if plain arc names do not +# contain spaces. + +proc undirected {arcs} { + # arcs = list(arc), arc = list(source target) + set result {} + foreach a $arcs { + if {[llength $a] < 2} { + lappend result $a + } else { + lappend result [lsort $a] + } + } + return $result +} + +# 2. Canonical representations of TSP tours. +# 2a. For symmetrical graphs the tour weight is invariant under node +# rotation and reversal of direction. +# 2b. For asymmetrical graphs the tour weight is invariant under node +# rotation. +# +# 'toursort' generates a canonical representation for a tour per (2a). +# First node is smallest node in the tour, second node is the smallest +# of the two neighbours in the tour, of the first node. +# +# 'toursorta' generates a canonical representation for a tour per (2b). +# First node is smallest node in the tour. +# +# 'Smallest' isdefined through lexicographical comparison of node +# names (lsort -dict). + +proc toursort {nodes} { + # Remember: last(nodes) == first(nodes) + + # Empty or single-node tour => nothing to do. + if {[llength $nodes] <= 2} { + return $nodes + } + + # Two-node tour => Sort it. + if {[llength $nodes] == 2} { + return [list {*}[set first [lsort -dict [lrange $nodes 0 1]]] $first] + } + + # Three or more nodes requires more complex operations. + + set nodes [lrange $nodes 0 end-1] ; # Drop the duplicate + set min [lindex [lsort -dict $nodes] 0] + set pos [lsearch -exact $nodes $min] + + # Extended list with pre-fist/post-last nodes to avoid boundary + # computations when getting the neighbours of min. + + set e [list [lindex $nodes end] {*}$nodes [lindex $nodes 0]] + + # We have to correct pos (+1) for the extended list, inlining this + # into the neighbour extraction, we are looking for the nodes at + # locations (pos+1)-1 and (pos+1)+1, i.e. pos and pos+2. + + set pre [lindex $e $pos] + set post [lindex $e $pos+2] + + if {[lindex [lsort -dict [list $pre $post]] 0] eq $pre} { + # pre < post => The direction is wrong, reverse. + set nodes [lreverse $nodes] + set pos [lsearch -exact $nodes $min] + } + + # Now it is time to rotate the node last to bring min to the + # front, if it is not there already. + + if {$pos > 0} { + set nodes [list {*}[lrange $nodes ${pos} end] {*}[lrange $nodes 0 ${pos}-1]] + } + + # Re-add the duplicate. + lappend nodes [lindex $nodes 0] + return $nodes +} + +proc toursorta {nodes} { + # Remember: last(nodes) == first(nodes) + + # Empty or single-node tour => nothing to do. + if {[llength $nodes] <= 2} { + return $nodes + } + + # Two-node tour => Sort it. + if {[llength $nodes] == 2} { + return [list {*}[set first [lsort -dict [lrange $nodes 0 1]]] $first] + } + + # Three or more nodes requires more complex operations. + + set nodes [lrange $nodes 0 end-1] ; # Drop the duplicate + set pos [lsearch -exact $nodes [lindex [lsort -dict $nodes] 0]] + + # Now it is time to rotate the node last to bring min to the + # front, if it is not there already. + + if {$pos > 0} { + set nodes [list {*}[lrange $nodes ${pos} end] {*}[lrange $nodes 0 ${pos}-1]] + } + + # Re-add the duplicate. + lappend nodes [lindex $nodes 0] + return $nodes +} + +#---------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/attr.test b/tcllib/modules/struct/graph/tests/arc/attr.test new file mode 100644 index 0000000..013e243 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/attr.test @@ -0,0 +1,97 @@ +# -*- tcl -*- +# Graph tests - arc attr +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: attr.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc attr KEY ?-arcs ARCLIST|-glob PATTERN|-regexp PATTERN? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-attr-1.0 {arc attr, wrong#args, missing} { + SETUPx + catch {mygraph arc attr} msg + mygraph destroy + set msg +} [tmWrong {arc attr} {key ?-arcs list|-glob pattern|-regexp pattern?} 0 {key args}] + +test graph-${impl}-${setimpl}-arc-attr-1.1 {arc attr, wrong#args, missing} { + SETUPx + catch {mygraph arc attr a b} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY arc attr key ?-arcs list|-glob pattern|-regexp pattern?\"" + +test graph-${impl}-${setimpl}-arc-attr-1.2 {arc attr, wrong#args, too many} { + SETUPx + catch {mygraph arc attr a b c d} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY arc attr key ?-arcs list|-glob pattern|-regexp pattern?\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-attr-2.0 {arc attr, bogus switch} { + SETUPx + catch {mygraph arc attr a -foo barf} msg + mygraph destroy + set msg +} {bad type "-foo": must be -arcs, -glob, or -regexp} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-attr-3.0 {arc attr, unfiltered, nothing} { + SETUPx + set result [mygraph arc attr vol] + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-arc-attr-3.1 {arc attr, unfiltered, something} { + SETUPx + set result [dictsort [mygraph arc attr volume]] + mygraph destroy + set result +} {0 30 5 50} + +test graph-${impl}-${setimpl}-arc-attr-3.2 {arc attr, filtered -arcs} { + SETUPx + set result [mygraph arc attr volume -arcs {0 3}] + mygraph destroy + set result +} {0 30} + +test graph-${impl}-${setimpl}-arc-attr-3.3 {arc attr, filtered -glob} { + SETUPx + set result [mygraph arc attr volume -glob {[0-3]}] + mygraph destroy + set result +} {0 30} + +test graph-${impl}-${setimpl}-arc-attr-3.4 {arc attr, filtered -regexp} { + SETUPx + set result [mygraph arc attr volume -regexp {[0-3]}] + mygraph destroy + set result +} {0 30} + +test graph-${impl}-${setimpl}-arc-attr-3.5 {arc attr, filtered -arcs nothing} { + SETUPx + set result [mygraph arc attr volume -arcs {}] + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-arc-attr-3.6 {arc attr, nothing} { + SETUPx + mygraph arc unset 0 volume + mygraph arc unset 5 volume + set result [mygraph arc attr volume] + mygraph destroy + set result +} {} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/delete.test b/tcllib/modules/struct/graph/tests/arc/delete.test new file mode 100644 index 0000000..41dc5b2 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/delete.test @@ -0,0 +1,94 @@ +# -*- tcl -*- +# Graph tests - arc deletion +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: delete.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc delete ARC ARC... + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-delete-1.0 {arc delete, wrong#args, missing} { + SETUP + catch {mygraph arc delete} msg + mygraph destroy + set msg +} [tmE {wrong # args: should be "::struct::graph::__arc_delete name arc arc..."} \ + {wrong # args: should be "mygraph arc delete arc arc..."}] + +# Cannot use tmWrong, will be incorrect for the Tcl implementation +# run by a pre-8.4 core. +# [tmWrong {arc delete} {arc arc...} 0] + +# Impossible to have too many arguments +# Any number of arcs is acceptable. + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-delete-2.0 {arc delete, missing arc} { + SETUP + catch {mygraph arc delete arc0} msg + mygraph destroy + set msg +} [MissingArc $MY arc0] + +# ------------------------------------------------------------------------- +# Ok arguments, single, multiple deletion. + +test graph-${impl}-${setimpl}-arc-delete-3.0 {arc delete} { + SETUP + + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + + set res {} + lappend res [mygraph arc exists arc0] + lappend res [mygraph arc delete arc0] + lappend res [mygraph arc exists arc0] + + mygraph destroy + set res +} {1 {} 0} + +test graph-${impl}-${setimpl}-arc-delete-3.1 {arc delete, multiple at once} { + SETUP + + mygraph node insert node0 node1 node2 node3 + mygraph arc insert node0 node1 arc0 + mygraph arc insert node0 node1 arc1 + mygraph arc insert node2 node3 arc2 + mygraph arc insert node1 node3 arc3 + + set res {} + lappend res [mygraph arc exists arc0] + lappend res [mygraph arc exists arc1] + lappend res [mygraph arc exists arc2] + lappend res [mygraph arc exists arc3] + lappend res [mygraph arc delete arc0 arc1 arc2 arc3] + lappend res [mygraph arc exists arc0] + lappend res [mygraph arc exists arc1] + lappend res [mygraph arc exists arc2] + lappend res [mygraph arc exists arc3] + + mygraph destroy + set res +} {1 1 1 1 {} 0 0 0 0} + +test graph-${impl}-${setimpl}-arc-delete-3.2 {arc delete, keeping adjacent nodes} { + SETUP + + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + + set res {} + lappend res [mygraph arc delete arc0] + lappend res [mygraph node exists node0] + lappend res [mygraph node exists node1] + + mygraph destroy + set res +} {{} 1 1} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/exists.test b/tcllib/modules/struct/graph/tests/arc/exists.test new file mode 100644 index 0000000..9865063 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/exists.test @@ -0,0 +1,47 @@ +# -*- tcl -*- +# Graph tests - arc existence +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: exists.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc exists ARC + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-exists-1.0 {arc exists, wrong#args, missing} { + SETUP + catch {mygraph arc exists} msg + mygraph destroy + set msg +} [tmWrong {arc exists} arc 0] + +test graph-${impl}-${setimpl}-arc-exists-1.1 {arc exists, wrong#args, too many} { + SETUP + catch {mygraph arc exists 0 1} msg + mygraph destroy + set msg +} [tmTooMany {arc exists} arc] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-exists-2.0 {arc exists} { + SETUP + set res {} + lappend res [mygraph arc exists arc1] + + mygraph node insert node1 node2 + mygraph arc insert node1 node2 arc1 + + lappend res [mygraph arc exists arc1] + + mygraph arc delete arc1 + + lappend res [mygraph arc exists arc1] + + mygraph destroy + set res +} {0 1 0} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/flip.test b/tcllib/modules/struct/graph/tests/arc/flip.test new file mode 100644 index 0000000..4fdd5d6 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/flip.test @@ -0,0 +1,59 @@ +# -*- tcl -*- +# Graph tests - arc flip +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: flip.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc flip ARC + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-flip-1.0 {arc flip, wrong#args, missing} { + SETUP + catch {mygraph arc flip} res + mygraph destroy + set res +} [tmWrong {arc flip} arc 0] + +test graph-${impl}-${setimpl}-arc-flip-1.1 {arc flip, wrong#args, too many} { + SETUP + catch {mygraph arc flip a b} res + mygraph destroy + set res +} [tmTooMany {arc flip} arc] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-flip-2.0 {arc flip, missing arc} { + SETUP + catch {mygraph arc flip a} res + mygraph destroy + set res +} [MissingArc $MY a] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-flip-3.0 {arc flip, regular arc} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + mygraph arc flip a + set res [list [mygraph arc source a] [mygraph arc target a]] + mygraph destroy + set res +} {1 0} + +test graph-${impl}-${setimpl}-arc-flip-3.1 {arc flip, loop} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc flip a + set res [list [mygraph arc source a] [mygraph arc target a]] + mygraph destroy + set res +} {0 0} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/getunweighted.test b/tcllib/modules/struct/graph/tests/arc/getunweighted.test new file mode 100644 index 0000000..2b94904 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/getunweighted.test @@ -0,0 +1,74 @@ +# -*- tcl -*- +# Graph tests - arc getunweighted +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: getunweighted.test,v 1.1 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph arc getunweighted + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-getunweighted-1.0 {arc getunweighted, wrong#args, too many} { + SETUP + catch {mygraph arc getunweighted a} res + mygraph destroy + set res +} [tmTooMany {arc getunweighted} {}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-getunweighted-3.0 {arc getunweighted, no arcs} { + SETUP + set res [mygraph arc getunweighted] + mygraph destroy + set res +} {} + +test graph-${impl}-${setimpl}-arc-getunweighted-3.1 {arc getunweighted, all arcs, one} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + set res [mygraph arc getunweighted] + mygraph destroy + set res +} {a} + +test graph-${impl}-${setimpl}-arc-getunweighted-3.2 {arc getunweighted, all arcs, more} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph node insert 1 + mygraph arc insert 1 0 b + set res [lsort -dict [mygraph arc getunweighted]] + mygraph destroy + set res +} {a b} + +test graph-${impl}-${setimpl}-arc-getunweighted-3.3 {arc getunweighted, none} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setweight a 1 + set res [mygraph arc getunweighted] + mygraph destroy + set res +} {} + +test graph-${impl}-${setimpl}-arc-getunweighted-3.4 {arc getunweighted, some} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph node insert 1 + mygraph arc insert 1 0 b + mygraph arc setweight a 1 + set res [mygraph arc getunweighted] + mygraph destroy + set res +} b + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/getweight.test b/tcllib/modules/struct/graph/tests/arc/getweight.test new file mode 100644 index 0000000..b1f9176 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/getweight.test @@ -0,0 +1,58 @@ +# -*- tcl -*- +# Graph tests - arc getweight +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: getweight.test,v 1.1 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph arc getweight + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-getweight-1.0 {arc getweight, wrong#args, missing} { + SETUP + catch {mygraph arc getweight} res + mygraph destroy + set res +} [tmWrong {arc getweight} arc 0] + +test graph-${impl}-${setimpl}-arc-getweight-1.1 {arc getweight, wrong#args, too many} { + SETUP + catch {mygraph arc getweight a b} res + mygraph destroy + set res +} [tmTooMany {arc getweight} arc] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-getweight-2.0 {arc getweight, missing arc} { + SETUP + catch {mygraph arc getweight a} res + mygraph destroy + set res +} [MissingArc $MY a] + +test graph-${impl}-${setimpl}-arc-getweight-2.1 {arc getweight, arc missing weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + catch {mygraph arc getweight a} res + mygraph destroy + set res +} {arc "a" has no weight} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-getweight-3.0 {arc getweight, arc has weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setweight a 1 + set res [mygraph arc getweight a] + mygraph destroy + set res +} 1 + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/hasweight.test b/tcllib/modules/struct/graph/tests/arc/hasweight.test new file mode 100644 index 0000000..a2ff523 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/hasweight.test @@ -0,0 +1,58 @@ +# -*- tcl -*- +# Graph tests - arc hasweight +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: hasweight.test,v 1.1 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph arc hasweight + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-hasweight-1.0 {arc hasweight, wrong#args, missing} { + SETUP + catch {mygraph arc hasweight} res + mygraph destroy + set res +} [tmWrong {arc hasweight} arc 0] + +test graph-${impl}-${setimpl}-arc-hasweight-1.1 {arc hasweight, wrong#args, too many} { + SETUP + catch {mygraph arc hasweight a b} res + mygraph destroy + set res +} [tmTooMany {arc hasweight} arc] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-hasweight-2.0 {arc hasweight, missing arc} { + SETUP + catch {mygraph arc hasweight a} res + mygraph destroy + set res +} [MissingArc $MY a] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-hasweight-3.0 {arc hasweight, arc missing weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + set res [mygraph arc hasweight a] + mygraph destroy + set res +} 0 + +test graph-${impl}-${setimpl}-arc-hasweight-3.` {arc hasweight, arc has weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setweight a 1 + set res [mygraph arc hasweight a] + mygraph destroy + set res +} 1 + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/insert.test b/tcllib/modules/struct/graph/tests/arc/insert.test new file mode 100644 index 0000000..b3c5efa --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/insert.test @@ -0,0 +1,113 @@ +# -*- tcl -*- +# Graph tests - arc insertion +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: insert.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc insert START END ?ARC? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-insert-1.0 {arc insert, wrong#args, missing} { + SETUP + catch {mygraph arc insert} msg + mygraph destroy + set msg +} [tmWrong {arc insert} {source target ?arc?} 0 {source target args}] + +test graph-${impl}-${setimpl}-arc-insert-1.1 {arc insert, wrong#args, missing} { + SETUP + catch {mygraph arc insert 0} msg + mygraph destroy + set msg +} [tmWrong {arc insert} {source target ?arc?} 1 {source target args}] + +test graph-${impl}-${setimpl}-arc-insert-1.2 {arc insert, wrong#args, too many} { + SETUP + catch {mygraph arc insert 0 1 2 3} msg + mygraph destroy + set msg +} [tmE {wrong # args: should be "::struct::graph::__arc_insert name source target ?arc?"} \ + {wrong # args: should be "mygraph arc insert source target ?arc?"}] + +# Cannot use tmTooMany, will be incorrect for the Tcl implementation +# run by a pre-8.4 core. +# [tmTooMany {arc insert} {source target ?arc?}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-insert-2.0 {arc insert, missing start} { + SETUP + mygraph node insert node1 + catch {mygraph arc insert node0 node1 arc0} msg + mygraph destroy + set msg +} "source [MissingNode $MY node0]" + +test graph-${impl}-${setimpl}-arc-insert-2.1 {arc insert, missing end} { + SETUP + mygraph node insert node0 + catch {mygraph arc insert node0 node1 arc0} msg + mygraph destroy + set msg +} "target [MissingNode $MY node1]" + +test graph-${impl}-${setimpl}-arc-insert-2.2 {arc insert, existing arc} { + SETUP + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + catch {mygraph arc insert node0 node1 arc0} msg + mygraph destroy + set msg +} [ExistingArc $MY arc0] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-insert-3.0 {arc insert, node/arc linkage} { + SETUP + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + + set result {} + lappend result [mygraph arc exists arc0] + lappend result [mygraph arc source arc0] + lappend result [mygraph arc target arc0] + lappend result [mygraph arcs -out node0] + lappend result [mygraph arcs -in node1] + + mygraph destroy + set result +} {1 node0 node1 arc0 arc0} + +test graph-${impl}-${setimpl}-arc-insert-3.1 {arc insert, attribute defaults} { + SETUP + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + + set result [mygraph arc getall arc0] + + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-arc-insert-3.2 {arc insert, auto-generated name} { + SETUP + mygraph node insert n0 + + # Note: The use of 'arc3' for the explicit name tests that the + # name-generator will skip over existing names when it tries to + # come up with a new one. + + set result {} + lappend result [mygraph arc insert n0 n0] + lappend result [mygraph arc insert n0 n0] + mygraph arc insert n0 n0 arc3 + lappend result [mygraph arc insert n0 n0] + mygraph destroy + set result +} {arc1 arc2 arc4} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/move-source.test b/tcllib/modules/struct/graph/tests/arc/move-source.test new file mode 100644 index 0000000..971188b --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/move-source.test @@ -0,0 +1,76 @@ +# -*- tcl -*- +# Graph tests - arc move-source +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: move-source.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc move-source ARC NEW-SOURCE + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-move-source-1.0 {arc move-source, wrong#args, missing} { + SETUP + catch {mygraph arc move-source} res + mygraph destroy + set res +} [tmWrong {arc move-source} {arc newsource} 0] + +test graph-${impl}-${setimpl}-arc-move-source-1.1 {arc move-source, wrong#args, missing} { + SETUP + catch {mygraph arc move-source a} res + mygraph destroy + set res +} [tmWrong {arc move-source} {arc newsource} 1] + +test graph-${impl}-${setimpl}-arc-move-source-1.2 {arc move-source, wrong#args, too many} { + SETUP + catch {mygraph arc move-source a b c} res + mygraph destroy + set res +} [tmTooMany {arc move-source} {arc newsource}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-move-source-1.3 {arc move-source, missing arc} { + SETUP + mygraph node insert 0 + catch {mygraph arc move-source a 0} res + mygraph destroy + set res +} [MissingArc $MY a] + +test graph-${impl}-${setimpl}-arc-move-source-1.4 {arc move-source, missing node} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + catch {mygraph arc move-source a 2} res + mygraph destroy + set res +} [MissingNode $MY 2] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-move-source-1.5 {arc move-source, changed source} { + SETUP + mygraph node insert 0 1 2 + mygraph arc insert 0 1 a + mygraph arc move-source a 2 + set res [mygraph arc source a] + mygraph destroy + set res +} 2 + +test graph-${impl}-${setimpl}-arc-move-source-1.6 {arc move-source, unchanged source} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + mygraph arc move-source a 0 + set res [mygraph arc source a] + mygraph destroy + set res +} 0 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/move-target.test b/tcllib/modules/struct/graph/tests/arc/move-target.test new file mode 100644 index 0000000..be0a5e3 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/move-target.test @@ -0,0 +1,76 @@ +# -*- tcl -*- +# Graph tests - arc move-target +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: move-target.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc move-target ARC NEW-TARGET + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-move-target-1.0 {arc move-target, wrong#args, missing} { + SETUP + catch {mygraph arc move-target} res + mygraph destroy + set res +} [tmWrong {arc move-target} {arc newtarget} 0] + +test graph-${impl}-${setimpl}-arc-move-target-1.1 {arc move-target, wrong#args, missing} { + SETUP + catch {mygraph arc move-target a} res + mygraph destroy + set res +} [tmWrong {arc move-target} {arc newtarget} 1] + +test graph-${impl}-${setimpl}-arc-move-target-1.2 {arc move-target, wrong#args, too many} { + SETUP + catch {mygraph arc move-target a b c} res + mygraph destroy + set res +} [tmTooMany {arc move-target} {arc newtarget}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-move-target-1.3 {arc move-target, missing arc} { + SETUP + mygraph node insert 0 + catch {mygraph arc move-target a 0} res + mygraph destroy + set res +} [MissingArc $MY a] + +test graph-${impl}-${setimpl}-arc-move-target-1.4 {arc move-target, missing node} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + catch {mygraph arc move-target a 2} res + mygraph destroy + set res +} [MissingNode $MY 2] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-move-target-1.5 {arc move-target, changed target} { + SETUP + mygraph node insert 0 1 2 + mygraph arc insert 0 1 a + mygraph arc move-target a 2 + set res [mygraph arc target a] + mygraph destroy + set res +} 2 + +test graph-${impl}-${setimpl}-arc-move-target-1.6 {arc move-target, unchanged target} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + mygraph arc move-target a 0 + set res [mygraph arc target a] + mygraph destroy + set res +} 0 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/move.test b/tcllib/modules/struct/graph/tests/arc/move.test new file mode 100644 index 0000000..4275888 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/move.test @@ -0,0 +1,111 @@ +# -*- tcl -*- +# Graph tests - arc move +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: move.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc move ARC NEW-SOURCE NEW-TARGET + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-move-1.0 {arc move, wrong#args, missing} { + SETUP + catch {mygraph arc move} res + mygraph destroy + set res +} [tmWrong {arc move} {arc newsource newtarget} 0] + +test graph-${impl}-${setimpl}-arc-move-1.1 {arc move} { + SETUP + catch {mygraph arc move a} res + mygraph destroy + set res +} [tmWrong {arc move} {arc newsource newtarget} 1] + +test graph-${impl}-${setimpl}-arc-move-1.2 {arc move} { + SETUP + catch {mygraph arc move a b} res + mygraph destroy + set res +} [tmWrong {arc move} {arc newsource newtarget} 2] + +test graph-${impl}-${setimpl}-arc-move-1.3 {arc move} { + SETUP + catch {mygraph arc move a b c d} res + mygraph destroy + set res +} [tmTooMany {arc move} {arc newsource newtarget}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-move-2.0 {arc move} { + SETUP + mygraph node insert 0 1 + catch {mygraph arc move a 0 1} res + mygraph destroy + set res +} [MissingArc $MY a] + +test graph-${impl}-${setimpl}-arc-move-2.1 {arc move} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + catch {mygraph arc move a 0 2} res + mygraph destroy + set res +} [MissingNode $MY 2] + +test graph-${impl}-${setimpl}-arc-move-2.2 {arc move} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + catch {mygraph arc move a 2 0} res + mygraph destroy + set res +} [MissingNode $MY 2] + +# ------------------------------------------------------------------------- + +test graph-${impl}-${setimpl}-arc-move-3.0 {arc move, new source & target} { + SETUP + mygraph node insert 0 1 2 3 + mygraph arc insert 0 1 a + mygraph arc move a 2 3 + set res [list [mygraph arc source a] [mygraph arc target a]] + mygraph destroy + set res +} {2 3} + +test graph-${impl}-${setimpl}-arc-move-3.1 {arc move, unchanged source, target} { + SETUP + mygraph node insert 0 1 2 3 + mygraph arc insert 0 1 a + mygraph arc move a 0 1 + set res [list [mygraph arc source a] [mygraph arc target a]] + mygraph destroy + set res +} {0 1} + +test graph-${impl}-${setimpl}-arc-move-3.2 {arc move, unchanged source, changed target} { + SETUP + mygraph node insert 0 1 2 3 + mygraph arc insert 0 1 a + mygraph arc move a 0 3 + set res [list [mygraph arc source a] [mygraph arc target a]] + mygraph destroy + set res +} {0 3} + +test graph-${impl}-${setimpl}-arc-move-3.3 {arc move, changed source, unchanged target} { + SETUP + mygraph node insert 0 1 2 3 + mygraph arc insert 0 1 a + mygraph arc move a 2 1 + set res [list [mygraph arc source a] [mygraph arc target a]] + mygraph destroy + set res +} {2 1} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/nodes.test b/tcllib/modules/struct/graph/tests/arc/nodes.test new file mode 100644 index 0000000..d5383b7 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/nodes.test @@ -0,0 +1,48 @@ +# -*- tcl -*- +# Graph tests - arc nodes +# Copyright (c) 2009 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: nodes.test,v 1.1 2009/09/24 16:23:47 andreas_kupries Exp $ + +# Syntax: graph arc nodes ARC + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-nodes-1.0 {arc nodes, wrong#arcs, missing} { + SETUP + catch {mygraph arc nodes} msg + mygraph destroy + set msg +} [tmWrong {arc nodes} arc 0] + +test graph-${impl}-${setimpl}-arc-nodes-1.1 {arc nodes, wrong#arcs, too many} { + SETUP + catch {mygraph arc nodes a b} msg + mygraph destroy + set msg +} [tmTooMany {arc nodes} arc] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-nodes-2.0 {arc nodes, missing arc} { + SETUP + catch {mygraph arc nodes arc0} msg + mygraph destroy + set msg +} [MissingArc $MY arc0] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-nodes-3.0 {arc nodes} { + SETUP + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + set result [mygraph arc nodes arc0] + mygraph destroy + set result +} {node0 node1} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/rename.test b/tcllib/modules/struct/graph/tests/arc/rename.test new file mode 100644 index 0000000..250dc7a --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/rename.test @@ -0,0 +1,104 @@ +# -*- tcl -*- +# Graph tests - arc rename +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: rename.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc rename ARC NEWNAME + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-rename-1.0 {arc rename, wrong # args, missing} { + SETUP + catch {mygraph arc rename} result + mygraph destroy + set result +} [tmWrong {arc rename} {arc newname} 0] + +test graph-${impl}-${setimpl}-arc-rename-1.1 {arc rename, wrong # args, missing} { + SETUP + catch {mygraph arc rename foo} result + mygraph destroy + set result +} [tmWrong {arc rename} {arc newname} 1] + +test graph-${impl}-${setimpl}-arc-rename-1.2 {arc rename, wrong # args, too many} { + SETUP + catch {mygraph arc rename foo far fox} result + mygraph destroy + set result +} [tmTooMany {arc rename} {arc newname}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-rename-2.0 {arc rename, missing arc} { + SETUP + catch {mygraph arc rename 0 foo} result + mygraph destroy + set result +} [MissingArc $MY 0] + +test graph-${impl}-${setimpl}-arc-rename-2.1 {arc rename, duplicate arc for target} { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a + mygraph arc insert 0 1 b + + catch {mygraph arc rename a b} result + mygraph destroy + set result +} [ExistingArc $MY b] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-rename-3.0 {arc rename, node linkage} { + SETUP + + mygraph node insert a b + mygraph arc insert a b 0 + + set result {} + lappend result [mygraph arc source 0] + lappend result [mygraph arc target 0] + lappend result [mygraph arc exists 0] + lappend result [mygraph arc exists snarf] + lappend result [mygraph arcs -in b] + lappend result [mygraph arcs -out a] + + mygraph arc rename 0 snarf + lappend result | + + lappend result [mygraph arc source snarf] + lappend result [mygraph arc target snarf] + lappend result [mygraph arc exists 0] + lappend result [mygraph arc exists snarf] + lappend result [mygraph arcs -in b] + lappend result [mygraph arcs -out a] + + mygraph destroy + set result +} {a b 1 0 0 0 | a b 0 1 snarf snarf} + +test graph-${impl}-${setimpl}-arc-rename-3.1 {arc rename, attribute transfer} { + SETUP + mygraph node insert a b + mygraph arc insert a b 0 + mygraph arc set 0 data foo + + set result {} + lappend result [mygraph arc getall 0] + lappend result [catch {mygraph arc getall 5}] + + mygraph arc rename 0 5 + + lappend result [mygraph arc getall 5] + lappend result [catch {mygraph arc getall 0}] + + mygraph destroy + set result +} {{data foo} 1 {data foo} 1} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/setunweighted.test b/tcllib/modules/struct/graph/tests/arc/setunweighted.test new file mode 100644 index 0000000..d70cbe1 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/setunweighted.test @@ -0,0 +1,64 @@ +# -*- tcl -*- +# Graph tests - arc setunweighted +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: setunweighted.test,v 1.1 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph arc setunweighted + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-setunweighted-1.0 {arc setunweighted, wrong#args, too many} { + SETUP + catch {mygraph arc setunweighted a b} res + mygraph destroy + set res +} [tmTooMany {arc setunweighted} {?weight?}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-setunweighted-3.0 {arc setunweighted, no arcs to set} { + SETUP + mygraph arc setunweighted + set res [mygraph arc weights] + mygraph destroy + set res +} {} + +test graph-${impl}-${setimpl}-arc-setunweighted-3.1 {arc setunweighted, arc, no arcs to set} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setweight a 3 + mygraph arc setunweighted + set res [mygraph arc weights] + mygraph destroy + set res +} {a 3} + +test graph-${impl}-${setimpl}-arc-setunweighted-3.2 {arc setunweighted, arc, set default} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setunweighted + set res [mygraph arc weights] + mygraph destroy + set res +} {a 0} + +test graph-${impl}-${setimpl}-arc-setunweighted-3.3 {arc setunweighted, arc, set weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setunweighted 4 + set res [mygraph arc weights] + mygraph destroy + set res +} {a 4} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/setweight.test b/tcllib/modules/struct/graph/tests/arc/setweight.test new file mode 100644 index 0000000..75cea95 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/setweight.test @@ -0,0 +1,71 @@ +# -*- tcl -*- +# Graph tests - arc setweight +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: setweight.test,v 1.1 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph arc setweight + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-setweight-1.0 {arc setweight, wrong#args, missing} { + SETUP + catch {mygraph arc setweight} res + mygraph destroy + set res +} [tmWrong {arc setweight} {arc weight} 0] + +test graph-${impl}-${setimpl}-arc-setweight-1.1 {arc setweight, wrong#args, missing} { + SETUP + catch {mygraph arc setweight a} res + mygraph destroy + set res +} [tmWrong {arc setweight} {arc weight} 0] + +test graph-${impl}-${setimpl}-arc-setweight-1.2 {arc setweight, wrong#args, too many} { + SETUP + catch {mygraph arc setweight a b c} res + mygraph destroy + set res +} [tmTooMany {arc setweight} {arc weight}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-setweight-2.0 {arc setweight, missing arc} { + SETUP + catch {mygraph arc setweight a 1} res + mygraph destroy + set res +} [MissingArc $MY a] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-setweight-3.0 {arc setweight, arc, set new weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + set res [mygraph arc hasweight a] + mygraph arc setweight a 2 + lappend res [mygraph arc hasweight a] + lappend res [mygraph arc getweight a] + mygraph destroy + set res +} {0 1 2} + +test graph-${impl}-${setimpl}-arc-setweight-3.1 {arc setweight, arc, replace existing weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setweight a 2 + set res [mygraph arc hasweight a] + mygraph arc setweight a 3 + lappend res [mygraph arc hasweight a] + lappend res [mygraph arc getweight a] + mygraph destroy + set res +} {1 1 3} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/source.test b/tcllib/modules/struct/graph/tests/arc/source.test new file mode 100644 index 0000000..b7f99f6 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/source.test @@ -0,0 +1,48 @@ +# -*- tcl -*- +# Graph tests - arc source +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: source.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc source ARC + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-source-1.0 {arc source, wrong#arcs, missing} { + SETUP + catch {mygraph arc source} msg + mygraph destroy + set msg +} [tmWrong {arc source} arc 0] + +test graph-${impl}-${setimpl}-arc-source-1.1 {arc source, wrong#arcs, too many} { + SETUP + catch {mygraph arc source a b} msg + mygraph destroy + set msg +} [tmTooMany {arc source} arc] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-source-2.0 {arc source, missing arc} { + SETUP + catch {mygraph arc source arc0} msg + mygraph destroy + set msg +} [MissingArc $MY arc0] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-source-3.0 {arc source} { + SETUP + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + set result [mygraph arc source arc0] + mygraph destroy + set result +} node0 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/target.test b/tcllib/modules/struct/graph/tests/arc/target.test new file mode 100644 index 0000000..5f74009 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/target.test @@ -0,0 +1,48 @@ +# -*- tcl -*- +# Graph tests - arc target +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: target.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph arc target ARC + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-target-1.0 {arc target, wrong#arcs, missing} { + SETUP + catch {mygraph arc target} msg + mygraph destroy + set msg +} [tmWrong {arc target} arc 0] + +test graph-${impl}-${setimpl}-arc-target-1.1 {arc target, wrong#arcs, too many} { + SETUP + catch {mygraph arc target a b} msg + mygraph destroy + set msg +} [tmTooMany {arc target} arc] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-target-2.0 {arc target, missing arc} { + SETUP + catch {mygraph arc target arc0} msg + mygraph destroy + set msg +} [MissingArc $MY arc0] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-target-3.0 {arc target} { + SETUP + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + set result [mygraph arc target arc0] + mygraph destroy + set result +} node1 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/unsetweight.test b/tcllib/modules/struct/graph/tests/arc/unsetweight.test new file mode 100644 index 0000000..8144212 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/unsetweight.test @@ -0,0 +1,62 @@ +# -*- tcl -*- +# Graph tests - arc unsetweight +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: unsetweight.test,v 1.1 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph arc unsetweight + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-unsetweight-1.0 {arc unsetweight, wrong#args, missing} { + SETUP + catch {mygraph arc unsetweight} res + mygraph destroy + set res +} [tmWrong {arc unsetweight} arc 0] + +test graph-${impl}-${setimpl}-arc-unsetweight-1.1 {arc unsetweight, wrong#args, too many} { + SETUP + catch {mygraph arc unsetweight a b} res + mygraph destroy + set res +} [tmTooMany {arc unsetweight} arc] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arc-unsetweight-2.0 {arc unsetweight, missing arc} { + SETUP + catch {mygraph arc unsetweight a} res + mygraph destroy + set res +} [MissingArc $MY a] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-unsetweight-3.0 {arc unsetweight, arc missing weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + set res [mygraph arc hasweight a] + mygraph arc unsetweight a + lappend res [mygraph arc hasweight a] + mygraph destroy + set res +} {0 0} + +test graph-${impl}-${setimpl}-arc-unsetweight-3.1 {arc unsetweight, arc missing weight} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setweight a 1 + set res [mygraph arc hasweight a] + mygraph arc unsetweight a + lappend res [mygraph arc hasweight a] + mygraph destroy + set res +} {1 0} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arc/weights.test b/tcllib/modules/struct/graph/tests/arc/weights.test new file mode 100644 index 0000000..430a745 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arc/weights.test @@ -0,0 +1,76 @@ +# -*- tcl -*- +# Graph tests - arc weights +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: weights.test,v 1.1 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph arc weights + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arc-weights-1.0 {arc weights, wrong#args, too many} { + SETUP + catch {mygraph arc weights a} res + mygraph destroy + set res +} [tmTooMany {arc weights} {}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arc-weights-3.0 {arc weights, no arcs} { + SETUP + set res [mygraph arc weights] + mygraph destroy + set res +} {} + +test graph-${impl}-${setimpl}-arc-weights-3.1 {arc weights, all arcs, one} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph arc setweight a 1 + set res [mygraph arc weights] + mygraph destroy + set res +} {a 1} + +test graph-${impl}-${setimpl}-arc-weights-3.2 {arc weights, all arcs, more} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph node insert 1 + mygraph arc insert 1 0 b + mygraph arc setweight a 2 + mygraph arc setweight b 1 + set res [dictsort [mygraph arc weights]] + mygraph destroy + set res +} {a 2 b 1} + +test graph-${impl}-${setimpl}-arc-weights-3.3 {arc weights, none} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + set res [mygraph arc weights] + mygraph destroy + set res +} {} + +test graph-${impl}-${setimpl}-arc-weights-3.4 {arc weights, some} { + SETUP + mygraph node insert 0 + mygraph arc insert 0 0 a + mygraph node insert 1 + mygraph arc insert 1 0 b + mygraph arc setweight a 1 + set res [mygraph arc weights] + mygraph destroy + set res +} {a 1} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/arcs.test b/tcllib/modules/struct/graph/tests/arcs.test new file mode 100644 index 0000000..9785a3f --- /dev/null +++ b/tcllib/modules/struct/graph/tests/arcs.test @@ -0,0 +1,326 @@ +# -*- tcl -*- +# Graph tests - arcs +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: arcs.test,v 1.4 2009/11/03 17:38:30 andreas_kupries Exp $ + +# Syntax: graph arcs +# (1) graph arcs -key KEY +# graph arcs -key KEY -value VALUE +# (2) graph arcs -filter CMDPREFIX +# (3) graph arcs -in NODE... +# graph arcs -out NODE... +# graph arcs -adj NODE... +# graph arcs -inner NODE... +# graph arcs -embedded NODE... + +# We can use one in each group (1,2,3) + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +# Cannot have missing arguments (zero is fine), +# except when switches are in use. That however +# is tested with the switches. Ditto for too many +# arguments. + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arcs-1.0 {arcs, bad switch} { + SETUP + catch {mygraph arcs -foo} msg + mygraph destroy + set msg +} {bad restriction "-foo": must be -adj, -embedding, -filter, -in, -inner, -key, -out, or -value} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arcs-2.0 {arcs, empty graph} { + SETUP + set result [mygraph arcs] + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-arcs-2.1 {arcs, nodes without arcs} { + SETUP + mygraph node insert 0 1 2 3 4 5 + set result [mygraph arcs] + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-arcs-2.2 {arcs} { + SETUP + mygraph node insert 0 1 2 3 4 5 + mygraph arc insert 0 1 a + mygraph arc insert 2 3 b + mygraph arc insert 4 5 c + set result [lsort [mygraph arcs]] + mygraph destroy + set result +} {a b c} + +# --------------------------------------------------- + +# (1) -key, -value +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arcs-key-1.0 {arcs, wrong#args, missing} { + SETUP + catch {mygraph arcs -key} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY arcs ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" + +test graph-${impl}-${setimpl}-arcs-key-1.1 {arcs, wrong#args, missing} { + SETUP + catch {mygraph arcs -value} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY arcs ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arcs-key-2.0 {arcs, multiple -key} { + SETUP + catch {mygraph arcs -key foobar -value 1 -key foo} msg + mygraph destroy + set msg +} {invalid restriction: illegal multiple use of "-key"} + +test graph-${impl}-${setimpl}-arcs-key-2.1 {arcs, multiple -value} { + SETUP + catch {mygraph arcs -key foobar -value 1 -value foo} msg + mygraph destroy + set msg +} {invalid restriction: illegal multiple use of "-value"} + +test graph-${impl}-${setimpl}-arcs-key-2.2 {arcs, -value without -key} { + SETUP + catch {mygraph arcs -value 1} msg + mygraph destroy + set msg +} {invalid restriction: use of "-value" without "-key"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arcs-key-3.0 {arcs, -key} { + SETUP + mygraph node insert n0 n1 + mygraph arc insert n0 n1 a1 + mygraph arc insert n0 n1 a2 + mygraph arc set a1 foobar 1 + mygraph arc set a2 blubber 2 + + catch {mygraph arcs -key foobar} msg + mygraph destroy + set msg +} a1 + +test graph-${impl}-${setimpl}-arcs-key-3.1 {arcs, -key, -value} { + SETUP + mygraph node insert n0 n1 + mygraph arc insert n0 n1 a1 + mygraph arc insert n0 n1 a2 + mygraph arc set a1 foobar 1 + mygraph arc set a2 foobar 2 + + catch {mygraph arcs -key foobar -value 1} msg + mygraph destroy + set msg +} a1 + +# --------------------------------------------------- + +# (2) -filter +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-arcs-filter-1.0 {arcs, wrong#args, missing} { + SETUP + catch {mygraph arcs -filter} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY arcs ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-arcs-filter-2.0 {arcs, multiple -filter} { + SETUP + catch {mygraph arcs -filter foobar -filter foo} msg + mygraph destroy + set msg +} {invalid restriction: illegal multiple use of "-filter"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-arcs-filter-3.0 {arcs, -filter} { + SETUP + + mygraph node insert 1 2 3 4 5 6 + + mygraph arc insert 4 1 A + mygraph arc insert 5 2 B + mygraph arc insert 6 3 C + mygraph arc insert 3 1 D + mygraph arc insert 1 2 E + mygraph arc insert 2 3 F + + mygraph arc set A volume 30 + mygraph arc set C volume 50 + + proc vol {g n} { + $g arc keyexists $n volume + } + + set result [lsort [mygraph arcs -filter vol]] + mygraph destroy + rename vol {} + + set result +} {A C} + +test graph-${impl}-${setimpl}-arcs-filter-3.1 {arcs, -filter} { + SETUP + + mygraph node insert 1 2 3 4 5 6 + + mygraph arc insert 4 1 A + mygraph arc insert 5 2 B + mygraph arc insert 6 3 C + mygraph arc insert 3 1 D + mygraph arc insert 1 2 E + mygraph arc insert 2 3 F + + mygraph arc set A volume 30 + mygraph arc set C volume 50 + + proc vol {g n} { + if {![$g arc keyexists $n volume]} {return 0} + expr {[$g arc get $n volume] > 40} + } + + set result [mygraph arcs -filter vol] + mygraph destroy + rename vol {} + + set result +} C + +# --------------------------------------------------- + +# (3) -in, -out, -adj, -inner, -embedding +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +set n 0 +foreach switch {-in -out -adj -inner -embedding} { + + test graph-${impl}-${setimpl}-arcs-ioaie-1.$n "arcs, $switch, wrong#args, missing" { + SETUP + catch {mygraph arcs $switch} msg + mygraph destroy + set msg + } "wrong # args: should be \"$MY arcs ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" ; # {} + + incr n +} + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +set n 0 +foreach switch {-in -out -adj -inner -embedding} { + + test graph-${impl}-${setimpl}-arcs-ioaie-2.$n "arcs, $switch, missing node" { + SETUP + catch {mygraph arcs $switch x} msg + mygraph destroy + set msg + } [MissingNode $MY x] ; # {} + + incr n + + foreach switchB {-in -out -adj -inner -embedding} { + + test graph-${impl}-${setimpl}-arcs-ioaie-2.$n "arcs, $switch, $switchB together" { + SETUP + catch {mygraph arcs $switch $switchB x} msg + mygraph destroy + set msg + } {invalid restriction: illegal multiple use of "-in"|"-out"|"-adj"|"-inner"|"-embedding"} ; # {} + + incr n + } +} + +# ------------------------------------------------------------------------- +# Ok arguments. + +set n 0 +foreach {switch nodes expected} { + -in {1 2 3} {A B C D E F} -in {4 5 6} {} + -out {1 2 3} {D E F} -out {4 5 6} {A B C} + -adj {1 2 3} {A B C D E F} -adj {4 5 6} {A B C} + -inner {1 2 3} {D E F} -inner {4 5 6} {} + -embedding {1 2 3} {A B C} -embedding {4 5 6} {A B C} + -in {1 2} {A B D E} -in {4 5} {} + -out {1 2} {E F} -out {4 5} {A B} + -adj {1 2} {A B D E F} -adj {4 5} {A B} + -inner {1 2} {E} -inner {4 5} {} + -embedding {1 2} {A B D F} -embedding {4 5} {A B} + -in {1} {A D} -in {4} {} + -out {1} {E} -out {4} {A} + -adj {1} {A D E} -adj {4} {A} + -inner {1} {} -inner {4} {} + -embedding {1} {A D E} -embedding {4} {A} + -in {1 4} {A D} -in {4 2} {B E} + -out {1 4} {A E} -out {4 2} {A F} + -adj {1 4} {A D E} -adj {4 2} {A B E F} + -inner {1 4} {A} -inner {4 2} {} + -embedding {1 4} {D E} -embedding {4 2} {A B E F} + -in {1 1} {A D} -in {4 4} {} + -out {1 1} {E} -out {4 4} {A} + -adj {1 1} {A D E} -adj {4 4} {A} + -inner {1 1} {} -inner {4 4} {} + -embedding {1 1} {A D E} -embedding {4 4} {A} +} { + test graph-${impl}-${setimpl}-arcs-ioaie-3.$n "arcs, $switch" { + SETUP + + mygraph node insert 1 2 3 4 5 6 + mygraph arc insert 4 1 A + mygraph arc insert 5 2 B + mygraph arc insert 6 3 C + mygraph arc insert 3 1 D + mygraph arc insert 1 2 E + mygraph arc insert 2 3 F + + set result [lsort [eval [linsert $nodes 0 mygraph arcs $switch]]] + mygraph destroy + set result + } $expected ; # {} + + incr n +} + +test graph-${impl}-${setimpl}-arcs-adj-1.0 {arcs -adj, border case C code failure} -setup { + struct::graph mygraph + mygraph node insert E + mygraph node insert F + mygraph arc insert E F E_F +} -body { + mygraph arcs -adj E +} -cleanup { + mygraph destroy +} -result {E_F} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/assign.test b/tcllib/modules/struct/graph/tests/assign.test new file mode 100644 index 0000000..20e2c29 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/assign.test @@ -0,0 +1,75 @@ +# -*- tcl -*- +# Graph tests - assignment (=) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: assign.test,v 1.2 2007/04/12 03:01:54 andreas_kupries Exp $ + +# Syntax: graph = GRAPH + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-assign-1.0 {assign, wrong#args, missing} { + SETUP + catch {mygraph =} result + mygraph destroy + set result +} [tmWrong = source 0] + +test graph-${impl}-${setimpl}-assign-1.1 {assign, wrong#args, too many} { + SETUP + catch {mygraph = foo bar} result + mygraph destroy + set result +} [tmTooMany = source] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-assign-2.0 {assign, bad src command} { + SETUP + catch {mygraph = foo} result + mygraph destroy + set result +} {invalid command name "foo"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-assign-3.0 {assign, direct} { + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + + SETUP + SETUP bgraph + + mygraph deserialize $serial + + set result [validate_serial bgraph $serial] + bgraph = mygraph + lappend result [validate_serial bgraph $serial] + + mygraph destroy + bgraph destroy + set result +} {attr/graph/data-mismatch ok} + +test graph-${impl}-${setimpl}-assign-3.1 {assign, deserial/serial} { + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + + SETUP + SETUP bgraph + proc mywrap {args} {uplevel #0 [linsert $args 0 mygraph]} + + mygraph deserialize $serial + + set result [validate_serial bgraph $serial] + bgraph = mywrap + lappend result [validate_serial bgraph $serial] + + mygraph destroy + bgraph destroy + rename mywrap {} + set result +} {attr/graph/data-mismatch ok} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/Xsetup b/tcllib/modules/struct/graph/tests/attr/Xsetup new file mode 100644 index 0000000..557ab66 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/Xsetup @@ -0,0 +1,78 @@ +# -*- tcl -*- +# Graph tests - Attribute helper commands +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: Xsetup,v 1.1 2006/11/16 06:33:14 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +proc Arc {} {mygraph node insert 0 1 ; mygraph arc insert 0 1 x} +proc Node {} {mygraph node insert x} +proc Graph {} {} + +proc SetRArc {a} {CMD set x $a} +proc SetRNode {a} {CMD set x $a} +proc SetRGraph {a} {CMD set $a} + +proc SetWArc {a v} {CMD set x $a $v} +proc SetWNode {a v} {CMD set x $a $v} +proc SetWGraph {a v} {CMD set $a $v} + +proc GetArc {a} {CMD get x $a} +proc GetNode {a} {CMD get x $a} +proc GetGraph {a} {CMD get $a} + +proc UnsetArc {a} {CMD unset x $a} +proc UnsetNode {a} {CMD unset x $a} +proc UnsetGraph {a} {CMD unset $a} + +proc AppendArc {a v} {CMD append x $a $v} +proc AppendNode {a v} {CMD append x $a $v} +proc AppendGraph {a v} {CMD append $a $v} + +proc LappendArc {a v} {CMD lappend x $a $v} +proc LappendNode {a v} {CMD lappend x $a $v} +proc LappendGraph {a v} {CMD lappend $a $v} + +proc KeyexistsArc {a} {CMD keyexists x $a} +proc KeyexistsNode {a} {CMD keyexists x $a} +proc KeyexistsGraph {a} {CMD keyexists $a} + +proc GetallArc {} {CMD getall x} +proc GetallNode {} {CMD getall x} +proc GetallGraph {} {CMD getall } + +proc GetallPArc {p} {CMD getall x $p} +proc GetallPNode {p} {CMD getall x $p} +proc GetallPGraph {p} {CMD getall $p} + +proc KeysArc {} {CMD keys x} +proc KeysNode {} {CMD keys x} +proc KeysGraph {} {CMD keys } + +proc KeysPArc {p} {CMD keys x $p} +proc KeysPNode {p} {CMD keys x $p} +proc KeysPGraph {p} {CMD keys $p} + +# ------------------------------------------------------------------------- + +proc AttrSetup {} { + # CMD is for the testing of wrong#args errors. + # XXX$ex are for regular tests, i.e. argument + # errors and ok behaviour. + + upvar 1 mk mk stem stem e e MY MY + + if {$mk == {}} {set mk $MY} + + # CMD = stem, remove existing CMD + catch {interp alias {} CMD {}} + eval [linsert $stem 0 interp alias {} CMD {}] + + # To skip tests which do not apply to graph attributes + ::tcltest::testConstraint graph \ + [string equal $e graph] + return +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/append.test b/tcllib/modules/struct/graph/tests/attr/append.test new file mode 100644 index 0000000..03dcbfd --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/append.test @@ -0,0 +1,88 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node append (attribute append) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: append.test,v 1.3 2008/03/07 06:51:36 andreas_kupries Exp $ + +# Syntax: graph append KEY VALUE +# Syntax: graph arc append ARC KEY VALUE +# Syntax: graph node append NODE KEY VALUE + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + AttrSetup + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-append-1.0 "$e append, wrong#args, missing" { + SETUP + catch {CMD append} msg + mygraph destroy + set msg + } [tmWrongA "${mp}append" "${mp}key value" 0] ; # {} + + test graph-${impl}-${setimpl}-${e}-append-1.1 "$e append, wrong#args, missing" { + SETUP + catch {CMD append a} msg + mygraph destroy + set msg + } [tmWrongA "${mp}append" "${mp}key value" 1] ; # {} + + test graph-${impl}-${setimpl}-${e}-append-1.2 "$e append, wrong#args, missing" !graph { + SETUP + catch {CMD append a b} msg + mygraph destroy + set msg + } [tmWrongA "${mp}append" "${mp}key value" 2] ; # {} + + test graph-${impl}-${setimpl}-${e}-append-1.3 "$e append, wrong#args, too many" { + SETUP + catch {CMD append a b c d} msg + mygraph destroy + set msg + } [tmTooManyA "${mp}append" "${mp}key value"] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-append-2.0 "$e append, missing $e" !graph { + SETUP + catch {Append$ex data foo} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-append-3.0 "$e append, no attribute, created" { + SETUP + $ex + set result {} + lappend result [Keyexists$ex data] + lappend result [Append$ex data bar] + lappend result [Keyexists$ex data] + lappend result [Get$ex data] + mygraph destroy + set result + } {0 bar 1 bar} ; # {} + + test graph-${impl}-${setimpl}-${e}-append-3.1 "$e append, existing attribute, appending" { + SETUP + $ex + set result {} + lappend result [SetW$ex data foo] + lappend result [Append$ex data bar] + lappend result [Get$ex data] + mygraph destroy + set result + } {foo foobar foobar} ; # {} +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/get.test b/tcllib/modules/struct/graph/tests/attr/get.test new file mode 100644 index 0000000..d7554ec --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/get.test @@ -0,0 +1,84 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node get (attribute get) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: get.test,v 1.3 2008/03/07 06:51:36 andreas_kupries Exp $ + +# Syntax: graph get KEY +# Syntax: graph arc get ARC KEY +# Syntax: graph node get NODE KEY + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + AttrSetup + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-get-1.0 "$e get, wrong#args, missing" { + SETUP + catch {CMD get} msg + mygraph destroy + set msg + } [tmWrongA "${mp}get" "${mp}key" 0] ; # {} + + test graph-${impl}-${setimpl}-${e}-get-1.1 "$e get, wrong#args, missing" !graph { + SETUP + catch {CMD get x} msg + mygraph destroy + set msg + } [tmWrongA "${mp}get" "${mp}key" 1] ; # {} + + test graph-${impl}-${setimpl}-${e}-get-1.2 "$e get, wrong#args, too many" { + SETUP + catch {CMD get x y z} msg + mygraph destroy + set msg + } [tmTooManyA "${mp}get" "${mp}key"] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-get-2.0 "$e get, missing $e" !graph { + SETUP + catch {Get$ex data} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + test graph-${impl}-${setimpl}-${e}-get-2.1 "$e get, no attributes" { + SETUP + $ex + catch {Get$ex bogus} msg + mygraph destroy + set msg + } [MissingKey $mk $e bogus] ; # {} + + test graph-${impl}-${setimpl}-${e}-get-2.2 "$e get, missing key" { + SETUP + $ex + SetW$ex foo far + catch {Get$ex bogus} msg + mygraph destroy + set msg + } [MissingKey $mk $e bogus] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-get-2.4 "$e get" { + SETUP + $ex + SetW$ex boom foobar + set result [Get$ex boom] + mygraph destroy + set result + } foobar ; # {} +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/getall.test b/tcllib/modules/struct/graph/tests/attr/getall.test new file mode 100644 index 0000000..114080d --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/getall.test @@ -0,0 +1,79 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node getall (attribute getall) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: getall.test,v 1.3 2008/03/07 06:51:37 andreas_kupries Exp $ + +# Syntax: graph getall ?PATTERN? +# Syntax: graph arc getall ARC ?PATTERN? +# Syntax: graph node getall NODE ?PATTERN? + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + AttrSetup + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-getall-1.0 "$e getall, wrong # args, missing" !graph { + SETUP + catch {CMD getall} msg + mygraph destroy + set msg + } [tmWrongA "${mp}getall" "${mp}?pattern?" 0] ; # {} + + test graph-${impl}-${setimpl}-${e}-getall-1.1 "$e getall, wrong # args, too many" { + SETUP + catch {CMD getall a b c} msg + mygraph destroy + set msg + } [tmTooManyA "${mp}getall" "${mp}?pattern?"] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-getall-2.0 "$e getall, missing $e" !graph { + SETUP + catch {Getall$ex} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-getall-3.0 "$e getall, no attributes, empty dictionary" { + SETUP + $ex + set results [Getall$ex] + mygraph destroy + set results + } {} ; # {} + + test graph-${impl}-${setimpl}-${e}-getall-3.1 "$e getall, result is dictionary" { + SETUP + $ex + SetW$ex data foobar + SetW$ex other thing + set results [dictsort [Getall$ex]] + mygraph destroy + set results + } {data foobar other thing} ; # {} + + test graph-${impl}-${setimpl}-${e}-getall-3.2 "$e getall, pattern match" { + SETUP + $ex + SetW$ex data foobar + SetW$ex other thing + set results [dictsort [GetallP$ex d*]] + mygraph destroy + set results + } {data foobar} ; # {} +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/keyexists.test b/tcllib/modules/struct/graph/tests/attr/keyexists.test new file mode 100644 index 0000000..d543be7 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/keyexists.test @@ -0,0 +1,84 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node keyexists (attribute keyexists) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: keyexists.test,v 1.3 2008/03/07 06:51:39 andreas_kupries Exp $ + +# Syntax: graph keyexists KEY +# Syntax: graph arc keyexists ARC KEY +# Syntax: graph node keyexists NODE KEY + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + AttrSetup + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-keyexists-1.0 "$e keyexists, wrong # args, missing" { + SETUP + catch {CMD keyexists} msg + mygraph destroy + set msg + } [tmWrongA "${mp}keyexists" "${mp}key" 0] ; # {} + + test graph-${impl}-${setimpl}-${e}-keyexists-1.1 "$e keyexists, wrong # args, missing" !graph { + SETUP + catch {CMD keyexists a} msg + mygraph destroy + set msg + } [tmWrongA "${mp}keyexists" "${mp}key" 1] ; # {} + + test graph-${impl}-${setimpl}-${e}-keyexists-1.2 "$e keyexists, wrong # args, too many" { + SETUP + catch {CMD keyexists a b c} msg + mygraph destroy + set msg + } [tmTooManyA "${mp}keyexists" "${mp}key"] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-keyexists-2.0 "$e keyexists, missing $e" !graph { + SETUP + catch {Keyexists$ex foo} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-keyexists-3.0 "$e keyexists, no attributes" { + SETUP + $ex + set result [Keyexists$ex bogus] + mygraph destroy + set result + } 0 ; # {} + + test graph-${impl}-${setimpl}-${e}-keyexists-3.1 "$e keyexists, missing key" { + SETUP + $ex + SetW$ex ok "" + set result [Keyexists$ex bogus] + mygraph destroy + set result + } 0 ; # {} + + test graph-${impl}-${setimpl}-${e}-keyexists-3.2 "$e keyexists, existing key" { + SETUP + $ex + SetW$ex ok "" + set result [Keyexists$ex ok] + mygraph destroy + set result + } 1 ; # {} +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/keys.test b/tcllib/modules/struct/graph/tests/attr/keys.test new file mode 100644 index 0000000..e80c445 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/keys.test @@ -0,0 +1,79 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node keys (attribute keys) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: keys.test,v 1.3 2008/03/07 06:51:39 andreas_kupries Exp $ + +# Syntax: graph keys ?PATTERN? +# Syntax: graph arc keys ARC ?PATTERN? +# Syntax: graph node keys NODE ?PATTERN? + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + AttrSetup + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-keys-1.0 "$e keys, wrong # args, missing" !graph { + SETUP + catch {CMD keys} msg + mygraph destroy + set msg + } [tmWrongA "${mp}keys" "${mp}?pattern?" 0] ; # {} + + test graph-${impl}-${setimpl}-${e}-keys-1.1 "$e keys, wrong # args, too many" { + SETUP + catch {CMD keys a b c} msg + mygraph destroy + set msg + } [tmTooManyA "${mp}keys" "${mp}?pattern?"] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-keys-2.0 "$e keys, missing $e" !graph { + SETUP + catch {Keys$ex} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-keys-3.0 "$e keys, no attributes, empty list result" { + SETUP + $ex + set results [Keys$ex] + mygraph destroy + set results + } {} + + test graph-${impl}-${setimpl}-${e}-keys-3.1 "$e keys, list result" { + SETUP + $ex + SetW$ex data foobar + SetW$ex other thing + set results [Keys$ex] + mygraph destroy + lsort $results + } {data other} + + test graph-${impl}-${setimpl}-${e}-keys-3.2 "$e keys, pattern match" { + SETUP + $ex + SetW$ex data foobar + SetW$ex other thing + set results [KeysP$ex d*] + mygraph destroy + set results + } data +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/lappend.test b/tcllib/modules/struct/graph/tests/attr/lappend.test new file mode 100644 index 0000000..df3e5ab --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/lappend.test @@ -0,0 +1,88 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node lappend (attribute lappend) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: lappend.test,v 1.3 2008/03/07 06:51:39 andreas_kupries Exp $ + +# Syntax: graph lappend KEY VALUE +# Syntax: graph arc lappend ARC KEY VALUE +# Syntax: graph node lappend NODE KEY VALUE + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + AttrSetup + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-lappend-1.0 "$e lappend, wrong#args, missing" { + SETUP + catch {CMD lappend} msg + mygraph destroy + set msg + } [tmWrongA "${mp}lappend" "${mp}key value" 0] ; # {} + + test graph-${impl}-${setimpl}-${e}-lappend-1.1 "$e lappend, wrong#args, missing" { + SETUP + catch {CMD lappend a} msg + mygraph destroy + set msg + } [tmWrongA "${mp}lappend" "${mp}key value" 1] ; # {} + + test graph-${impl}-${setimpl}-${e}-lappend-1.2 "$e lappend, wrong#args, missing" !graph { + SETUP + catch {CMD lappend a b} msg + mygraph destroy + set msg + } [tmWrongA "${mp}lappend" "${mp}key value" 2] ; # {} + + test graph-${impl}-${setimpl}-${e}-lappend-1.3 "$e lappend, wrong#args, too many" { + SETUP + catch {CMD lappend a b c d} msg + mygraph destroy + set msg + } [tmTooManyA "${mp}lappend" "${mp}key value"] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-lappend-2.0 "$e lappend, missing $e" !graph { + SETUP + catch {Lappend$ex data foo} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-lappend-3.0 "$e lappend, no attribute, created" { + SETUP + $ex + set result {} + lappend result [Keyexists$ex data] + lappend result [Lappend$ex data bar] + lappend result [Keyexists$ex data] + lappend result [Get$ex data] + mygraph destroy + set result + } {0 bar 1 bar} ; # {} + + test graph-${impl}-${setimpl}-${e}-lappend-3.1 "$e lappend, existing attribute, appending" { + SETUP + $ex + set result {} + lappend result [SetW$ex data foo] + lappend result [Lappend$ex data bar] + lappend result [Get$ex data] + mygraph destroy + set result + } {foo {foo bar} {foo bar}} ; # {} +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/set.test b/tcllib/modules/struct/graph/tests/attr/set.test new file mode 100644 index 0000000..626404e --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/set.test @@ -0,0 +1,97 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node set (attribute set) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: set.test,v 1.3 2008/03/07 06:51:39 andreas_kupries Exp $ + +# Syntax: graph set KEY ?VALUE? +# Syntax: graph arc set ARC KEY ?VALUE? +# Syntax: graph node set NODE KEY ?VALUE? + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + AttrSetup + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-set-1.0 "$e set, wrong # args, missing" { + SETUP + catch {CMD set} msg + mygraph destroy + set msg + } [tmWrongA "${mp}set" "${mp}key ?value?" 0 "${mp}key args"] ; # {} + + test graph-${impl}-${setimpl}-${e}-set-1.1 "$e set, wrong # args, missing" !graph { + SETUP + catch {CMD set a} msg + mygraph destroy + set msg + } [tmWrongA "${mp}set" "${mp}key ?value?" 1 "${mp}key args"] ; # {} + + test graph-${impl}-${setimpl}-${e}-set-1.2 "$e set, wrong # args, too many" { + SETUP + catch {CMD set a b c d} msg + mygraph destroy + set msg + } [tmE \ + "wrong # args: should be \"$MY ${mp}set ${mp}key ?value?\"" \ + [tmTooManyA "${mp}set" "${mp}key ?value?"]] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-set-2.0 "$e set, missing $e" !graph { + SETUP + catch {CMD set x data} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + test graph-${impl}-${setimpl}-${e}-set-2.1 "$e set, no attributes (retrieval)" { + SETUP + $ex + catch {SetR$ex foo} msg + mygraph destroy + set msg + } [MissingKey $mk $e foo] ; # {} + + test graph-${impl}-${setimpl}-${e}-set-2.2 "$e set, missing key (retrieval)" { + SETUP + $ex + SetW$ex data "" + catch {SetR$ex foo} msg + mygraph destroy + set msg + } [MissingKey $mk $e foo] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-set-3.0 "$e set, set value, result" { + SETUP + $ex + set result {} + lappend result [SetW$ex baz foobar] + lappend result [Get$ex baz] + mygraph destroy + set result + } {foobar foobar} ; # {} + + test graph-${impl}-${setimpl}-${e}-set-3.1 "$e set, retrieve value" { + SETUP + $ex + SetW$ex baz foobar + + set result [SetR$ex baz] + mygraph destroy + set result + } foobar ; # {} +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/attr/unset.test b/tcllib/modules/struct/graph/tests/attr/unset.test new file mode 100644 index 0000000..1a79440 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/attr/unset.test @@ -0,0 +1,115 @@ +# -*- tcl -*- +# Graph tests - graph/arc/node unset (attribute unset) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: unset.test,v 1.3 2008/03/07 06:51:39 andreas_kupries Exp $ + +# Syntax: graph unset KEY +# Syntax: graph arc unset ARC KEY +# Syntax: graph node unset NODE KEY + +# ------------------------------------------------------------------------- + +proc Arc {} {mygraph node insert 0 1 ; mygraph arc insert 0 1 x} +proc Node {} {mygraph node insert x} + +# ------------------------------------------------------------------------- + +foreach {e ex stem mp mk} { + arc Arc {mygraph arc} {arc } x + node Node {mygraph node} {node } x + graph Graph {mygraph} {} {} +} { + if {$mk == {}} {set mk $MY} + # CMD = stem, remove existing CMD + catch {interp alias {} CMD {}} + eval [linsert $stem 0 interp alias {} CMD {}] + # To skip tests which do not apply to graph attributes + ::tcltest::testConstraint graph [string equal $e graph] + + # CMD is for the testing of wrong#args errors. + # XXX$ex are for regular tests, i.e. argument + # errors and ok behaviour. + + # ------------------------------------------------------------------------- + # Wrong # args: Missing, Too many + + test graph-${impl}-${setimpl}-${e}-unset-1.0 "$e unset, wrong # args, missing" { + SETUP + catch {CMD unset} msg + mygraph destroy + set msg + } [tmWrongA "${mp}unset" "${mp}key" 0] ; # {} + + test graph-${impl}-${setimpl}-${e}-unset-1.1 "$e unset, wrong # args, missing" !graph { + SETUP + catch {CMD unset a} msg + mygraph destroy + set msg + } [tmWrongA "${mp}unset" "${mp}key" 1] ; # {} + + test graph-${impl}-${setimpl}-${e}-unset-1.2 "$e unset, wrong # args, too many" { + SETUP + catch {CMD unset a b c} msg + mygraph destroy + set msg + } [tmTooManyA "${mp}unset" "${mp}key"] ; # {} + + # ------------------------------------------------------------------------- + # Logical arguments checks and failures + + test graph-${impl}-${setimpl}-${e}-unset-2.0 "$e unset, missing $e" !graph { + SETUP + catch {Unset$ex data} msg + mygraph destroy + set msg + } [Missing$ex $MY x] ; # {} + + # ------------------------------------------------------------------------- + # Ok arguments. + + test graph-${impl}-${setimpl}-${e}-unset-3.0 "$e unset, no attributes, ok" { + SETUP + $ex + set result [list [catch {Unset$ex bogus} msg] $msg] + mygraph destroy + set result + } {0 {}} ; # {} + + test graph-${impl}-${setimpl}-${e}-unset-3.1 "$e unset, missing key, ok" { + SETUP + $ex + SetW$ex foo "" + set result [list [catch {Unset$ex bogus} msg] $msg] + mygraph destroy + set result + } {0 {}} ; # {} + + test graph-${impl}-${setimpl}-${e}-unset-3.2 "$e unset, data is gone" { + SETUP + $ex + set result {} + lappend result [Keyexists$ex foobar] + SetW$ex foobar foobar + lappend result [Keyexists$ex foobar] + Unset$ex foobar + lappend result [Keyexists$ex foobar] + mygraph destroy + set result + } {0 1 0} ; # {} + + test graph-${impl}-${setimpl}-${e}-unset-3.6 "$e unset, then $e delete" !graph { + SETUP + $ex + set result {} + + mygraph $e set x foo bar + mygraph $e unset x foo + mygraph $e delete x + set result [mygraph $e exists x] + mygraph destroy + set result + } 0 ; # {} +} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/command.test b/tcllib/modules/struct/graph/tests/command.test new file mode 100644 index 0000000..67121b9 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/command.test @@ -0,0 +1,161 @@ +# -*- tcl -*- +# Graph tests - graph command basics +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: command.test,v 1.7 2009/11/26 04:42:16 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +# Graph class command has no missing arguments, will auto-generate +# instance name. As for too many arguments, this will be checked as +# part of testing the de-serialization. + +test graph-${impl}-${setimpl}-create-1.1 {graph create, copy, wrong#args, missing} { + catch {mygraph destroy} + catch {struct::graph mygraph =} result + set result +} {wrong # args: should be "struct::graph ?name ?=|:=|as|deserialize source??"} + +test graph-${impl}-${setimpl}-create-1.2 {graph create, copy, wrong#args, too many} { + catch {mygraph destroy} + catch {struct::graph mygraph = a b} result + set result +} {wrong # args: should be "struct::graph ?name ?=|:=|as|deserialize source??"} + +test graph-${impl}-${setimpl}-create-1.3 {graph create, copy, unknown operator} { + catch {mygraph destroy} + catch {struct::graph mygraph foo a} result + set result +} {wrong # args: should be "struct::graph ?name ?=|:=|as|deserialize source??"} + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-create-2.0 {graph create, duplicate, graph} { + SETUP + catch {struct::graph mygraph} msg + mygraph destroy + set msg +} "command \"::mygraph\" already exists, unable to create graph" + +test graph-${impl}-${setimpl}-create-2.1 {graph create, duplicate, non-graph} { + catch {struct::graph set} msg + set msg +} "command \"::set\" already exists, unable to create graph" + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-create-3.0 {graph create, object command is created} { + SETUP + set result [string equal [info commands ::mygraph] "::mygraph"] + mygraph destroy + set result +} 1 + +test graph-${impl}-${setimpl}-create-3.1 {graph create, auto-generation of name} { + set name [struct::graph] + set result [list \ + [string match ::graph* $name] \ + [string equal [info commands $name] "$name"]] + $name destroy + set result +} {1 1} + +test graph-${impl}-${setimpl}-create-3.2 {graph create, destroy removes object command} { + SETUP + mygraph destroy + string equal [info commands ::mygraph] "" +} 1 + +test graph-${impl}-${setimpl}-create-3.3 {graph create, copy, value} { + catch {mygraph destroy} + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + + struct::graph mygraph deserialize $serial + set result [validate_serial mygraph $serial] + mygraph destroy + + set result +} ok + +test graph-${impl}-${setimpl}-create-3.4 {graph create, copy, graph} { + catch {mygraph destroy} + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + + struct::graph mygraph deserialize $serial + struct::graph bgraph = mygraph + + set result [validate_serial bgraph $serial] + mygraph destroy + bgraph destroy + + set result +} ok + +test graph-${impl}-${setimpl}-create-3.5 {graph create, copy, graph with weights} { + catch {mygraph destroy} + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {} 222}} %1 {} {{d 9 {}}} %2 {} {{e 0 {} 444}} {data foo}} + + struct::graph mygraph deserialize $serial + struct::graph bgraph = mygraph + + set result [validate_serial bgraph $serial] + mygraph destroy + bgraph destroy + + set result +} ok + +test graph-${impl}-${setimpl}-create-3.6 {graph create, copy, empty graph} { + catch {mygraph destroy} + set serial {{}} + + struct::graph mygraph deserialize $serial + struct::graph bgraph = mygraph + + set result [validate_serial bgraph $serial] + mygraph destroy + bgraph destroy + + set result +} ok + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-instance-1.0 {graph command, wrong#args, missing} { + SETUP + catch {mygraph} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY option ?arg arg ...?\"" + +# Too many arguments dependent on method, not testable here. + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-instance-2.0 {graph command, bad method} { + SETUP + catch {mygraph foo} msg + mygraph destroy + set msg +} {bad option "foo": must be -->, =, append, arc, arcs, deserialize, destroy, get, getall, keyexists, keys, lappend, node, nodes, serialize, set, swap, unset, or walk} + +test graph-${impl}-${setimpl}-instance-2.1 {graph arc command, bad method} { + SETUP + catch {mygraph arc foo} msg + mygraph destroy + set msg +} {bad option "foo": must be append, attr, delete, exists, flip, get, getall, getunweighted, getweight, hasweight, insert, keyexists, keys, lappend, move, move-source, move-target, nodes, rename, set, setunweighted, setweight, source, target, unset, unsetweight, or weights} + +test graph-${impl}-${setimpl}-instance-2.2 {graph node command, bad method} { + SETUP + catch {mygraph node foo} msg + mygraph destroy + set msg +} {bad option "foo": must be append, attr, degree, delete, exists, get, getall, insert, keyexists, keys, lappend, opposite, rename, set, or unset} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/deserialize.test b/tcllib/modules/struct/graph/tests/deserialize.test new file mode 100644 index 0000000..b6cc895 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/deserialize.test @@ -0,0 +1,209 @@ +# -*- tcl -*- +# Graph tests - deserialize +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: deserialize.test,v 1.3 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph deserialize SERIALIZATION + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-deserialize-1.0 {deserialize, wrong #args, missing} { + SETUP + catch {mygraph deserialize} result + mygraph destroy + set result +} [tmWrong deserialize serial 0] + +test graph-${impl}-${setimpl}-deserialize-1.1 {deserialize, wrong #args, to many} { + SETUP + catch {mygraph deserialize foo bar} result + mygraph destroy + set result +} [tmTooMany deserialize serial] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-deserialize-2.0 {deserialize, incorrect length} { + SETUP + set serial {. %3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: list length not 1 mod 3.}} + +test graph-${impl}-${setimpl}-deserialize-2.1 {deserialize, attributes, graph, !dict} { + SETUP + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data . foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: malformed graph attribute dictionary.}} + +test graph-${impl}-${setimpl}-deserialize-2.2 {deserialize, attributes, node, !dict} { + SETUP + set serial {%3 {.} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: malformed node attribute dictionary.}} + +test graph-${impl}-${setimpl}-deserialize-2.3 {deserialize, attributes, arc, !dict} { + SETUP + set serial {%3 {} {{f 6 {.}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: malformed arc attribute dictionary.}} + +test graph-${impl}-${setimpl}-deserialize-2.4 {deserialize, duplicate arcs} { + SETUP + set serial {%3 {} {{a 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: duplicate definition of arc "a".}} + +test graph-${impl}-${setimpl}-deserialize-2.5 {deserialize, non-numeric node-reference} { + SETUP + set serial {%3 {} {{f . {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: bad arc destination reference ".".}} + +test graph-${impl}-${setimpl}-deserialize-2.6 {deserialize, incorrect node-reference, not 0 mod 3} { + SETUP + set serial {%3 {} {{f 2 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: bad arc destination reference "2".}} + +test graph-${impl}-${setimpl}-deserialize-2.7 {deserialize, out-of-range node-reference, lower bound} { + SETUP + set serial {%3 {} {{f -2 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: bad arc destination reference "-2".}} + +test graph-${impl}-${setimpl}-deserialize-2.8 {deserialize, out-of-range node-reference, upper bound} { + SETUP + set serial {%3 {} {{f 14 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: bad arc destination reference "14".}} + +test graph-${impl}-${setimpl}-deserialize-2.9 {deserialize, duplicate nodes} { + SETUP + set serial {%1 {foo bar} {{a 3 {}} {c 6 {}}} %1 {} {} %3 {} {{f 3 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: duplicate node names.}} + +test graph-${impl}-${setimpl}-deserialize-2.10 {deserialize, wrong arc information length, missing} { + SETUP + set serial {%3 {} {{f 6}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: arc information length not 3 or 4.}} + +test graph-${impl}-${setimpl}-deserialize-2.11 {deserialize, wrong arc information length, too many} { + SETUP + set serial {%3 {} {{f 6 {. .} _weight_ toomuch}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set fail [catch {mygraph deserialize $serial} result] + mygraph destroy + list $fail $result +} {1 {error in serialization: arc information length not 3 or 4.}} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-deserialize-3.0 {deserialize, empty graph} { + SETUP + set serial {{}} + mygraph deserialize $serial + set result [validate_serial mygraph $serial] + mygraph destroy + set result +} ok + +test graph-${impl}-${setimpl}-deserialize-3.1 {deserialize} { + SETUP + + # Our check of the success of the deserialize + # is to validate the generated graph against the + # serialized data. + + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + + set result [list] + lappend result [validate_serial mygraph $serial] + + mygraph deserialize $serial + lappend result [validate_serial mygraph $serial] + + mygraph destroy + set result +} {attr/graph/data-mismatch ok} + +test graph-${impl}-${setimpl}-deserialize-3.2 {deserialize} { + SETUP + + # Our check of the success of the deserialize + # is to validate the generated graph against the + # serialized data. + + # Applying to serialization one after the + # other. Checking that the second operation + # completely squashes the data from the first. + + set seriala {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + set serialb {%0 {foo bar} {{a 3 {}} {c 6 {}}} %1 {} {} %3 {} {{f 3 {}}} {data foo}} + + set result [list] + lappend result [validate_serial mygraph $seriala] + lappend result [validate_serial mygraph $serialb] + + mygraph deserialize $seriala + lappend result [validate_serial mygraph $seriala] + lappend result [validate_serial mygraph $serialb] + + mygraph deserialize $serialb + lappend result [validate_serial mygraph $seriala] + lappend result [validate_serial mygraph $serialb] + + mygraph destroy + set result +} [list \ + attr/graph/data-mismatch attr/graph/data-mismatch \ + ok nodes/mismatch/#nodes \ + arc/b/unknown ok] + + +test graph-${impl}-${setimpl}-deserialize-3.3 {deserialize, weights} { + SETUP + + # Our check of the success of the deserialize + # is to validate the generated graph against the + # serialized data. + + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {} 333} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {} 888}} %2 {} {{e 0 {}}} {data foo}} + + set result [list] + lappend result [validate_serial mygraph $serial] + + mygraph deserialize $serial + lappend result [validate_serial mygraph $serial] + + mygraph destroy + set result +} {attr/graph/data-mismatch ok} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/node/attr.test b/tcllib/modules/struct/graph/tests/node/attr.test new file mode 100644 index 0000000..fab276e --- /dev/null +++ b/tcllib/modules/struct/graph/tests/node/attr.test @@ -0,0 +1,97 @@ +# -*- tcl -*- +# Graph tests - node attr +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: attr.test,v 1.2 2007/04/12 03:01:56 andreas_kupries Exp $ + +# Syntax: graph node attr KEY ?-nodes NODESLIST|-glob PATTERN|-regexp PATTERN? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-node-attr-1.0 {node attr, wrong#args, missing} { + SETUPx + catch {mygraph node attr} msg + mygraph destroy + set msg +} [tmWrong {node attr} {key ?-nodes list|-glob pattern|-regexp pattern?} 0 {key args}] + +test graph-${impl}-${setimpl}-node-attr-1.1 {node attr, wrong#args, missing} { + SETUPx + catch {mygraph node attr a b} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY node attr key ?-nodes list|-glob pattern|-regexp pattern?\"" + +test graph-${impl}-${setimpl}-node-attr-1.2 {node attr, wrong#args, too many} { + SETUPx + catch {mygraph node attr a b c d} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY node attr key ?-nodes list|-glob pattern|-regexp pattern?\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-node-attr-2.0 {node attr, bogus switch} { + SETUPx + catch {mygraph node attr a -foo barf} msg + mygraph destroy + set msg +} {bad type "-foo": must be -glob, -nodes, or -regexp} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-node-attr-3.4 {node attr, unfiltered, nothing} { + SETUPx + set result [mygraph node attr vol] + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-node-attr-3.5 {node attr, unfiltered something} { + SETUPx + set result [dictsort [mygraph node attr volume]] + mygraph destroy + set result +} {%0 30 %5 50} + +test graph-${impl}-${setimpl}-node-attr-3.6 {node attr, filtered -nodes} { + SETUPx + set result [mygraph node attr volume -nodes {%0 %3}] + mygraph destroy + set result +} {%0 30} + +test graph-${impl}-${setimpl}-node-attr-3.7 {node attr, filtered -glob} { + SETUPx + set result [mygraph node attr volume -glob {%[0-3]}] + mygraph destroy + set result +} {%0 30} + +test graph-${impl}-${setimpl}-node-attr-3.8 {node attr, filtered regexp} { + SETUPx + set result [mygraph node attr volume -regexp {[0-3]}] + mygraph destroy + set result +} {%0 30} + +test graph-${impl}-${setimpl}-node-attr-3.9 {node attr, filtered -nodes nothing} { + SETUPx + set result [mygraph node attr volume -nodes {}] + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-node-attr-3.10 {node attr, nothing} { + SETUPx + mygraph node unset %0 volume + mygraph node unset %5 volume + set result [mygraph node attr volume] + mygraph destroy + set result +} {} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/node/degree.test b/tcllib/modules/struct/graph/tests/node/degree.test new file mode 100644 index 0000000..cca0ce5 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/node/degree.test @@ -0,0 +1,87 @@ +# -*- tcl -*- +# Graph tests - node degree +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: degree.test,v 1.2 2007/04/12 03:01:56 andreas_kupries Exp $ + +# Syntax: graph node degree ?-in|-out? NODE + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-node-degree-1.0 {node degree, wrong#args, missing} { + SETUP + catch {mygraph node degree} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY node degree ?-in|-out? node\"" + +test graph-${impl}-${setimpl}-node-degree-1.1 {node degree, wrong#args, too many} { + SETUP + catch {mygraph node degree foo bar baz} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY node degree ?-in|-out? node\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-node-degree-2.0 {node degree, missing node} { + SETUP + catch {mygraph node degree node0} msg + mygraph destroy + set msg +} [MissingNode $MY node0] + +test graph-${impl}-${setimpl}-node-degree-2.1 {node degree, bad switch} { + SETUP + catch {mygraph node degree -foo node0} msg + mygraph destroy + set msg +} "bad option \"-foo\": must be -in or -out" + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-node-degree-3.0 {node degree} { + SETUP + mygraph node insert node0 node1 node2 node3 node4 node5 + + mygraph arc insert node1 node2 arc0 + mygraph arc insert node3 node3 arc1 + mygraph arc insert node4 node5 arc2 + mygraph arc insert node4 node5 arc3 + mygraph arc insert node4 node5 arc4 + mygraph arc insert node5 node2 arc5 + + set result {} + lappend result node0 - + lappend result [mygraph node degree node0] + lappend result [mygraph node degree -in node0] + lappend result [mygraph node degree -out node0] + lappend result node1 - + lappend result [mygraph node degree node1] + lappend result [mygraph node degree -in node1] + lappend result [mygraph node degree -out node1] + lappend result node2 - + lappend result [mygraph node degree node2] + lappend result [mygraph node degree -in node2] + lappend result [mygraph node degree -out node2] + lappend result node3 - + lappend result [mygraph node degree node3] + lappend result [mygraph node degree -in node3] + lappend result [mygraph node degree -out node3] + lappend result node4 - + lappend result [mygraph node degree node4] + lappend result [mygraph node degree -in node4] + lappend result [mygraph node degree -out node4] + lappend result node5 - + lappend result [mygraph node degree node5] + lappend result [mygraph node degree -in node5] + lappend result [mygraph node degree -out node5] + + mygraph destroy + set result +} {node0 - 0 0 0 node1 - 1 0 1 node2 - 2 2 0 node3 - 2 1 1 node4 - 3 0 3 node5 - 4 3 1} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/node/delete.test b/tcllib/modules/struct/graph/tests/node/delete.test new file mode 100644 index 0000000..56a92d3 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/node/delete.test @@ -0,0 +1,88 @@ +# -*- tcl -*- +# Graph tests - node deletion +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: delete.test,v 1.2 2007/04/12 03:01:56 andreas_kupries Exp $ + +# Syntax: graph node delete NODE NODE... + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-node-delete-1.0 {node delete, wrong#args, missing} { + SETUP + catch {mygraph node delete} msg + mygraph destroy + set msg +} [tmE {wrong # args: should be "::struct::graph::__node_delete name node node..."} \ + {wrong # args: should be "mygraph node delete node node..."}] + +# Cannot use tmWrong, will be incorrect for the Tcl implementation +# run by a pre-8.4 core. +# [tmWrong {node delete} {node node...} 0] + +# Impossible to have too many arguments +# Any number of nodes is acceptable. + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-node-delete-2.0 {node delete, missing node} { + SETUP + catch {mygraph node delete node0} msg + mygraph destroy + set msg +} [MissingNode $MY node0] + +# ------------------------------------------------------------------------- +# Ok arguments, single, multiple deletion. + +test graph-${impl}-${setimpl}-node-delete-3.0 {node delete, single} { + SETUP + mygraph node insert node0 + set res {} + + lappend res [mygraph node exists node0] + lappend res [mygraph node delete node0] + lappend res [mygraph node exists node0] + + mygraph destroy + set res +} {1 {} 0} + +test graph-${impl}-${setimpl}-node-delete-3.1 {node delete, multiple at once} { + SETUP + mygraph node insert node0 node1 node2 node3 + set res {} + + lappend res [mygraph node exists node0] + lappend res [mygraph node exists node1] + lappend res [mygraph node exists node2] + lappend res [mygraph node exists node3] + lappend res [mygraph node delete node0 node1 node2 node3] + lappend res [mygraph node exists node0] + lappend res [mygraph node exists node1] + lappend res [mygraph node exists node2] + lappend res [mygraph node exists node3] + + mygraph destroy + set res +} {1 1 1 1 {} 0 0 0 0} + +test graph-${impl}-${setimpl}-node-delete-3.2 {node delete, deleting adjacent arcs} { + SETUP + mygraph node insert node0 node1 node2 + mygraph arc insert node0 node1 arc0 + mygraph arc insert node1 node2 arc1 + + mygraph node delete node1 + + set result {} + lappend result [mygraph arc exists arc0] + lappend result [mygraph arc exists arc1] + + mygraph destroy + set result +} {0 0} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/node/exists.test b/tcllib/modules/struct/graph/tests/node/exists.test new file mode 100644 index 0000000..47d8ef2 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/node/exists.test @@ -0,0 +1,46 @@ +# -*- tcl -*- +# Graph tests - node existence +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: exists.test,v 1.2 2007/04/12 03:01:56 andreas_kupries Exp $ + +# Syntax: graph node exists NODE + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-node-exists-1.0 {node exists, wrong#args, missing} { + SETUP + catch {mygraph node exists} msg + mygraph destroy + set msg +} [tmWrong {node exists} node 0] + +test graph-${impl}-${setimpl}-node-exists-1.1 {node exists, wrong#args, too many} { + SETUP + catch {mygraph node exists 0 1} msg + mygraph destroy + set msg +} [tmTooMany {node exists} node] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-node-exists-2.0 {node exists} { + SETUP + set res {} + lappend res [mygraph node exists node1] + + mygraph node insert node1 + + lappend res [mygraph node exists node1] + + mygraph node delete node1 + + lappend res [mygraph node exists node1] + + mygraph destroy + set res +} {0 1 0} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/node/insert.test b/tcllib/modules/struct/graph/tests/node/insert.test new file mode 100644 index 0000000..6fa748e --- /dev/null +++ b/tcllib/modules/struct/graph/tests/node/insert.test @@ -0,0 +1,67 @@ +# -*- tcl -*- +# Graph tests - node insertion +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: insert.test,v 1.2 2007/04/12 03:01:56 andreas_kupries Exp $ + +# Syntax: graph node insert ?NODE...? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +# Impossible to have to have missing or too many arguments. +# Any number of new nodes is acceptable. + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-node-insert-2.0 {node insert, duplicate node} { + SETUP + mygraph node insert node0 + catch {mygraph node insert node0} msg + mygraph destroy + set msg +} [ExistingNode $MY node0] + +# ------------------------------------------------------------------------- +# Ok arguments. None, single, multiple, defaults + +test graph-${impl}-${setimpl}-node-insert-3.0 {node insert, defaults} { + SETUP + mygraph node insert node0 + set result {} + lappend result [mygraph node exists node0] + lappend result [mygraph node getall node0] + lappend result [mygraph nodes -out node0] + lappend result [mygraph nodes -in node0] + mygraph destroy + set result +} {1 {} {} {}} + +test graph-${impl}-${setimpl}-node-insert-3.1 {node insert, auto-generation of name} { + SETUP + + # Note: The use of 'node3' for the explicit name tests that the + # name-generator will skip over existing names when it tries to + # come up with a new one. + + set result {} + lappend result [mygraph node insert] + lappend result [mygraph node insert] + mygraph node insert node3 + lappend result [mygraph node insert] + mygraph destroy + set result +} {node1 node2 node4} + +test graph-${impl}-${setimpl}-node-insert-3.2 {node insert, multiple} { + SETUP + mygraph node insert node0 node1 + set result {} + lappend result [mygraph node exists node0] + lappend result [mygraph node exists node1] + mygraph destroy + set result +} {1 1} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/node/opposite.test b/tcllib/modules/struct/graph/tests/node/opposite.test new file mode 100644 index 0000000..71b8aec --- /dev/null +++ b/tcllib/modules/struct/graph/tests/node/opposite.test @@ -0,0 +1,88 @@ +# -*- tcl -*- +# Graph tests - node opposite +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: opposite.test,v 1.2 2007/04/12 03:01:56 andreas_kupries Exp $ + +# Syntax: graph node opposite NODE ARC + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-node-opposite-1.0 {node opposite, wrong#args, missing} { + SETUP + catch {mygraph node opposite} msg + mygraph destroy + set msg +} [tmWrong {node opposite} {node arc} 0] + +test graph-${impl}-${setimpl}-node-opposite-1.1 {node opposite, wrong#args, missing} { + SETUP + catch {mygraph node opposite 0} msg + mygraph destroy + set msg +} [tmWrong {node opposite} {node arc} 1] + +test graph-${impl}-${setimpl}-node-opposite-1.2 {node opposite, wrong#args, too many} { + SETUP + catch {mygraph node opposite 0 1 2} msg + mygraph destroy + set msg +} [tmTooMany {node opposite} {node arc}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-node-opposite-2.1 {node opposite, missing node} { + SETUP + catch {mygraph node opposite node0 arc0} msg + mygraph destroy + set msg +} [MissingNode $MY node0] + +test graph-${impl}-${setimpl}-node-opposite-2.2 {node opposite, missing arc} { + SETUP + mygraph node insert node0 + catch {mygraph node opposite node0 arc0} msg + mygraph destroy + set msg +} [MissingArc $MY arc0] + +test graph-${impl}-${setimpl}-node-opposite-2.3 {node opposite, !adjacent node/arc} { + SETUP + mygraph node insert node0 node1 node2 + mygraph arc insert node1 node2 arc0 + + catch {mygraph node opposite node0 arc0} msg + mygraph destroy + set msg +} "node \"node0\" and arc \"arc0\" are not connected in graph \"$MY\"" + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-node-opposite-3.0 {node opposite, source|target} { + SETUP + mygraph node insert node0 node1 + mygraph arc insert node0 node1 arc0 + + set result {} + lappend result [mygraph node opposite node0 arc0] + lappend result [mygraph node opposite node1 arc0] + + mygraph destroy + set result +} {node1 node0} + +test graph-${impl}-${setimpl}-node-opposite-3.1 {node opposite, loop} { + SETUP + mygraph node insert node0 + mygraph arc insert node0 node0 arc0 + + set result [mygraph node opposite node0 arc0] + + mygraph destroy + set result +} {node0} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/node/rename.test b/tcllib/modules/struct/graph/tests/node/rename.test new file mode 100644 index 0000000..f9d2cdd --- /dev/null +++ b/tcllib/modules/struct/graph/tests/node/rename.test @@ -0,0 +1,106 @@ +# -*- tcl -*- +# Graph tests - node rename +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: rename.test,v 1.2 2007/04/12 03:01:56 andreas_kupries Exp $ + +# Syntax: graph node rename NODE NEW-NAME + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-node-rename-1.0 {node rename, wrong # args, missing} { + SETUP + catch {mygraph node rename} result + mygraph destroy + set result +} [tmWrong {node rename} {node newname} 0] + +test graph-${impl}-${setimpl}-node-rename-1.1 {node rename, wrong # args, missing} { + SETUP + catch {mygraph node rename foo} result + mygraph destroy + set result +} [tmWrong {node rename} {node newname} 1] + +test graph-${impl}-${setimpl}-node-rename-1.2 {node rename, wrong # args, too many} { + SETUP + catch {mygraph node rename foo far fox} result + mygraph destroy + set result +} [tmTooMany {node rename} {node newname}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-node-rename-2.0 {node rename, missing node} { + SETUP + catch {mygraph node rename 0 foo} result + mygraph destroy + set result +} [MissingNode $MY 0] + +test graph-${impl}-${setimpl}-node-rename-2.1 {node rename, duplicate target node} { + SETUP + mygraph node insert root 0 + catch {mygraph node rename root 0} result + mygraph destroy + set result +} [ExistingNode $MY 0] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-node-rename-3.0 {node rename, arc linkage} { + SETUP + + mygraph node insert 0 1 2 3 4 5 6 + mygraph arc insert 1 0 a + mygraph arc insert 2 0 b + mygraph arc insert 3 0 c + mygraph arc insert 0 4 d + mygraph arc insert 0 5 e + mygraph arc insert 0 6 f + + + set result {} + lappend result [mygraph node degree -in 0] + lappend result [mygraph node degree -out 0] + lappend result [mygraph node exists 0] + lappend result [mygraph node exists snarf] + lappend result [lsort [mygraph nodes -in 0]] + lappend result [lsort [mygraph nodes -out 0]] + + mygraph node rename 0 snarf + lappend result | + + lappend result [mygraph node degree -in snarf] + lappend result [mygraph node degree -out snarf] + lappend result [mygraph node exists 0] + lappend result [mygraph node exists snarf] + lappend result [lsort [mygraph nodes -in snarf]] + lappend result [lsort [mygraph nodes -out snarf]] + + mygraph destroy + set result +} {3 3 1 0 {1 2 3} {4 5 6} | 3 3 0 1 {1 2 3} {4 5 6}} + +test graph-${impl}-${setimpl}-node-rename-3.1 {node rename, attribute transfer} { + SETUP + mygraph node insert 0 + mygraph node set 0 data foo + + set result {} + lappend result [mygraph node getall 0] + lappend result [catch {mygraph node getall 5}] + + mygraph node rename 0 5 + + lappend result [mygraph node getall 5] + lappend result [catch {mygraph node getall 0}] + + mygraph destroy + set result +} {{data foo} 1 {data foo} 1} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/nodes.test b/tcllib/modules/struct/graph/tests/nodes.test new file mode 100644 index 0000000..4934073 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/nodes.test @@ -0,0 +1,313 @@ +# -*- tcl -*- +# Graph tests - nodes +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: nodes.test,v 1.3 2008/03/23 19:08:26 andreas_kupries Exp $ + +# Syntax: graph nodes +# (1) graph nodes -key KEY +# graph nodes -key KEY -value VALUE +# (2) graph nodes -filter CMDPREFIX +# (3) graph nodes -in NODE... +# graph nodes -out NODE... +# graph nodes -adj NODE... +# graph nodes -inner NODE... +# graph nodes -embedded NODE... + +# We can use one in each group (1,2,3) + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +# Cannot have missing arguments (zero is fine), +# except when switches are in use. That however +# is tested with the switches. Ditto for too many +# arguments. + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-nodes-1.0 {nodes, bad switch} { + SETUP + catch {mygraph nodes -foo} msg + mygraph destroy + set msg +} {bad restriction "-foo": must be -adj, -embedding, -filter, -in, -inner, -key, -out, or -value} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-nodes-2.0 {nodes, empty graph} { + SETUP + set result [mygraph nodes] + mygraph destroy + set result +} {} + +test graph-${impl}-${setimpl}-nodes-2.1 {nodes} { + SETUP + mygraph node insert 0 1 2 3 4 5 + set result [lsort [mygraph nodes]] + mygraph destroy + set result +} {0 1 2 3 4 5} + +# --------------------------------------------------- + +# (1) -key, -value +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-nodes-key-1.0 {nodes, wrong#args, missing} { + SETUP + catch {mygraph nodes -key} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY nodes ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" + +test graph-${impl}-${setimpl}-nodes-key-1.1 {nodes, wrong#args, missing} { + SETUP + catch {mygraph nodes -value} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY nodes ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-nodes-key-2.0 {nodes, multiple -key} { + SETUP + catch {mygraph nodes -key foobar -value 1 -key foo} msg + mygraph destroy + set msg +} {invalid restriction: illegal multiple use of "-key"} + +test graph-${impl}-${setimpl}-nodes-key-2.1 {nodes, multiple -value} { + SETUP + catch {mygraph nodes -key foobar -value 1 -value foo} msg + mygraph destroy + set msg +} {invalid restriction: illegal multiple use of "-value"} + +test graph-${impl}-${setimpl}-nodes-key-2.2 {nodes, -value without -key} { + SETUP + catch {mygraph nodes -value 1} msg + mygraph destroy + set msg +} {invalid restriction: use of "-value" without "-key"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-nodes-key-3.0 {nodes, -key} { + SETUP + mygraph node insert n0 n1 + mygraph node set n0 foobar 1 + mygraph node set n1 blubber 2 + + catch {mygraph nodes -key foobar} msg + mygraph destroy + set msg +} n0 + +test graph-${impl}-${setimpl}-nodes-key-3.1 {nodes, -key, -value} { + SETUP + mygraph node insert n0 n1 + mygraph node set n0 foobar 1 + mygraph node set n1 foobar 2 + + catch {mygraph nodes -key foobar -value 1} msg + mygraph destroy + set msg +} n0 + +# --------------------------------------------------- + +# (2) -filter +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-nodes-filter-1.0 {nodes, wrong#args, missing} { + SETUP + catch {mygraph nodes -filter} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY nodes ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-nodes-filter-2.0 {nodes, multiple -filter} { + SETUP + catch {mygraph nodes -filter foobar -filter foo} msg + mygraph destroy + set msg +} {invalid restriction: illegal multiple use of "-filter"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-nodes-filter-3.0 {nodes, -filter} { + SETUP + + mygraph node insert 1 2 3 4 5 6 + mygraph node set 1 volume 30 + mygraph node set 3 volume 50 + + proc vol {g n} { + $g node keyexists $n volume + } + + set result [lsort [mygraph nodes -filter vol]] + mygraph destroy + rename vol {} + + set result +} {1 3} + +test graph-${impl}-${setimpl}-nodes-filter-3.1 {nodes, -filter} { + SETUP + + mygraph node insert 1 2 3 4 5 6 + mygraph node set 1 volume 30 + mygraph node set 3 volume 50 + + proc vol {g n} { + if {![$g node keyexists $n volume]} {return 0} + expr {[$g node get $n volume] > 40} + } + + set result [mygraph nodes -filter vol] + mygraph destroy + rename vol {} + + set result +} 3 + +# --------------------------------------------------- + +# (3) -in, -out, -adj, -inner, -embedding +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +set n 0 +foreach switch {-in -out -adj -inner -embedding} { + + test graph-${impl}-${setimpl}-nodes-ioaie-1.$n "nodes, $switch, wrong#args, missing" { + SETUP + catch {mygraph nodes $switch} msg + mygraph destroy + set msg + } "wrong # args: should be \"$MY nodes ?-key key? ?-value value? ?-filter cmd? ?-in|-out|-adj|-inner|-embedding node node...?\"" ; # {} + + incr n +} + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +set n 0 +foreach switch {-in -out -adj -inner -embedding} { + + test graph-${impl}-${setimpl}-nodes-ioaie-2.$n "nodes, $switch, missing node" { + SETUP + catch {mygraph nodes $switch x} msg + mygraph destroy + set msg + } [MissingNode $MY x] ; # {} + + incr n + + foreach switchB {-in -out -adj -inner -embedding} { + + test graph-${impl}-${setimpl}-nodes-ioaie-2.$n "nodes, $switch, $switchB together" { + SETUP + catch {mygraph nodes $switch $switchB x} msg + mygraph destroy + set msg + } {invalid restriction: illegal multiple use of "-in"|"-out"|"-adj"|"-inner"|"-embedding"} ; # {} + + incr n + } +} + +# ------------------------------------------------------------------------- +# Ok arguments. + +set n 0 +foreach {switch nodes expected} { + -in {1 2 3} {1 2 3 4 5 6} -in {4 5 6} {} + -out {1 2 3} {1 2 3} -out {4 5 6} {1 2 3} + -adj {1 2 3} {1 2 3 4 5 6} -adj {4 5 6} {1 2 3} + -inner {1 2 3} {1 2 3} -inner {4 5 6} {} + -embedding {1 2 3} {4 5 6} -embedding {4 5 6} {1 2 3} + -in {1 2} {1 3 4 5} -in {4 5} {} + -out {1 2} {2 3} -out {4 5} {1 2} + -adj {1 2} {1 2 3 4 5} -adj {4 5} {1 2} + -inner {1 2} {1 2} -inner {4 5} {} + -embedding {1 2} {3 4 5} -embedding {4 5} {1 2} + -in {1} {3 4} -in {4} {} + -out {1} {2} -out {4} {1} + -adj {1} {2 3 4} -adj {4} {1} + -inner {1} {} -inner {4} {} + -embedding {1} {2 3 4} -embedding {4} {1} + -in {1 4} {3 4} -in {4 2} {1 5} + -out {1 4} {1 2} -out {4 2} {1 3} + -adj {1 4} {1 2 3 4} -adj {4 2} {1 3 5} + -inner {1 4} {1 4} -inner {4 2} {} + -embedding {1 4} {2 3} -embedding {4 2} {1 3 5} +} { + test graph-${impl}-${setimpl}-nodes-ioaie-3.$n "nodes, $switch" { + SETUP + + mygraph node insert 1 2 3 4 5 6 + mygraph arc insert 4 1 A + mygraph arc insert 5 2 B + mygraph arc insert 6 3 C + mygraph arc insert 3 1 D + mygraph arc insert 1 2 E + mygraph arc insert 2 3 F + + set result [lsort [eval [linsert $nodes 0 mygraph nodes $switch]]] + mygraph destroy + set result + } $expected ; # {} + + incr n +} + +# --------------------------------------------------- +# Test with many parallel arcs, beyond the number of nodes, i.e. lots +# of duplicates sources and destinations, to check that the dup +# removal works correctly. See bug [SF 1923685]. + +set n 0 +foreach {switch nodes expected} { + -in 2 1 + -out 2 3 + -adj 2 {1 3} + -inner {1 2 3} {1 2 3} + -embedding 2 {1 3} +} { + test graph-${impl}-${setimpl}-nodes-parallel-ioaie-bug1923685-4.$n "nodes, $switch, parallel arcs, bug 1923685" { + SETUP + + mygraph node insert 1 2 3 4 + mygraph arc insert 1 2 A ; mygraph arc insert 2 3 A. + mygraph arc insert 1 2 B ; mygraph arc insert 2 3 B. + mygraph arc insert 1 2 C ; mygraph arc insert 2 3 C. + mygraph arc insert 1 2 D ; mygraph arc insert 2 3 D. + mygraph arc insert 1 2 E ; mygraph arc insert 2 3 E. + mygraph arc insert 1 2 F ; mygraph arc insert 2 3 F. + mygraph arc insert 1 2 G ; mygraph arc insert 2 3 G. + mygraph arc insert 1 2 H ; mygraph arc insert 2 3 H. + + set result [lsort [eval [linsert $nodes 0 mygraph nodes $switch]]] + mygraph destroy + set result + } $expected ; # {} + + incr n +} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/adjlist.test b/tcllib/modules/struct/graph/tests/ops/adjlist.test new file mode 100644 index 0000000..ab135eb --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/adjlist.test @@ -0,0 +1,158 @@ +# -*- tcl -*- +#Adjacency List - Tests + +# Sort input into canonical form. +proc adjsort {dict} { + set res {} + foreach {k v} [dictsort $dict] { + lappend res $k [lsort -dict $v] + } + return $res +} + +#Test 1.0 - undirected but weighted graph containing some special cases +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.0 { AdjacencyList, undirected, unweighted, graph simulation } { + SETUP_ADJACENCYLIST_K4 + set result [struct::graph::op::toAdjacencyList mygraph] + mygraph destroy + set result +} "node1 {node2 node3 node4} node2 {node1 node3} node3 {node1 node2 node4} node4 {node1 node3}" + +#Test 1.1 - undirected but weighted graph containing some special cases +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.1 { AdjacencyList, undirected, weighted, graph simulation } { + SETUP_ADJACENCYLIST_K4_WEIGHTED + set result [struct::graph::op::toAdjacencyList mygraph -weights] + mygraph destroy + set result +} "node1 {{node2 1} {node3 1} {node4 1}} node2 {{node1 1} {node3 1}} node3 {{node1 1} {node2 1} {node4 1}} node4 {{node1 1} {node3 1}}" + +#Test 1.2 - directed, weighted graph with different wages at crucial edges ( e.g. edges between same nodes ) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.2 { AdjacencyList, directed, weighted, graph simulation } { + SETUP_ADJACENCYLIST_K4_WEIGHTED_DIRECTED + set result [adjsort [struct::graph::op::toAdjacencyList mygraph -directed -weights]] + mygraph destroy + set result +} {node1 {{node2 1} {node3 1} {node4 2}} node2 {{node3 1}} node3 {{node4 1}} node4 {{node1 3}}} + +#Test 1.3 - directed weighted graph, same us upper but changed order of options +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.3 { AdjacencyList, directed, weighted, graph simulation } { + SETUP_ADJACENCYLIST_K4_WEIGHTED_DIRECTED + set result [adjsort [struct::graph::op::toAdjacencyList mygraph -weights -directed]] + mygraph destroy + set result +} {node1 {{node2 1} {node3 1} {node4 2}} node2 {{node3 1}} node3 {{node4 1}} node4 {{node1 3}}} + +#Test 1.4 - directed but unweighted graph containing some special cases +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.4 { AdjacencyList, directed, unweighted, graph simulation } { + SETUP_ADJACENCYLIST_K4 + set result [adjsort [struct::graph::op::toAdjacencyList mygraph -directed]] + mygraph destroy + set result +} {node1 {node2 node3 node4} node2 node3 node3 node4 node4 node1} + +#Test 1.5 - case where graph has no edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.5 { AdjacencyList, no edges } { + SETUP_NOEDGES_1 + set result [struct::graph::op::toAdjacencyList mygraph] + mygraph destroy + set result +} "node1 {} node2 {} node3 {} node4 {}" + +#Test 1.6 - case where graph has no edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.6 { AdjacencyList, no edges } { + SETUP_NOEDGES_1 + set result [struct::graph::op::toAdjacencyList mygraph -directed -weights] + mygraph destroy + set result +} "node1 {} node2 {} node3 {} node4 {}" + +#Test 1.7 - another graph simulation for checking proper return value +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-1.7 { AdjacencyList, undirected, unweighted, graph simulation } { + SETUP_ADJACENCYLIST_1 + set result [struct::graph::op::toAdjacencyList mygraph] + mygraph destroy + set result +} "node1 {node2 node6} node2 {node1 node3} node3 {node2 node6} node4 {node5 node6} node5 node4 node6 {node1 node3 node4}" + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-2.0 { AdjacencyList, wrong args, missing } { + catch {struct::graph::op::toAdjacencyList} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::toAdjacencyList {G args} 0] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when given undirected graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.0 {AdjacencyList, undirected, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::toAdjacencyList mygraph -weights} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.1 - case when given directed graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.1 {AdjacencyList, directed, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::toAdjacencyList mygraph -directed -weights} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.2 - case when given undirected graph doesn't have weights at some edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.2 {AdjacencyList, undirected, partial lack of weights at edges } { + SETUP_PARTIALLYWEIGHTED_K4 + catch {struct::graph::op::toAdjacencyList mygraph -weights} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.3 - case when given directed graph doesn't have weights at some edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.3 {AdjacencyList, directed, partial lack of weights at edges } { + SETUP_PARTIALLYWEIGHTED_K4 + catch {struct::graph::op::toAdjacencyList mygraph -directed -weights} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.4 - case when user sets wrong option to the procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.4 {AdjacencyList, bad option used } { + SETUP + catch {struct::graph::op::toAdjacencyList mygraph -badoption} result + mygraph destroy + set result +} {Bad option "-badoption". Expected -directed or -weights} + +#Test 3.5 - case when user sets wrong option to the procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.5 {AdjacencyList, bad options used } { + SETUP + catch {struct::graph::op::toAdjacencyList mygraph -directed -badoption} result + mygraph destroy + set result +} {Bad option "-badoption". Expected -directed or -weights} + +#Test 3.6 - case when user sets wrong option to the procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.6 {AdjacencyList, bad options used } { + SETUP + catch {struct::graph::op::toAdjacencyList mygraph -weights -badoption} result + mygraph destroy + set result +} {Bad option "-badoption". Expected -directed or -weights} + +#Test 3.7 - case when user sets wrong option to the procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.7 {AdjacencyList, bad options used } { + SETUP + catch {struct::graph::op::toAdjacencyList mygraph -badoption -directed} result + mygraph destroy + set result +} {Bad option "-badoption". Expected -directed or -weights} + +#Test 3.8 - case when user sets wrong option to the procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-AdjacencyList-3.8 {AdjacencyList, bad options used } { + SETUP + catch {struct::graph::op::toAdjacencyList mygraph -badoption -weights} result + mygraph destroy + set result +} {Bad option "-badoption". Expected -directed or -weights} diff --git a/tcllib/modules/struct/graph/tests/ops/adjmatrix.test b/tcllib/modules/struct/graph/tests/ops/adjmatrix.test new file mode 100644 index 0000000..67f8fea --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/adjmatrix.test @@ -0,0 +1,69 @@ +# -*- tcl -*- +# Graph ops tests - Adjacency Matrix. +# Copyright (c) 2008-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: adjmatrix.test,v 1.5 2010/09/09 21:48:27 andreas_kupries Exp $ + +# Syntax: struct::graph::op::toAdjacencyMatrix G + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-toAdjacencyMatrix-1.0 {toAdjacencyMatrix, wrong args, missing} -body { + struct::graph::op::toAdjacencyMatrix +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::toAdjacencyMatrix {g} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-toAdjacencyMatrix-1.1 {toAdjacencyMatrix, wrong args, too many} -body { + struct::graph::op::toAdjacencyMatrix g x +} -returnCodes error -result [tcltest::tooManyArgs struct::graph::op::toAdjacencyMatrix {g}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-toAdjacencyMatrix-2.0 {toAdjacencyMatrix, empty graph} -setup { + SETUP +} -body { + struct::graph::op::toAdjacencyMatrix mygraph +} -cleanup { + mygraph destroy +} -result {{{}}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-toAdjacencyMatrix-2.1 {toAdjacencyMatrix, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 +} -body { + struct::graph::op::toAdjacencyMatrix mygraph +} -cleanup { + mygraph destroy +} -result {{{} 0 1 2 3 4 5} {0 0 0 0 0 0 0} {1 0 0 0 0 0 0} {2 0 0 0 0 0 0} {3 0 0 0 0 0 0} {4 0 0 0 0 0 0} {5 0 0 0 0 0 0}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-toAdjacencyMatrix-2.2 {toAdjacencyMatrix, nodes, arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 + mygraph arc insert 0 1 a + mygraph arc insert 2 3 b + mygraph arc insert 4 5 c +} -body { + struct::graph::op::toAdjacencyMatrix mygraph +} -cleanup { + mygraph destroy +} -result {{{} 0 1 2 3 4 5} {0 0 1 0 0 0 0} {1 1 0 0 0 0 0} {2 0 0 0 1 0 0} {3 0 0 1 0 0 0} {4 0 0 0 0 0 1} {5 0 0 0 0 1 0}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-toAdjacencyMatrix-2.3 {toAdjacencyMatrix, nodes, parallel arcs, loops} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 + mygraph arc insert 0 1 a + mygraph arc insert 0 1 b + mygraph arc insert 2 3 c + mygraph arc insert 3 2 d + mygraph arc insert 4 4 e +} -body { + struct::graph::op::toAdjacencyMatrix mygraph +} -cleanup { + mygraph destroy +} -result {{{} 0 1 2 3 4 5} {0 0 1 0 0 0 0} {1 1 0 0 0 0 0} {2 0 0 0 1 0 0} {3 0 0 1 0 0 0} {4 0 0 0 0 1 0} {5 0 0 0 0 0 0}} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/bellmanford.test b/tcllib/modules/struct/graph/tests/ops/bellmanford.test new file mode 100644 index 0000000..706f9c5 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/bellmanford.test @@ -0,0 +1,137 @@ +# -*- tcl -*- +#Bellman-Ford's Algorithm - Tests +# +#Searching distances between selected node and all other nodes in graph. + +#------------------------------------------------------------------------------------ +#Tests concerning returning right values by algorithm + +#Tests 1.0 and 1.1 - couting right values for special cases of graphs +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.0 { BellmanFord, graph simulation } { + SETUP_BELLMANFORD_1 + set result [dictsort [struct::graph::op::BellmanFord mygraph node1]] + mygraph destroy + set result +} {node1 0 node2 1 node3 2 node4 3} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.1 { BellmanFord, graph simulation } { + SETUP_BELLMANFORD_2 + set result [dictsort [struct::graph::op::BellmanFord mygraph node1]] + mygraph destroy + set result +} {node1 0 node2 8 node3 5 node4 7 node5 3 node6 5} + +#Tests 1.2 - 1.4 - Test cases when there occur existance of cycle with negative sum of weights at edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.2 { BellmanFord, negative cycles } { + SETUP_NEGATIVECYCLE_1 + catch { struct::graph::op::BellmanFord mygraph node1 } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.3 { BellmanFord, negative cycles } { + SETUP_NEGATIVECYCLE_2 + catch { struct::graph::op::BellmanFord mygraph node1 } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.4 { BellmanFord, negative cycles } { + SETUP_NEGATIVECYCLE_3 + catch { struct::graph::op::BellmanFord mygraph node1 } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +#Test 1.5 - do the algorithm finds a proper solution for directed complete graph with one edge deleted? +#checking proper source - target relation +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.5 { BellmanFord, complete graph } { + SETUP_K4 + set result [dictsort [struct::graph::op::BellmanFord mygraph node4]] + mygraph destroy + set result +} {node1 2 node2 2 node3 3 node4 0} + +#Test 1.6 - coherent graph case, graph with startnode without edges pointing out, setting Inf values +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.6 { BellmanFord, uncoherence } { + SETUP_PARTIALLYCONNECTED_1 + set result [dictsort [struct::graph::op::BellmanFord mygraph node5]] + mygraph destroy + set result +} {node1 Inf node2 Inf node3 Inf node4 Inf node5 0} + +#Test 1.7 - case when we are given a graph without any edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.7 { BellmanFord, no edges } { + SETUP_NOEDGES_1 + set result [dictsort [struct::graph::op::BellmanFord mygraph node1]] + mygraph destroy + set result +} {node1 0 node2 Inf node3 Inf node4 Inf} + +#Test 1.8 - case when we are given a graph with all edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.8 { BellmanFord, all weights set to 0 } { + SETUP_ZEROWEIGHTED_K4 + set result [dictsort [struct::graph::op::BellmanFord mygraph node1]] + mygraph destroy + set result +} {node1 0 node2 0 node3 0 node4 0} + +#Test 1.9 - case when we are given a graph with some edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.9 { BellmanFord, some weights set to 0 } { + SETUP_PARTIALLYZEROWEIGHTED + set result [dictsort [struct::graph::op::BellmanFord mygraph node1]] + mygraph destroy + set result +} {node1 0 node2 0 node3 0 node4 1} + +#Test 1.10 - case when we are given a complete K4 graph with some edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-1.10 { BellmanFord, some weights set to 0 } { + SETUP_PARTIALLYZEROWEIGHTED_K4 + set result [dictsort [struct::graph::op::BellmanFord mygraph node1]] + mygraph destroy + set result +} {node1 0 node2 0 node3 0 node4 0} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-2.0 { BellmanFord, wrong args, missing } { + catch {struct::graph::op::BellmanFord} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BellmanFord {G startnode} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-2.1 { BellmanFord, wrong args, missing } { + catch {struct::graph::op::BellmanFord G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BellmanFord {G startnode} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-2.2 { BellmanFord, wrong args, too many} { + catch {struct::graph::op::BellmanFord G startnode x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::BellmanFord {G startnode}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when startnode doesn't exist in given graph +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-3.0 {BellmanFord, unexisting node } { + SETUP + catch {struct::graph::op::BellmanFord mygraph startnode} result + mygraph destroy + set result +} [MissingNode mygraph startnode] + +#Test 3.1 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-3.1 {BellmanFord, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::BellmanFord mygraph startnode} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.2 - case when given graph doesn't have weights at some edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BellmanFord-3.1 {BellmanFord, partial lack of weights at edges } { + SETUP_PARTIALLYWEIGHTED_K4 + catch {struct::graph::op::BellmanFord mygraph startnode} result + mygraph destroy + set result +} [UnweightedArcOccurance] diff --git a/tcllib/modules/struct/graph/tests/ops/bfs.test b/tcllib/modules/struct/graph/tests/ops/bfs.test new file mode 100644 index 0000000..2155c9f --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/bfs.test @@ -0,0 +1,204 @@ +# -*- tcl -*- +#Breadth-First Search procedures +# +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +# ------------------------------------------------------------------------------------ + +# ------------------------------------------------------------------------------------ +#Tests for shortest paths finding using BFS algorithm +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-1.0 { graph simulation } { + SETUP_BFS_1 + set result [dictsort [struct::graph::op::ShortestsPathsByBFS mygraph s distances]] + mygraph destroy + set result +} {a 2 b 7 c 13 d 9 s 0 x 5} + +#Test 1.1 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-1.1 { graph simulation } { + SETUP_BFS_1 + set result [dictsort [struct::graph::op::ShortestsPathsByBFS mygraph s paths]] + mygraph destroy + set result +} {a {s x} b {s x a} c {s x a b} d {s x a b} x s} + +#Test 1.2 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-1.2 { graph simulation } { + SETUP_BFS_2 + set result [dictsort [struct::graph::op::ShortestsPathsByBFS mygraph s distances]] + mygraph destroy + set result +} {a 13 b 23 c 11 d 9 s 0 t 18} + +#Test 1.3 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-1.3 { graph simulation } { + SETUP_BFS_2 + set result [dictsort [struct::graph::op::ShortestsPathsByBFS mygraph s paths]] + mygraph destroy + set result +} {a {s d} b {s d c t} c {s d} d s t {s d c}} + +#Test 1.4 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-1.4 { graph simulation } { + SETUP_BELLMANFORD_2 + set result [dictsort [struct::graph::op::ShortestsPathsByBFS mygraph node1 distances]] + mygraph destroy + set result +} {node1 0 node2 8 node3 5 node4 7 node5 3 node6 5} + +#Test 1.5 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-1.5 { graph simulation } { + SETUP_BELLMANFORD_2 + set result [dictsort [struct::graph::op::ShortestsPathsByBFS mygraph node1 paths]] + mygraph destroy + set result +} {node2 node1 node3 {node1 node2 node4} node4 {node1 node2} node5 {node1 node2 node4 node3} node6 {node1 node2 node4 node3 node5}} + +#Tests for standard BFS Algorithm +#Test 1.6 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-1.6 { graph simulation } { + SETUP_BFS_2 + set solution [struct::graph::op::BFS mygraph s graph] + set result "[lsort [$solution nodes]] | [lsort [$solution arcs]]" + $solution destroy + mygraph destroy + set result +} [tmE \ + {a b c d s t | {a b} {c t} {d c} {s a} {s d}} \ + {a b c d s t | {a b} {a c} {b t} {s a} {s d}}] +# Tcl ordering: d,a | Both results are valid. +# C ordering: a,d | + +#Test 1.7 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-1.7 { graph simulation } { + SETUP_BFS_2 + set result [struct::graph::op::BFS mygraph s tree] + set tree {} + foreach node [$result nodes] { + lappend tree [list $node [lsort [$result children $node]]] + } + mygraph destroy + $result destroy + lsort $tree +} [tmE \ + {{a b} {b {}} {c t} {d c} {s {a d}} {t {}}} \ + {{a {b c}} {b t} {c {}} {d {}} {s {a d}} {t {}}}] +# See 1.6. + +#Test 1.8 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-1.8 { graph simulation } { + SETUP_MDST_1 + set solution [struct::graph::op::BFS mygraph d graph] + set result "[lsort [$solution nodes]] | [lsort [$solution arcs]]" + mygraph destroy + $solution destroy + set result +} [tmE \ + {a b c d e f g h i j | {b a} {d c} {d e} {d h} {e f} {e g} {g i} {h b} {h j}} \ + {a b c d e f g h i j | {b a} {c b} {c g} {d c} {d e} {d h} {e f} {g i} {h j}}] + +#Test 1.9 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-1.9 { graph simulation } { + SETUP_MDST_1 + set result [struct::graph::op::BFS mygraph d tree] + set tree {} + foreach node [$result nodes] { + lappend tree [list $node [lsort [$result children $node]]] + } + mygraph destroy + $result destroy + lsort $tree +} [tmE \ + {{a {}} {b a} {c {}} {d {c e h}} {e {f g}} {f {}} {g i} {h {b j}} {i {}} {j {}}} \ + {{a {}} {b a} {c {b g}} {d {c e h}} {e f} {f {}} {g i} {h j} {i {}} {j {}}}] + +#Test 1.10 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-1.10 { graph simulation } { + SETUP_BELLMANFORD_2 + set solution [struct::graph::op::BFS mygraph node1 graph] + set result "[lsort [$solution nodes]] | [lsort [$solution arcs]]" + mygraph destroy + $solution destroy + set result +} [tmE \ + {node1 node2 node3 node4 node5 node6 | {node1 node2} {node1 node3} {node2 node4} {node3 node5} {node4 node6}} \ + {node1 node2 node3 node4 node5 node6 | {node1 node2} {node1 node3} {node3 node4} {node3 node5} {node4 node6}}] + +#Test 1.11 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-1.11 { graph simulation } { + SETUP_BELLMANFORD_2 + set result [struct::graph::op::BFS mygraph node1 tree] + set tree {} + foreach node [$result nodes] { + lappend tree [list $node [lsort [$result children $node]]] + } + mygraph destroy + $result destroy + lsort $tree +} [tmE \ + {{node1 {node2 node3}} {node2 node4} {node3 node5} {node4 node6} {node5 {}} {node6 {}}} \ + {{node1 {node2 node3}} {node2 {}} {node3 {node4 node5}} {node4 node6} {node5 {}} {node6 {}}}] + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-2.0 { BFS, wrong args, missing } { + catch {struct::graph::op::ShortestsPathsByBFS} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::ShortestsPathsByBFS {G s outputFormat} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-2.1 { BFS, wrong args, missing } { + catch {struct::graph::op::ShortestsPathsByBFS G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::ShortestsPathsByBFS {G s outputFormat} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-2.2 { BFS, wrong args, missing } { + catch {struct::graph::op::ShortestsPathsByBFS G s} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::ShortestsPathsByBFS {G s outputFormat} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-2.3 { BFS, wrong args, too many} { + catch {struct::graph::op::ShortestsPathsByBFS G a b c} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::ShortestsPathsByBFS {G s outputFormat}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-2.4 { BFS, wrong args, missing } { + catch {struct::graph::op::BFS} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BFS {G s outputFormat} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-2.5 { BFS, wrong args, missing } { + catch {struct::graph::op::BFS G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BFS {G s outputFormat} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-2.6 { BFS, wrong args, missing } { + catch {struct::graph::op::BFS G s} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BFS {G s outputFormat} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-2.7 { BFS, wrong args, too many} { + catch {struct::graph::op::BFS G a b c} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::BFS {G s outputFormat}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-ShortestsPathsByBFS-3.0 { ShortestsPathsByBFS } { + SETUP + catch {struct::graph::op::ShortestsPathsByBFS mygraph s badOption} result + mygraph destroy + set result +} {Unknown output format "badOption", expected distances, or paths.} + +#Test 3.1 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BFS-3.1 { BFS } { + SETUP + catch {struct::graph::op::BFS mygraph s badOption} result + mygraph destroy + set result +} {Unknown output format "badOption", expected graph, or tree.} diff --git a/tcllib/modules/struct/graph/tests/ops/bipartite.test b/tcllib/modules/struct/graph/tests/ops/bipartite.test new file mode 100644 index 0000000..786e566 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/bipartite.test @@ -0,0 +1,147 @@ +# -*- tcl -*- +# Graph ops tests - Minimum spanning tree/forest per Bipartite +# Copyright (c) 2008-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: bipartite.test,v 1.4 2010/09/09 21:48:27 andreas_kupries Exp $ + +# Syntax: struct::graph::op::isBipartite? G ?partitionvar? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-1.0 {bipartite, wrong args, missing} -body { + struct::graph::op::isBipartite? +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::isBipartite? {g ?bipartitionvar?} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-1.1 {bipartite, wrong args, too many} -body { + struct::graph::op::isBipartite? g x y +} -returnCodes error -result [tcltest::tooManyArgs struct::graph::op::isBipartite? {g ?bipartitionvar?}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-3.0 {bipartite, empty graph} -setup { + SETUP +} -body { + struct::graph::op::isBipartite? mygraph +} -cleanup { + mygraph destroy +} -result 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-3.1 {bipartite, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 +} -body { + struct::graph::op::isBipartite? mygraph +} -cleanup { + mygraph destroy +} -result 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-3.2 {bipartite, no} -setup { + SETUP_D +} -body { + struct::graph::op::isBipartite? mygraph +} -cleanup { + mygraph destroy +} -result 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-3.3 {bipartite, yes} -setup { + SETUP_E +} -body { + struct::graph::op::isBipartite? mygraph +} -cleanup { + mygraph destroy +} -result 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-3.4 {bipartite, yes} -setup { + SETUP_F +} -body { + struct::graph::op::isBipartite? mygraph +} -cleanup { + mygraph destroy +} -result 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-3.5 {bipartite, yes} -setup { + SETUP_G +} -body { + struct::graph::op::isBipartite? mygraph +} -cleanup { + mygraph destroy +} -result 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-3.6 {bipartite, yes} -setup { + SETUP_C +} -body { + struct::graph::op::isBipartite? mygraph +} -cleanup { + mygraph destroy +} -result 1 + +# ------------------------------------------------------------------------- +# Ok arguments, get the partitions. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-4.0 {bipartite, empty graph} -setup { + SETUP + set result {} +} -body { + struct::graph::op::isBipartite? mygraph result + set result +} -cleanup { + mygraph destroy +} -result {{} {}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-4.1 {bipartite, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 + set result {} +} -body { + struct::graph::op::isBipartite? mygraph result + bicanon $result +} -cleanup { + mygraph destroy +} -result {{} {0 1 2 3 4 5}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-4.3 {bipartite, yes} -setup { + SETUP_E + set result {} +} -body { + struct::graph::op::isBipartite? mygraph result + bicanon $result +} -cleanup { + mygraph destroy +} -result {{1b 2b 3b 4b 5b 6b 7b 8b} {1w 2w 3w 4w 5w 6w 7w 8w}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-4.4 {bipartite, yes} -setup { + SETUP_F + set result {} +} -body { + struct::graph::op::isBipartite? mygraph result + bicanon $result +} -cleanup { + mygraph destroy +} -result {{1b 2b 3b 4b} {1w 2w 3w 4w}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-4.5 {bipartite, yes} -setup { + SETUP_G + set result {} +} -body { + struct::graph::op::isBipartite? mygraph result + bicanon $result +} -cleanup { + mygraph destroy +} -result {{1b 2b 3b 4b 5b} {1w 2w 3w 4w 5w}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-bipartite-4.6 {bipartite, yes} -setup { + SETUP_C + set result {} +} -body { + struct::graph::op::isBipartite? mygraph result + bicanon $result +} -cleanup { + mygraph destroy +} -result {{A D F} {B C E}} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/bridge.test b/tcllib/modules/struct/graph/tests/ops/bridge.test new file mode 100644 index 0000000..b84c1ab --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/bridge.test @@ -0,0 +1,75 @@ +# -*- tcl -*- +# Graph ops tests - Connected components II. +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: bridge.test,v 1.3 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::isBridge? G A + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-1.0 {isBridge?, wrong args, missing} { + catch {struct::graph::op::isBridge?} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::isBridge? {g arc} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-1.1 {isBridge?, wrong args, missing} { + catch {struct::graph::op::isBridge? g} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::isBridge? {g arc} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-1.2 {isBridge?, wrong args, too many} { + catch {struct::graph::op::isBridge? g x y} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::isBridge? {g arc}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-2.0 {isBridge?, bad arc} { + SETUP + catch {struct::graph::op::isBridge? mygraph foo} result + mygraph destroy + set result +} {arc "foo" does not exist in graph "mygraph"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-3.1 {isBridge?} { + SETUP_A + set result [lsort -dict [struct::graph::op::isBridge? mygraph 'arc0_1']] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-3.2 {isBridge?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isBridge? mygraph bridge1]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-3.3 {isBridge?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isBridge? mygraph bridge2]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-3.4 {isBridge?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isBridge? mygraph bridge3]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isBridge?-3.5 {isBridge?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isBridge? mygraph nobridge]] + mygraph destroy + set result +} 0 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/busackergowen.test b/tcllib/modules/struct/graph/tests/ops/busackergowen.test new file mode 100644 index 0000000..d83a638 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/busackergowen.test @@ -0,0 +1,157 @@ +# -*- tcl -*- +#Busacker-Gowen algorithm - computing maximum flow in a flow network +# +# + + +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +# ------------------------------------------------------------------------------------ +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-1.0 { graph simulation } { + SETUP_BUSACKERGOWEN_1 + set result [dictsort [struct::graph::op::BusackerGowen mygraph 25 s t]] + mygraph destroy + set result +} {{a b} 8 {a c} 10 {b t} 8 {c t} 17 {s a} 18 {s c} 7} + +#Test 1.1 - case considering when desired flow is equal to max flow +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-1.1 { graph simulation } { + SETUP_BUSACKERGOWEN_1 + set result [dictsort [struct::graph::op::BusackerGowen mygraph 31 s t]] + mygraph destroy + set result +} {{a b} 14 {b t} 14 {c a} 18 {c t} 17 {s a} 18 {s c} 13} + +#Test 1.2 - case considering when desired flow exceeds max flow - algorithm should end when +#there is no more paths between source and sink nodes. +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-1.2 { graph simulation } { + SETUP_BUSACKERGOWEN_1 + set result [dictsort [struct::graph::op::BusackerGowen mygraph 40 s t]] + mygraph destroy + set result +} {{a b} 14 {b t} 14 {c a} 18 {c t} 17 {s a} 18 {s c} 13} + +#Test 1.3 - case when the are no paths between source and sink from the beginning +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-1.3 { graph simulation } { + SETUP_SOURCESINKNOPATHS + set result [struct::graph::op::BusackerGowen mygraph 1 s t] + mygraph destroy + set result +} {} + +#Test 1.4 - test for subprocedure that creates Augmenting Network +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-1.4 { createAugmentingNetwork, graph simulation } -setup { + SETUP_AUGMENTINGNETWORK_1 f path + set throughputs {} + set costs {} +} -body { + set result [struct::graph::op::createAugmentingNetwork mygraph $f $path] + set throughputs_arcs [$result arcs -key throughput] + set costs_arcs [$result arcs -key cost] + foreach t $throughputs_arcs c $costs_arcs { + dict set throughputs $t [$result arc set $t throughput] + dict set costs $c [$result arc set $c cost] + } + list [dictsort $throughputs] | [dictsort $costs] +} -cleanup { + unset costs throughputs f costs_arcs throughputs_arcs path t + mygraph destroy + $result destroy +} -result {{{a b} 20 {a c} 0 {a s} 15 {b t} 14 {c a} 15 {c b} 12 {c t} 2 {s a} 3 {s c} 20 {t c} 15} | {{a b} 5 {a c} Inf {a s} -3 {b t} 5 {c a} -4 {c b} 8 {c t} 3 {s a} 3 {s c} 8 {t c} -3}} + +#Test 1.5 - test for subprocedure that creates Augmenting Network +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-1.5 { createAugmentingNetwork, graph simulation } -setup { + SETUP_AUGMENTINGNETWORK_2 f path + set throughputs {} + set costs {} +} -body { + set result [struct::graph::op::createAugmentingNetwork mygraph $f $path] + set throughputs_arcs [$result arcs -key throughput] + set costs_arcs [$result arcs -key cost] + foreach t $throughputs_arcs c $costs_arcs { + dict set throughputs $t [$result arc set $t throughput] + dict set costs $c [$result arc set $c cost] + } + list [dictsort $throughputs] | [dictsort $costs] +} -cleanup { + unset costs throughputs f costs_arcs throughputs_arcs path t + mygraph destroy + $result destroy +} -result {{{a b} 20 {a c} 0 {a s} 15 {b t} 14 {c a} 15 {c b} 12 {c s} 2 {c t} 0 {s a} 3 {s c} 18 {t c} 17} | {{a b} 5 {a c} Inf {a s} -3 {b t} 5 {c a} -4 {c b} 8 {c s} -8 {c t} Inf {s a} 3 {s c} 8 {t c} -3}} + +#Test 1.6 - test for subprocedure that creates Augmenting Network +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-1.6 { createAugmentingNetwork, graph simulation } -setup { + SETUP_AUGMENTINGNETWORK_3 f path + set throughputs {} + set costs {} +} -body { + set result [struct::graph::op::createAugmentingNetwork mygraph $f $path] + set throughputs_arcs [$result arcs -key throughput] + set costs_arcs [$result arcs -key cost] + foreach t $throughputs_arcs c $costs_arcs { + dict set throughputs $t [$result arc set $t throughput] + dict set costs $c [$result arc set $c cost] + } + list [dictsort $throughputs] | [dictsort $costs] +} -cleanup { + unset costs throughputs f costs_arcs throughputs_arcs path t + mygraph destroy + $result destroy +} -result {{{a b} 17 {a c} 0 {a s} 18 {b a} 3 {b t} 11 {c a} 15 {c b} 12 {c s} 2 {c t} 0 {s a} 0 {s c} 18 {t b} 3 {t c} 17} | {{a b} 5 {a c} Inf {a s} -3 {b a} -5 {b t} 5 {c a} -4 {c b} 8 {c s} -8 {c t} Inf {s a} Inf {s c} 8 {t b} -5 {t c} -3}} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-2.0 { BusackerGowen, wrong args, missing } { + catch {struct::graph::op::BusackerGowen} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BusackerGowen {G desiredFlow s t} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-2.1 { BusackerGowen, wrong args, missing } { + catch {struct::graph::op::BusackerGowen G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BusackerGowen {G desiredFlow s t} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-2.2 { BusackerGowen, wrong args, missing } { + catch {struct::graph::op::BusackerGowen G desiredFlow} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BusackerGowen {G desiredFlow s t} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-2.3 { BusackerGowen, wrong args, too many} { + catch {struct::graph::op::BusackerGowen G desiredFlow c s t z} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::BusackerGowen {G desiredFlow s t}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-2.4 { BusackerGowen, wrong args, missing } { + catch {struct::graph::op::BusackerGowen G desiredFlow s} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BusackerGowen {G desiredFlow s t} 3] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when sink and source nodes given at input aren't nodes of input graph +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-3.0 {BusackerGowen, wrong sink or source } { + SETUP_BUSACKERGOWEN_1 + catch {struct::graph::op::BusackerGowen mygraph 25 x y } result + mygraph destroy + set result +} [LackOfSinkOrSource x y] + +#Test 3.1 - case when input network has lacking attributes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-3.1 {BusackerGowen, missing attributes } { + SETUP_BUSACKERGOWEN_2 + catch {struct::graph::op::BusackerGowen mygraph 25 s t } result + mygraph destroy + set result +} [WrongAttributes throughput cost] + +#Test 3.2 - case when wrong input value of desired flow is given at input +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BusackerGowen-3.2 {BusackerGowen, wrong input, desired flow } { + SETUP_BUSACKERGOWEN_1 + catch {struct::graph::op::BusackerGowen mygraph 0 s t } result + mygraph destroy + set result +} [WrongValueAtInput desiredFlow] diff --git a/tcllib/modules/struct/graph/tests/ops/christofides.test b/tcllib/modules/struct/graph/tests/ops/christofides.test new file mode 100644 index 0000000..fdb6124 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/christofides.test @@ -0,0 +1,58 @@ +# -*- tcl -*- +#Christofides Algorithm - Tests +# +#Finding Hamilton Cycle in a graph satisfying triangle inequality + +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +#Test 1.0 - Tight Example for Christofides algorithm +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Christofides-1.0 { Christofides, graph simulation } -setup { + SETUP_CHRISTO_1 +} -body { + toursort [struct::graph::op::Christofides mygraph] +} -cleanup { + mygraph destroy +} -result [tmE \ + {node1 node2 node3 node5 node7 node6 node4 node2 node1} \ + {node1 node2 node3 node4 node5 node7 node6 node4 node2 node1}] + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Christofides-2.0 { Christofides, wrong args, missing } { + catch {struct::graph::op::Christofides} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::Christofides {G} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Christofides-2.1 { Christofides, wrong args, too many} { + catch {struct::graph::op::Christofides G y x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::Christofides {G}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Christofides-3.0 {Christofides, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::Christofides mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.1 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Christofides-3.1 {Christofides, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::Christofides mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.2 - case when given graph is not a connected graph +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Christofides-3.2 { Christofides, unconnected graph } { + SETUP_NOEDGES_1 + catch { struct::graph::op::Christofides mygraph } result + mygraph destroy + set result +} [UnconnectedGraphOccurance {mygraph}] diff --git a/tcllib/modules/struct/graph/tests/ops/componentof.test b/tcllib/modules/struct/graph/tests/ops/componentof.test new file mode 100644 index 0000000..4a93be1 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/componentof.test @@ -0,0 +1,167 @@ +# -*- tcl -*- +# Graph ops tests - Connected components II. +# Copyright (c) 2008-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: componentof.test,v 1.4 2010/09/09 21:48:27 andreas_kupries Exp $ + +# Syntax: struct::graph::op::connectedComponentOf G + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-1.0 {connectedComponentOf, wrong args, missing} -body { + struct::graph::op::connectedComponentOf +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::connectedComponentOf {g n} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-1.1 {connectedComponentOf, wrong args, missing} -body { + struct::graph::op::connectedComponentOf g +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::connectedComponentOf {g n} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-1.2 {connectedComponentOf, wrong args, too many} -body { + struct::graph::op::connectedComponentOf g x y +} -returnCodes error -result [tcltest::tooManyArgs struct::graph::op::connectedComponentOf {g n}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-2.0 {connectedComponentOf, bad node} -setup { + SETUP +} -body { + struct::graph::op::connectedComponentOf mygraph foo +} -cleanup { + mygraph destroy +} -returnCodes error -result {node "foo" does not exist in graph "mygraph"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.1 {connectedComponentOf, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 0] +} -cleanup { + mygraph destroy +} -result 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.2 {connectedComponentOf, single CC} -setup { + SETUP_A +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 'node5'] +} -cleanup { + mygraph destroy +} -result {'node0' 'node1' 'node2' 'node3' 'node4' 'node5' 'node6'} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.3 {connectedComponentOf, single CC} -setup { + SETUP_B +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph D] +} -cleanup { + mygraph destroy +} -result {A B C D E S} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.4 {connectedComponentOf, single CC} -setup { + SETUP_C +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph D] +} -cleanup { + mygraph destroy +} -result {A B C D E F} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.5 {connectedComponentOf, single CC} -setup { + SETUP_D +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph g] +} -cleanup { + mygraph destroy +} -result {a b c d f g h i j} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.6 {connectedComponentOf, single CC} -setup { + SETUP_E +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 5b] +} -cleanup { + mygraph destroy +} -result {1b 1w 2b 2w 3b 3w 4b 4w 5b 5w 6b 6w 7b 7w 8b 8w} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.7 {connectedComponentOf, single CC} -setup { + SETUP_F +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 2w] +} -cleanup { + mygraph destroy +} -result {1b 1w 2b 2w 3b 3w 4b 4w} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.8 {connectedComponentOf, single CC} -setup { + SETUP_G +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 3b] +} -cleanup { + mygraph destroy +} -result {1b 1w 2b 2w 3b 3w 4b 4w 5b 5w} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.9 {connectedComponentOf, single CC} -setup { + SETUP_H +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph C] +} -cleanup { + mygraph destroy +} -result {A B C D E} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.10 {connectedComponentOf, single CC} -setup { + SETUP_I +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph N4] +} -cleanup { + mygraph destroy +} -result {N1 N2 N3 N4 N5} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.11.0 {connectedComponentOf, multiple CC} -setup { + SETUP_J +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 4] +} -cleanup { + mygraph destroy +} -result {1 4 5} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.11.1 {connectedComponentOf, multiple CC} -setup { + SETUP_J +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 2] +} -cleanup { + mygraph destroy +} -result 2 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.11.2 {connectedComponentOf, multiple CC} -setup { + SETUP_J +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 3] +} -cleanup { + mygraph destroy +} -result 3 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.11.3 {connectedComponentOf, multiple CC} -setup { + SETUP_J +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph 6] +} -cleanup { + mygraph destroy +} -result {6 7} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.12.0 {connectedComponentOf, multiple CC} -setup { + SETUP_K +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph No3] +} -cleanup { + mygraph destroy +} -result {No1 No2 No3 No4} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponentOf-3.12.1 {connectedComponentOf, multiple CC} -setup { + SETUP_K +} -body { + lsort -dict [struct::graph::op::connectedComponentOf mygraph No5] +} -cleanup { + mygraph destroy +} -result No5 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/components.test b/tcllib/modules/struct/graph/tests/ops/components.test new file mode 100644 index 0000000..c2776b0 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/components.test @@ -0,0 +1,131 @@ +# -*- tcl -*- +# Graph ops tests - Connected components. +# Copyright (c) 2008-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: components.test,v 1.4 2010/09/09 21:48:27 andreas_kupries Exp $ + +# Syntax: struct::graph::op::connectedComponents G + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-1.0 {connectedComponents, wrong args, missing} -body { + struct::graph::op::connectedComponents +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::connectedComponents {g} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-1.1 {connectedComponents, wrong args, too many} -body { + struct::graph::op::connectedComponents g x +} -returnCodes error -result [tcltest::tooManyArgs struct::graph::op::connectedComponents {g}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.0 {connectedComponents, empty graph} -setup { + SETUP +} -body { + struct::graph::op::connectedComponents mygraph +} -cleanup { + mygraph destroy +} -result {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.1 {connectedComponents, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {0 1 2 3 4 5} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.2 {connectedComponents, single CC} -setup { + SETUP_A +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{'node0' 'node1' 'node2' 'node3' 'node4' 'node5' 'node6'}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.3 {connectedComponents, single CC} -setup { + SETUP_B +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{A B C D E S}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.4 {connectedComponents, single CC} -setup { + SETUP_C +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{A B C D E F}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.5 {connectedComponents, single CC} -setup { + SETUP_D +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{a b c d f g h i j}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.6 {connectedComponents, single CC} -setup { + SETUP_E +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{1b 1w 2b 2w 3b 3w 4b 4w 5b 5w 6b 6w 7b 7w 8b 8w}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.7 {connectedComponents, single CC} -setup { + SETUP_F +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{1b 1w 2b 2w 3b 3w 4b 4w}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.8 {connectedComponents, single CC} -setup { + SETUP_G +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{1b 1w 2b 2w 3b 3w 4b 4w 5b 5w}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.9 {connectedComponents, single CC} -setup { + SETUP_H +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{A B C D E}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.10 {connectedComponents, single CC} -setup { + SETUP_I +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{N1 N2 N3 N4 N5}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.11 {connectedComponents, multiple CC} -setup { + SETUP_J +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{1 4 5} 2 3 {6 7}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-connectedComponents-3.12 {connectedComponents, multiple CC} -setup { + SETUP_K +} -body { + setsetcanon [struct::graph::op::connectedComponents mygraph] +} -cleanup { + mygraph destroy +} -result {{No1 No2 No3 No4} No5} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/connected.test b/tcllib/modules/struct/graph/tests/ops/connected.test new file mode 100644 index 0000000..d459636 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/connected.test @@ -0,0 +1,120 @@ +# -*- tcl -*- +# Graph ops tests - Connected components. +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: connected.test,v 1.3 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::isConnected? G + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-1.0 {isConnected?, wrong args, missing} { + catch {struct::graph::op::isConnected?} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::isConnected? {g} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-1.1 {isConnected?, wrong args, too many} { + catch {struct::graph::op::isConnected? g x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::isConnected? {g}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.0 {isConnected?, empty graph} { + SETUP + set result [struct::graph::op::isConnected? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.1 {isConnected?, nodes, no arcs} { + SETUP + mygraph node insert 0 1 2 3 4 5 + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.2 {isConnected?, single CC} { + SETUP_A + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.3 {isConnected?, single CC} { + SETUP_B + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.4 {isConnected?, single CC} { + SETUP_C + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.5 {isConnected?, single CC} { + SETUP_D + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.6 {isConnected?, single CC} { + SETUP_E + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.7 {isConnected?, single CC} { + SETUP_F + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.8 {isConnected?, single CC} { + SETUP_G + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.9 {isConnected?, single CC} { + SETUP_H + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.10 {isConnected?, single CC} { + SETUP_I + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.11 {isConnected?, multiple CC} { + SETUP_J + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isConnected?-3.12 {isConnected?, multiple CC} { + SETUP_K + set result [setsetcanon [struct::graph::op::isConnected? mygraph]] + mygraph destroy + set result +} 0 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/cutvertex.test b/tcllib/modules/struct/graph/tests/ops/cutvertex.test new file mode 100644 index 0000000..d501142 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/cutvertex.test @@ -0,0 +1,97 @@ +# -*- tcl -*- +# Graph ops tests - Connected components II. +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: cutvertex.test,v 1.3 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::isCutVertex? G N + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-1.0 {isCutVertex?, wrong args, missing} { + catch {struct::graph::op::isCutVertex?} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::isCutVertex? {g n} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-1.1 {isCutVertex?, wrong args, missing} { + catch {struct::graph::op::isCutVertex? g} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::isCutVertex? {g n} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-1.2 {isCutVertex?, wrong args, too many} { + catch {struct::graph::op::isCutVertex? g x y} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::isCutVertex? {g n}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-2.0 {isCutVertex?, bad node} { + SETUP + catch {struct::graph::op::isCutVertex? mygraph foo} result + mygraph destroy + set result +} {node "foo" does not exist in graph "mygraph"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.1 {isCutVertex?, nodes, no arcs} { + SETUP + mygraph node insert 0 1 2 3 4 5 + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 0]] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.2 {isCutVertex?} { + SETUP_A + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 'node0']] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.3 {isCutVertex?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 4w]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.3 {isCutVertex?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 4b]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.3 {isCutVertex?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 5w]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.3 {isCutVertex?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 5b]] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.3 {isCutVertex?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 2w]] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isCutVertex?-3.3 {isCutVertex?} { + SETUP_G + set result [lsort -dict [struct::graph::op::isCutVertex? mygraph 3b]] + mygraph destroy + set result +} 0 + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/diameter.test b/tcllib/modules/struct/graph/tests/ops/diameter.test new file mode 100644 index 0000000..606a5e6 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/diameter.test @@ -0,0 +1,45 @@ +# -*- tcl -*- +# Graph ops tests - Dijkstra, distances, diameter +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: diameter.test,v 1.2 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::diameter G ?options? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-diameter-1.0 {diameter, wrong args, missing} { + catch {struct::graph::op::diameter} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::diameter {g args} 0] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +set n 0 +foreach {setup diameter undiameter} { + SETUP_A Inf 8 + SETUP_B Inf 6 +} { + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-diameter-3.$n "diameter, $setup/$node, directed" { + $setup + set result [struct::graph::op::diameter mygraph -arcmode directed] + mygraph destroy + set result + } $diameter + + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-diameter-4.$n "diameter, $setup/$node, undirected" { + $setup + set result [struct::graph::op::diameter mygraph -arcmode undirected] + mygraph destroy + set result + } $undiameter + + incr n +} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/dijkstra.test b/tcllib/modules/struct/graph/tests/ops/dijkstra.test new file mode 100644 index 0000000..e034a26 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/dijkstra.test @@ -0,0 +1,107 @@ +# -*- tcl -*- +# Graph ops tests - Node distances, Dijkstra's algorithm +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: dijkstra.test,v 1.3 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::dijkstra G N ?-arcmode undirected|directed? ?-outputformat tree/distances? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-1.0 {dijkstra, wrong args, missing} { + catch {struct::graph::op::dijkstra} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::dijkstra {g node args} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-1.1 {dijkstra, wrong args, missing} { + catch {struct::graph::op::dijkstra g} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::dijkstra {g node args} 1] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-2.0 {dijkstra, bad node} { + SETUP + catch {struct::graph::op::dijkstra mygraph foo} result + mygraph destroy + set result +} {node "foo" does not exist in graph "mygraph"} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-2.1 {dijkstra, bad option} { + SETUPx + catch {struct::graph::op::dijkstra mygraph %0 -foo bar} result + mygraph destroy + set result +} {Bad option "-foo", expected one of "-arcmode" or "-outputformat"} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-2.2 {dijkstra, bad option value} { + SETUPx + catch {struct::graph::op::dijkstra mygraph %0 -arcmode bar} result + mygraph destroy + set result +} {Bad value for -arcmode, expected one of "directed" or "undirected"} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-2.3 {dijkstra, bad option value} { + SETUPx + catch {struct::graph::op::dijkstra mygraph %0 -outputformat bar} result + mygraph destroy + set result +} {Bad value for -outputformat, expected one of "distances" or "tree"} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-2.4 {dijkstra, bad option value} { + SETUP_A2 + catch {struct::graph::op::dijkstra mygraph 'node0'} result + mygraph destroy + set result +} {Operation invalid for graph with unweighted arcs.} + +# ------------------------------------------------------------------------- +# Ok arguments. + +set n 0 +foreach {setup start distances tree undistances untree} { + SETUP_A 'node0' + {'node0' 0 'node1' 2 'node2' 3 'node3' 1 'node4' 3 'node5' 6 'node6' 5} + {'node0' 'node0' 'node1' 'node0' 'node2' {'node3' 'node0'} 'node3' 'node0' 'node4' {'node3' 'node0'} 'node5' {'node6' 'node3' 'node0'} 'node6' {'node3' 'node0'}} + {'node0' 0 'node1' 2 'node2' 3 'node3' 1 'node4' 3 'node5' 6 'node6' 5} + {'node0' 'node0' 'node1' 'node0' 'node2' {'node3' 'node0'} 'node3' 'node0' 'node4' {'node3' 'node0'} 'node5' {'node6' 'node3' 'node0'} 'node6' {'node3' 'node0'}} + SETUP_A 'node6' + {'node0' Inf 'node1' Inf 'node2' Inf 'node3' Inf 'node4' Inf 'node5' 1 'node6' 0} + {'node5' 'node6' 'node6' 'node6'} + {'node0' 5 'node1' 7 'node2' 6 'node3' 4 'node4' 6 'node5' 1 'node6' 0} + {'node0' {'node3' 'node6'} 'node1' {'node3' 'node6'} 'node2' {'node5' 'node6'} 'node3' 'node6' 'node4' 'node6' 'node5' 'node6' 'node6' 'node6'} +} { + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-3.$n "dijkstra, $setup/$start, distances/directed" { + $setup + set result [dictsort [struct::graph::op::dijkstra mygraph $start -arcmode directed -outputformat distances]] + mygraph destroy + set result + } $distances + + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-4.$n "dijkstra, $setup/$start, tree/directed" { + $setup + set result [dictsort [struct::graph::op::dijkstra mygraph $start -arcmode directed -outputformat tree]] + mygraph destroy + set result + } $tree + + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-5.$n "dijkstra, $setup/$start, distances/undirected" { + $setup + set result [dictsort [struct::graph::op::dijkstra mygraph $start -arcmode undirected -outputformat distances]] + mygraph destroy + set result + } $undistances + + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-dijkstra-6.$n "dijkstra, $setup/$start, tree/undirected" { + $setup + set result [dictsort [struct::graph::op::dijkstra mygraph $start -arcmode undirected -outputformat tree]] + mygraph destroy + set result + } $untree + + incr n +} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/dinicblockingflow.test b/tcllib/modules/struct/graph/tests/ops/dinicblockingflow.test new file mode 100644 index 0000000..725b459 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/dinicblockingflow.test @@ -0,0 +1,70 @@ +# -*- tcl -*- +#Blocking flow by MKM - Tests +# +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-1.0 { graph simulation } { + SETUP_BLOCKINGFLOW_1 + set result [dictsort [struct::graph::op::BlockingFlowByDinic mygraph s t]] + mygraph destroy + set result +} {{s v1} 3 {s v3} 2 {v1 v2} 2 {v1 v4} 1 {v2 v5} 2 {v3 v4} 1 {v3 v6} 1 {v4 v5} 1 {v4 v7} 1 {v5 t} 3 {v6 v7} 1 {v7 t} 2} + +# {{v1 v4} 1 {v2 v5} 2 {v3 v4} 1 {v3 v6} 1 {v4 v5} 1 {v5 t} 3 {v4 v7} 1 {v7 t} 2 {v6 v7} 1 {s v1} 3 {s v3} 2 {v1 v2} 2} + +#Test 1.1 - case when input residual graph is created from network that hasn't any flows yet +#Tcl does a 4/6 split at 1, C does a 2/8 split at 1. +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-1.1 { graph simulation } { + SETUP_MAXIMUMFLOW_1 + set result [dictsort [struct::graph::op::BlockingFlowByDinic mygraph s t]] + mygraph destroy + set result +} [tmE \ + {{s v1} 10 {s v2} 4 {v1 v3} 4 {v1 v4} 6 {v2 v4} 4 {v3 t} 4 {v4 t} 10} \ + {{s v1} 10 {s v2} 2 {v1 v3} 2 {v1 v4} 8 {v2 v4} 2 {v3 t} 2 {v4 t} 10}] + +#Test 1.2 - case when input residual graph is created from network that has already some flows used in it +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-1.2 { graph simulation } { + SETUP_BLOCKINGFLOW_2 + set result [dictsort [struct::graph::op::BlockingFlowByDinic mygraph s t]] + mygraph destroy + set result +} {{s v2} 5 {v2 v4} 5 {v3 t} 5 {v4 v3} 5} + +#Test 1.3 - case when from residual graph we get level graph with no arcs - the blocking flow is not found +#cause there are no paths between sink and source in residual graph. +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-1.3 { graph simulation } { + SETUP_BLOCKINGFLOW_3 + set result [dictsort [struct::graph::op::BlockingFlowByDinic mygraph s t]] + mygraph destroy + set result +} {} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-2.0 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::BlockingFlowByDinic} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BlockingFlowByDinic {G s t} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-2.1 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::BlockingFlowByDinic G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BlockingFlowByDinic {G s t} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-2.2 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::BlockingFlowByDinic G s} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BlockingFlowByDinic {G s t} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowDinic-2.3 { BlockingFlow, wrong args, too many} { + catch {struct::graph::op::BlockingFlowByDinic G y x z} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::BlockingFlowByDinic {G s t}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + diff --git a/tcllib/modules/struct/graph/tests/ops/dinicmaximumflow.test b/tcllib/modules/struct/graph/tests/ops/dinicmaximumflow.test new file mode 100644 index 0000000..ce069ec --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/dinicmaximumflow.test @@ -0,0 +1,137 @@ +# -*- tcl -*- +#Dinic's algorithm for computing maximum flow in flow network - Tests +# +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.0 { graph simulation } { + SETUP_MAXIMUMFLOW_1 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t dinic]] + mygraph destroy + set result +} {{s v1} 10 {s v2} 9 {v1 v3} 4 {v1 v4} 6 {v2 v4} 9 {v3 t} 9 {v4 t} 10 {v4 v3} 5} + +#Test 1.1 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.1 { graph simulation } { + SETUP_MAXIMUMFLOW_1 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t mkm]] + mygraph destroy + set result +} {{s v1} 10 {s v2} 9 {v1 v3} 4 {v1 v4} 6 {v2 v4} 9 {v3 t} 9 {v4 t} 10 {v4 v3} 5} + +#Test 1.2 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.2 { graph simulation } { + SETUP_FORDFULKERSON_1 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t mkm]] + mygraph destroy + set result +} {{s v1} 12 {s v2} 11 {v1 v3} 12 {v2 v4} 11 {v3 t} 19 {v4 t} 4 {v4 v3} 7} + +#Test 1.3 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.3 { graph simulation } { + SETUP_FORDFULKERSON_2 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph a d mkm]] + mygraph destroy + set result +} {{a b} 1000000 {a c} 1000000 {b d} 1000000 {c d} 1000000} + +#Test 1.4 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.4 { graph simulation } { + SETUP_FORDFULKERSON_3 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t mkm]] + mygraph destroy + set result +} {{s v1} 6 {s v2} 5 {s v3} 3 {v1 t} 3 {v1 v2} 3 {v2 t} 8 {v3 t} 3} + +#Test 1.5 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.5 { graph simulation } { + SETUP_FORDFULKERSON_4 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t mkm]] + mygraph destroy + set result +} {{s v1} 4 {s v2} 5 {s v3} 3 {v1 t} 3 {v1 v2} 1 {v2 t} 6 {v3 t} 3} + +#Test 1.6 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.6 { graph simulation } { + SETUP_FORDFULKERSON_5 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t mkm]] + mygraph destroy + set result +} {{s v1} 6.5 {s v2} 5.5 {s v3} 3.5 {v1 t} 3.1 {v1 v2} 3.4000000000000004 {v2 t} 8.9 {v3 t} 3.5} + +#Test 1.7 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.7 { graph simulation } { + SETUP_FORDFULKERSON_1 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t dinic]] + mygraph destroy + set result +} {{s v1} 12 {s v2} 11 {v1 v3} 12 {v2 v4} 11 {v3 t} 19 {v4 t} 4 {v4 v3} 7} + +#Test 1.8 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.8 { graph simulation } { + SETUP_FORDFULKERSON_2 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph a d dinic]] + mygraph destroy + set result +} {{a b} 1000000 {a c} 1000000 {b d} 1000000 {c d} 1000000} + +#Test 1.9 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.9 { graph simulation } { + SETUP_FORDFULKERSON_3 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t dinic]] + mygraph destroy + set result +} {{s v1} 6 {s v2} 5 {s v3} 3 {v1 t} 3 {v1 v2} 3 {v2 t} 8 {v3 t} 3} + +#Test 1.10 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.10 { graph simulation } { + SETUP_FORDFULKERSON_4 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t dinic]] + mygraph destroy + set result +} {{s v1} 4 {s v2} 5 {s v3} 3 {v1 t} 3 {v1 v2} 1 {v2 t} 6 {v3 t} 3} + +#Test 1.11 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-1.11 { graph simulation } { + SETUP_FORDFULKERSON_5 + set result [dictsort [struct::graph::op::MaximumFlowByDinic mygraph s t dinic]] + mygraph destroy + set result +} {{s v1} 6.5 {s v2} 5.5 {s v3} 3.5 {v1 t} 3.1 {v1 v2} 3.4000000000000004 {v2 t} 8.9 {v3 t} 3.5} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-2.0 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::MaximumFlowByDinic} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MaximumFlowByDinic {G s t blockingFlowAlg} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-2.1 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::MaximumFlowByDinic G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MaximumFlowByDinic {G s t blockingFlowAlg} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-2.2 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::MaximumFlowByDinic G s} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MaximumFlowByDinic {G s t blockingFlowAlg} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-2.3 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::MaximumFlowByDinic G s t} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MaximumFlowByDinic {G s t blockingFlowAlg} 3] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-2.4 { BlockingFlow, wrong args, too many} { + catch {struct::graph::op::MaximumFlowByDinic G a b c d} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::MaximumFlowByDinic {G s t blockingFlowAlg}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-DinicMaximumFlow-3.0 { bad value of blocking flow algorithm variable } { + catch {struct::graph::op::MaximumFlowByDinic G s t blockingFlowAlg} msg + set msg +} "Uncorrect name of blocking flow algorithm. Choose \"mkm\" for Malhotra, Kumar and Maheshwari algorithm and \"dinic\" for Dinic algorithm." diff --git a/tcllib/modules/struct/graph/tests/ops/distance.test b/tcllib/modules/struct/graph/tests/ops/distance.test new file mode 100644 index 0000000..7317238 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/distance.test @@ -0,0 +1,70 @@ +# -*- tcl -*- +# Graph ops tests - Dijkstra, distances +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: distance.test,v 1.2 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::distance G N N' ?options? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-distance-1.0 {distance, wrong args, missing} { + catch {struct::graph::op::distance} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::distance {g origin destination args} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-distance-1.1 {distance, wrong args, missing} { + catch {struct::graph::op::distance g} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::distance {g origin destination args} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-distance-1.2 {distance, wrong args, missing} { + catch {struct::graph::op::distance g o} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::distance {g origin destination args} 2] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-distance-2.0 {distance, bad node} { + SETUP + catch {struct::graph::op::distance mygraph foo bar} result + mygraph destroy + set result +} {node "foo" does not exist in graph "mygraph"} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-distance-2.1 {distance, bad node} { + SETUP + mygraph node insert foo + catch {struct::graph::op::distance mygraph foo bar} result + mygraph destroy + set result +} {node "bar" does not exist in graph "mygraph"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +set n 0 +foreach {setup origin destination distance undistance} { + SETUP_A 'node0' 'node6' 5 5 + SETUP_A 'node0' 'node0' 0 0 +} { + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-distance-3.$n "distance, $setup/$origin/$destination, directed" { + $setup + set result [struct::graph::op::distance mygraph $origin $destination -arcmode directed] + mygraph destroy + set result + } $distance + + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-distance-4.$n "distance, $setup/$origin/$destination, undirected" { + $setup + set result [struct::graph::op::distance mygraph $origin $destination -arcmode undirected] + mygraph destroy + set result + } $undistance + + incr n +} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/eccentricity.test b/tcllib/modules/struct/graph/tests/ops/eccentricity.test new file mode 100644 index 0000000..939d7c2 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/eccentricity.test @@ -0,0 +1,57 @@ +# -*- tcl -*- +# Graph ops tests - Dijkstra, distances, eccentricity. +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: eccentricity.test,v 1.2 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::eccentricity G N ?options? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-eccentricity-1.0 {eccentricity, wrong args, missing} { + catch {struct::graph::op::eccentricity} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::eccentricity {g node args} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-eccentricity-1.1 {eccentricity, wrong args, missing} { + catch {struct::graph::op::eccentricity g} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::eccentricity {g node args} 1] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-eccentricity-2.0 {eccentricity, bad node} { + SETUP + catch {struct::graph::op::eccentricity mygraph foo} result + mygraph destroy + set result +} {node "foo" does not exist in graph "mygraph"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +set n 0 +foreach {setup node eccentricity uneccentricity} { + SETUP_A 'node0' 6 6 + SETUP_A 'node6' Inf 7 +} { + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-eccentricity-3.$n "eccentricity, $setup/$node, directed" { + $setup + set result [struct::graph::op::eccentricity mygraph $node -arcmode directed] + mygraph destroy + set result + } $eccentricity + + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-eccentricity-4.$n "eccentricity, $setup/$node, undirected" { + $setup + set result [struct::graph::op::eccentricity mygraph $node -arcmode undirected] + mygraph destroy + set result + } $uneccentricity + + incr n +} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/edmondskarp.test b/tcllib/modules/struct/graph/tests/ops/edmondskarp.test new file mode 100644 index 0000000..d01fbca --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/edmondskarp.test @@ -0,0 +1,195 @@ +# -*- tcl -*- +#Edmonds Karp algorithm - computing maximum flow in a flow network +# +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +# ------------------------------------------------------------------------------------ +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.0 { graph simulation } { + SETUP_FORDFULKERSON_1 + set result [dictsort [struct::graph::op::FordFulkerson mygraph s t]] + mygraph destroy + set result +} {{s v1} 12 {s v2} 11 {v1 v3} 12 {v2 v4} 11 {v3 t} 19 {v4 t} 4 {v4 v3} 7} + +#Test 1.1 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.1 { graph simulation } { + SETUP_FORDFULKERSON_2 + set result [dictsort [struct::graph::op::FordFulkerson mygraph a d]] + mygraph destroy + set result +} {{a b} 1000000 {a c} 1000000 {b d} 1000000 {c d} 1000000} + +#Test 1.2 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.2 { graph simulation } { + SETUP_FORDFULKERSON_3 + set result [dictsort [struct::graph::op::FordFulkerson mygraph s t]] + mygraph destroy + set result +} {{s v1} 6 {s v2} 5 {s v3} 3 {v1 t} 3 {v1 v2} 3 {v2 t} 8 {v3 t} 3} + +#Test 1.3 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.3 { graph simulation } { + SETUP_FORDFULKERSON_4 + set result [dictsort [struct::graph::op::FordFulkerson mygraph s t]] + mygraph destroy + set result +} {{s v1} 4 {s v2} 5 {s v3} 3 {v1 t} 3 {v1 v2} 1 {v2 t} 6 {v3 t} 3} + +#Test 1.4 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.4 { graph simulation } { + SETUP_FORDFULKERSON_5 + set result [dictsort [struct::graph::op::FordFulkerson mygraph s t]] + mygraph destroy + set result +} {{s v1} 6.5 {s v2} 5.5 {s v3} 3.5 {v1 t} 3.1 {v1 v2} 3.4000000000000004 {v2 t} 8.9 {v3 t} 3.5} + +#Test 1.5 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.5 { graph simulation } -setup { + SETUP_FORDFULKERSON_1 + set output {} + foreach arc [mygraph arcs] { + set u [mygraph arc source $arc] + set v [mygraph arc target $arc] + dict set f [list $u $v] 0 + dict set f [list $v $u] 0 + } +} -body { + set result [struct::graph::op::createResidualGraph mygraph $f] + foreach arc [$result arcs] { + set throughput [$result arc get $arc throughput] + if { $throughput } { + dict set output $arc $throughput + } + } + dictsort $output +} -cleanup { + unset throughput output f arc u v + $result destroy + mygraph destroy +} -result {{s v1} 16 {s v2} 13 {v1 v2} 10 {v1 v3} 12 {v2 v1} 4 {v2 v4} 14 {v3 t} 20 {v3 v2} 9 {v4 t} 4 {v4 v3} 7} + +#Test 1.6 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.6 { graph simulation } -setup { + SETUP_FORDFULKERSON_1 + set output {} + set f [SETUP_FLOWS_1 mygraph] +} -body { + set result [struct::graph::op::createResidualGraph mygraph $f] + foreach arc [$result arcs] { + set throughput [$result arc get $arc throughput] + if { $throughput } { + dict set output $arc $throughput + } + } + dictsort $output +} -cleanup { + unset throughput output f arc + $result destroy + mygraph destroy +} -result {{s v1} 12 {s v2} 13 {t v4} 4 {v1 s} 4 {v1 v2} 10 {v1 v3} 8 {v2 v1} 4 {v2 v3} 4 {v2 v4} 10 {v3 t} 20 {v3 v1} 4 {v3 v2} 5 {v4 v2} 4 {v4 v3} 7} + +#Test 1.7 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.7 { graph simulation } -setup { + SETUP_FORDFULKERSON_1 + set output {} + set f [SETUP_FLOWS_2 mygraph] +} -body { + set result [struct::graph::op::createResidualGraph mygraph $f] + foreach arc [$result arcs] { + set throughput [$result arc get $arc throughput] + if { $throughput } { + dict set output $arc $throughput + } + } + dictsort $output +} -cleanup { + unset throughput output f arc + $result destroy + mygraph destroy +} -result {{s v1} 5 {s v2} 13 {t v3} 7 {t v4} 4 {v1 s} 11 {v1 v2} 3 {v1 v3} 8 {v2 v1} 11 {v2 v3} 4 {v2 v4} 3 {v3 t} 13 {v3 v1} 4 {v3 v2} 5 {v3 v4} 7 {v4 v2} 11} + +#Test 1.8 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.8 { graph simulation } -setup { + SETUP_FORDFULKERSON_1 + set output {} + set f [SETUP_FLOWS_3 mygraph] +} -body { + set result [struct::graph::op::createResidualGraph mygraph $f] + foreach arc [$result arcs] { + set throughput [$result arc get $arc throughput] + if { $throughput } { + dict set output $arc $throughput + } + } + dictsort $output +} -cleanup { + unset throughput output f arc + $result destroy + mygraph destroy +} -result {{s v1} 5 {s v2} 5 {t v3} 15 {t v4} 4 {v1 s} 11 {v1 v2} 11 {v2 s} 8 {v2 v1} 3 {v2 v3} 4 {v2 v4} 3 {v3 t} 5 {v3 v1} 12 {v3 v2} 5 {v3 v4} 7 {v4 v2} 11} + +#Test 1.9 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-1.9 { graph simulation } -setup { + SETUP_FORDFULKERSON_1 + set output {} + set f [SETUP_FLOWS_4 mygraph] +} -body { + set result [struct::graph::op::createResidualGraph mygraph $f] + foreach arc [$result arcs] { + set throughput [$result arc get $arc throughput] + if { $throughput } { + dict set output $arc $throughput + } + } + dictsort $output +} -cleanup { + unset throughput output f arc + $result destroy + mygraph destroy +} -result {{s v1} 5 {s v2} 1 {t v3} 19 {t v4} 4 {v1 s} 11 {v1 v2} 11 {v2 s} 12 {v2 v1} 3 {v2 v4} 3 {v3 t} 1 {v3 v1} 12 {v3 v2} 9 {v3 v4} 7 {v4 v2} 11} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-2.0 { FordFulkerson, wrong args, missing } { + catch {struct::graph::op::FordFulkerson} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::FordFulkerson {G s t} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-2.1 { FordFulkerson, wrong args, missing } { + catch {struct::graph::op::FordFulkerson G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::FordFulkerson {G s t} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-2.2 { FordFulkerson, wrong args, missing } { + catch {struct::graph::op::FordFulkerson G s} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::FordFulkerson {G s t} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-2.3 { FordFulkerson, wrong args, too many} { + catch {struct::graph::op::FordFulkerson G s t z} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::FordFulkerson {G s t}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when sink and source nodes given at input aren't nodes of input graph +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-3.0 {FordFulkerson, wrong sink or source } { + SETUP_FORDFULKERSON_1 + catch {struct::graph::op::FordFulkerson mygraph a b } result + mygraph destroy + set result +} [LackOfSinkOrSource a b] + +#Test 3.1 - case when input network has lacking attributes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FordFulkerson-3.1 {FordFulkerson, missing attributes } { + SETUP_BUSACKERGOWEN_2 + catch {struct::graph::op::FordFulkerson mygraph s t } result + mygraph destroy + set result +} [WrongAttributes throughput] + diff --git a/tcllib/modules/struct/graph/tests/ops/eulerpath.test b/tcllib/modules/struct/graph/tests/ops/eulerpath.test new file mode 100644 index 0000000..1ddcdff --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/eulerpath.test @@ -0,0 +1,215 @@ +# -*- tcl -*- +# Graph ops tests - Euler tours. +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: eulerpath.test,v 1.4 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::isSemiEulerian? G A + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many +if 0 { +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-1.0 {isSemiEulerian?, wrong args, missing} { + catch {struct::graph::op::isSemiEulerian?} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::isSemiEulerian? {g ?eulervar?} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-1.1 {isSemiEulerian?, wrong args, too many} { + catch {struct::graph::op::isSemiEulerian? g x y} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::isSemiEulerian? {g ?eulervar?}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.0 {isSemiEulerian?, empty graph} { + SETUP + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.1 {isSemiEulerian?, nodes, no arcs} { + SETUP + mygraph node insert 0 1 2 3 4 5 + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.2 {isSemiEulerian?} { + SETUP_A + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.3 {isSemiEulerian?} { + SETUP_B + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.4 {isSemiEulerian?} { + SETUP_B2 + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.5 {isSemiEulerian?} { + SETUP_C + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.6 {isSemiEulerian?} { + SETUP_D + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.7 {isSemiEulerian?} { + SETUP_E + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.8 {isSemiEulerian?} { + SETUP_F + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.9 {isSemiEulerian?} { + SETUP_G + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.10 {isSemiEulerian?} { + SETUP_H + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.11 {isSemiEulerian?} { + SETUP_I + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.12 {isSemiEulerian?} { + SETUP_J + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.13 {isSemiEulerian?} { + SETUP_K + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.14 {isSemiEulerian?} { + SETUP_K2 + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.15 {isSemiEulerian?} { + SETUP_L + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.16 {isSemiEulerian?} { + SETUP_M + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-3.17 {isSemiEulerian?} { + SETUP_N + set result [struct::graph::op::isSemiEulerian? mygraph] + mygraph destroy + set result +} 1 + +# --------------------------------------------------- + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-4.3 {isSemiEulerian?, and path} { + SETUP_B + set result [struct::graph::op::isSemiEulerian? mygraph path] + lappend result [EulerPath mygraph $path] + mygraph destroy + set result +} {1 ok} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-4.4 {isSemiEulerian?, and path} { + SETUP_B2 + set result [struct::graph::op::isSemiEulerian? mygraph path] + lappend result [EulerPath mygraph $path] + mygraph destroy + set result +} {1 ok} +} +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-4.5 {isSemiEulerian?, and path} -setup { + SETUP_C +} -body { + set result [struct::graph::op::isSemiEulerian? mygraph path] + lappend result [EulerPath mygraph $path] + set result +} -cleanup { + mygraph destroy +} -result {1 ok} +if 0 { +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-4.10 {isSemiEulerian?, and path} { + SETUP_H + set result [struct::graph::op::isSemiEulerian? mygraph path] + lappend result [EulerPath mygraph $path] + mygraph destroy + set result +} {1 ok} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-4.14 {isSemiEulerian?, and path} { + SETUP_K2 + set result [struct::graph::op::isSemiEulerian? mygraph path] + lappend result [EulerPath mygraph $path] + mygraph destroy + set result +} {1 ok} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-4.16 {isSemiEulerian?, and path} { + SETUP_M + set result [struct::graph::op::isSemiEulerian? mygraph path] + lappend result [EulerPath mygraph $path] + mygraph destroy + set result +} {1 ok} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isSemiEulerian?-4.17 {isSemiEulerian?, and path} { + SETUP_N + set result [struct::graph::op::isSemiEulerian? mygraph path] + lappend result [EulerPath mygraph $path] + mygraph destroy + set result +} {1 ok} +} +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/eulertour.test b/tcllib/modules/struct/graph/tests/ops/eulertour.test new file mode 100644 index 0000000..cfada68 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/eulertour.test @@ -0,0 +1,189 @@ +# -*- tcl -*- +# Graph ops tests - Euler tours. +# Copyright (c) 2008-2009 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: eulertour.test,v 1.4 2009/09/21 23:48:03 andreas_kupries Exp $ + +# Syntax: struct::graph::op::isEulerian? G A + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-1.0 {isEulerian?, wrong args, missing} { + catch {struct::graph::op::isEulerian?} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::isEulerian? {g ?eulervar? ?tourstart?} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-1.1 {isEulerian?, wrong args, too many} { + catch {struct::graph::op::isEulerian? g x y z} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::isEulerian? {g ?eulervar? ?tourstart?}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.0 {isEulerian?, empty graph} { + SETUP + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.1 {isEulerian?, nodes, no arcs} { + SETUP + mygraph node insert 0 1 2 3 4 5 + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.2 {isEulerian?} { + SETUP_A + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.3 {isEulerian?} { + SETUP_B + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.4 {isEulerian?} { + SETUP_B2 + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.5 {isEulerian?} { + SETUP_C + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.6 {isEulerian?} { + SETUP_D + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.7 {isEulerian?} { + SETUP_E + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.8 {isEulerian?} { + SETUP_F + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.9 {isEulerian?} { + SETUP_G + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.10 {isEulerian?} { + SETUP_H + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.11 {isEulerian?} { + SETUP_I + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.12 {isEulerian?} { + SETUP_J + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.13 {isEulerian?} { + SETUP_K + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.14 {isEulerian?} { + SETUP_K2 + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.15 {isEulerian?} { + SETUP_L + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 0 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.16 {isEulerian?} { + SETUP_M + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 1 + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.17 {isEulerian?} { + SETUP_N + set result [struct::graph::op::isEulerian? mygraph] + mygraph destroy + set result +} 1 + +# --------------------------------------------------- + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-4.4 {isEulerian?, and tour} { + SETUP_B2 + set result [struct::graph::op::isEulerian? mygraph tour] + lappend result [EulerTour mygraph $tour] + mygraph destroy + set result +} {1 ok} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-4.14 {isEulerian?, and tour} { + SETUP_K2 + set result [struct::graph::op::isEulerian? mygraph tour] + lappend result [EulerTour mygraph $tour] + mygraph destroy + set result +} {1 ok} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-3.16 {isEulerian?, and tour} { + SETUP_M + set result [struct::graph::op::isEulerian? mygraph tour] + lappend result [EulerTour mygraph $tour] + mygraph destroy + set result +} {1 ok} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-isEulerian?-4.17 {isEulerian?, and tour} { + SETUP_N + set result [struct::graph::op::isEulerian? mygraph tour] + lappend result [EulerTour mygraph $tour] + mygraph destroy + set result +} {1 ok} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/floydwarshall.test b/tcllib/modules/struct/graph/tests/ops/floydwarshall.test new file mode 100644 index 0000000..cf103a9 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/floydwarshall.test @@ -0,0 +1,124 @@ +# -*- tcl -*- +#Floyd-Warshall's Algorithm - Tests +# +#Searching distances between all nodes. + +#------------------------------------------------------------------------------------ +#Tests concerning returning right values by algorithm + +#Test 1.0 - special case for pathfinding algorithm. +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.0 { FloydWarshall, graph simulation } { + SETUP_BELLMANFORD_1 + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} 1 {node1 node3} 2 {node1 node4} 3 {node2 node1} 3 {node2 node2} 0 {node2 node3} 1 {node2 node4} 2 {node3 node1} 2 {node3 node2} 3 {node3 node3} 0 {node3 node4} 1 {node4 node1} 1 {node4 node2} 2 {node4 node3} 3 {node4 node4} 0} + +#Tests 1.1 - 1.3 - Test cases when there occur existance of cycle with negative sum of weights at edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.1 { FloydWarshall, negative cycles } { + SETUP_NEGATIVECYCLE_1 + catch { struct::graph::op::FloydWarshall mygraph} result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.2 { FloydWarshall, negative cycles } { + SETUP_NEGATIVECYCLE_2 + catch { struct::graph::op::FloydWarshall mygraph } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.3 { FloydWarshall, negative cycles } { + SETUP_NEGATIVECYCLE_3 + catch { struct::graph::op::FloydWarshall mygraph } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +#Test 1.4 - case when we are given a graph without any edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.4 { FloydWarshall, no edges } { + SETUP_NOEDGES_1 + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} Inf {node1 node3} Inf {node1 node4} Inf {node2 node1} Inf {node2 node2} 0 {node2 node3} Inf {node2 node4} Inf {node3 node1} Inf {node3 node2} Inf {node3 node3} 0 {node3 node4} Inf {node4 node1} Inf {node4 node2} Inf {node4 node3} Inf {node4 node4} 0} + +#Test 1.5 - case when we are given a graph with all edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.5 { FloydWarshall, all weights set to 0 } { + SETUP_ZEROWEIGHTED_K4 + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} 0 {node1 node3} 0 {node1 node4} 0 {node2 node1} 0 {node2 node2} 0 {node2 node3} 0 {node2 node4} 0 {node3 node1} 0 {node3 node2} 0 {node3 node3} 0 {node3 node4} 0 {node4 node1} 0 {node4 node2} 0 {node4 node3} 0 {node4 node4} 0} + +#Test 1.6 - case when we are given a graph with some edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.6 { FloydWarshall, some weights set to 0 } { + SETUP_PARTIALLYZEROWEIGHTED + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} 0 {node1 node3} 0 {node1 node4} 1 {node2 node1} 2 {node2 node2} 0 {node2 node3} 0 {node2 node4} 1 {node3 node1} 2 {node3 node2} 2 {node3 node3} 0 {node3 node4} 1 {node4 node1} 1 {node4 node2} 1 {node4 node3} 1 {node4 node4} 0} + +#Test 1.7 - case when we are given a complete K4 graph with some edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.7 { FloydWarshall, some weights set to 0 } { + SETUP_PARTIALLYZEROWEIGHTED_K4 + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} 0 {node1 node3} 0 {node1 node4} 0 {node2 node1} 0 {node2 node2} 0 {node2 node3} 0 {node2 node4} 0 {node3 node1} 0 {node3 node2} 0 {node3 node3} 0 {node3 node4} 0 {node4 node1} 0 {node4 node2} 0 {node4 node3} 0 {node4 node4} 0} + +#Tests 1.8 - 1.10 - counting right values for special cases of graphs +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.8 { FloydWarshall, graph simulation } { + SETUP_JOHNSONS_1 + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} -4 {node1 node3} 1 {node1 node4} -1 {node1 node5} 3 {node2 node1} 4 {node2 node2} 0 {node2 node3} 5 {node2 node4} 3 {node2 node5} 7 {node3 node1} -1 {node3 node2} -5 {node3 node3} 0 {node3 node4} -2 {node3 node5} 2 {node4 node1} 5 {node4 node2} 1 {node4 node3} 6 {node4 node4} 0 {node4 node5} 8 {node5 node1} 1 {node5 node2} -3 {node5 node3} 2 {node5 node4} -4 {node5 node5} 0} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.9 { FloydWarshall, graph simulation } { + SETUP_JOHNSONS_2 + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} 8 {node1 node3} 7 {node1 node4} 5 {node1 node5} 3 {node1 node6} 5 {node2 node1} Inf {node2 node2} 0 {node2 node3} -1 {node2 node4} -3 {node2 node5} -5 {node2 node6} -3 {node3 node1} Inf {node3 node2} 1 {node3 node3} 0 {node3 node4} -2 {node3 node5} -4 {node3 node6} -2 {node4 node1} Inf {node4 node2} Inf {node4 node3} Inf {node4 node4} 0 {node4 node5} Inf {node4 node6} Inf {node5 node1} Inf {node5 node2} Inf {node5 node3} Inf {node5 node4} 2 {node5 node5} 0 {node5 node6} Inf {node6 node1} Inf {node6 node2} 3 {node6 node3} 2 {node6 node4} 0 {node6 node5} -2 {node6 node6} 0} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-1.10 { FloydWarshall, graph simulation } { + SETUP_BELLMANFORD_2 + set result [dictsort [struct::graph::op::FloydWarshall mygraph]] + mygraph destroy + set result +} {{node1 node1} 0 {node1 node2} 8 {node1 node3} 5 {node1 node4} 7 {node1 node5} 3 {node1 node6} 5 {node2 node1} Inf {node2 node2} 0 {node2 node3} -3 {node2 node4} -1 {node2 node5} -5 {node2 node6} -3 {node3 node1} Inf {node3 node2} 3 {node3 node3} 0 {node3 node4} 2 {node3 node5} -2 {node3 node6} 0 {node4 node1} Inf {node4 node2} 1 {node4 node3} -2 {node4 node4} 0 {node4 node5} -4 {node4 node6} -2 {node5 node1} Inf {node5 node2} Inf {node5 node3} Inf {node5 node4} Inf {node5 node5} 0 {node5 node6} 2 {node6 node1} Inf {node6 node2} Inf {node6 node3} Inf {node6 node4} Inf {node6 node5} Inf {node6 node6} 0} +# + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-2.0 { FloydWarshall, wrong args, missing } { + catch {struct::graph::op::FloydWarshall} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::FloydWarshall {G} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-2.1 { FloydWarshall, wrong args, too many} { + catch {struct::graph::op::FloydWarshall G y x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::FloydWarshall {G}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-3.0 {FloydWarshall, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::FloydWarshall mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.1 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-FloydWarshall-3.1 {FloydWarshall, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::FloydWarshall mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] diff --git a/tcllib/modules/struct/graph/tests/ops/johnsons.test b/tcllib/modules/struct/graph/tests/ops/johnsons.test new file mode 100644 index 0000000..8a19d8b --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/johnsons.test @@ -0,0 +1,130 @@ +# -*- tcl -*- +#Johnson's Algorithm - Tests +# +#Searching distances between all pairs of nodes + +#------------------------------------------------------------------------------------ +#Tests concerning returning right values by algorithm + + +#Tests 1.0 and 1.1 - couting right values for special cases of graphs +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.0 { Johnsons, graph simulation } { + SETUP_JOHNSONS_1 + set result [dictsort [struct::graph::op::Johnsons mygraph]] + mygraph destroy + set result +} {{node1 node2} -4 {node1 node3} 1 {node1 node4} -1 {node1 node5} 3 {node2 node1} 4 {node2 node3} 5 {node2 node4} 3 {node2 node5} 7 {node3 node1} -1 {node3 node2} -5 {node3 node4} -2 {node3 node5} 2 {node4 node1} 5 {node4 node2} 1 {node4 node3} 6 {node4 node5} 8 {node5 node1} 1 {node5 node2} -3 {node5 node3} 2 {node5 node4} -4} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.1 { Johnsons, graph simulation } { + SETUP_JOHNSONS_2 + set result [dictsort [struct::graph::op::Johnsons mygraph]] + mygraph destroy + set result +} {{node1 node2} 8 {node1 node3} 7 {node1 node4} 5 {node1 node5} 3 {node1 node6} 5 {node2 node1} Inf {node2 node3} -1 {node2 node4} -3 {node2 node5} -5 {node2 node6} -3 {node3 node1} Inf {node3 node2} 1 {node3 node4} -2 {node3 node5} -4 {node3 node6} -2 {node4 node1} Inf {node4 node2} Inf {node4 node3} Inf {node4 node5} Inf {node4 node6} Inf {node5 node1} Inf {node5 node2} Inf {node5 node3} Inf {node5 node4} 2 {node5 node6} Inf {node6 node1} Inf {node6 node2} 3 {node6 node3} 2 {node6 node4} 0 {node6 node5} -2} + +#Tests 1.2 and 1.3 - based on the same graphs as previous tests but checking the return value when using option -cutdisplay +#1.2 - cutting from return value 'Inf' ( returned when connection between two nodes doesn't exist ) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.2 { Johnsons, graph simulation, cutted display} { + SETUP_JOHNSONS_2 + set result [dictsort [struct::graph::op::Johnsons mygraph -filter]] + mygraph destroy + set result +} {{node1 node2} 8 {node1 node3} 7 {node1 node4} 5 {node1 node5} 3 {node1 node6} 5 {node2 node3} -1 {node2 node4} -3 {node2 node5} -5 {node2 node6} -3 {node3 node2} 1 {node3 node4} -2 {node3 node5} -4 {node3 node6} -2 {node5 node4} 2 {node6 node2} 3 {node6 node3} 2 {node6 node4} 0 {node6 node5} -2} + +#1.3 - case when there are no 'Inf' values and we use -cutdisplay option. +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.3 { Johnsons, graph simulation, cutted display } { + SETUP_JOHNSONS_1 + set result [dictsort [struct::graph::op::Johnsons mygraph]] + mygraph destroy + set result +} {{node1 node2} -4 {node1 node3} 1 {node1 node4} -1 {node1 node5} 3 {node2 node1} 4 {node2 node3} 5 {node2 node4} 3 {node2 node5} 7 {node3 node1} -1 {node3 node2} -5 {node3 node4} -2 {node3 node5} 2 {node4 node1} 5 {node4 node2} 1 {node4 node3} 6 {node4 node5} 8 {node5 node1} 1 {node5 node2} -3 {node5 node3} 2 {node5 node4} -4} + +#Tests 1.4 - 1.6 - Test cases when there occur existance of cycle with negative sum of weights at edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.4 { Johnsons, negative cycles } { + SETUP_NEGATIVECYCLE_1 + catch { struct::graph::op::Johnsons mygraph } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.5 { Johnsons, negative cycles } { + SETUP_NEGATIVECYCLE_2 + catch { struct::graph::op::Johnsons mygraph } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.6 { Johnsons, negative cycles } { + SETUP_NEGATIVECYCLE_3 + catch { struct::graph::op::Johnsons mygraph } result + mygraph destroy + set result +} [NegativeCycleOccurance {mygraph}] + +#Test 1.7 - case when we are given a graph without any edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.7 { Johnsons, no edges } { + SETUP_NOEDGES_1 + set result [dictsort [struct::graph::op::Johnsons mygraph]] + mygraph destroy + set result +} {{node1 node2} Inf {node1 node3} Inf {node1 node4} Inf {node2 node1} Inf {node2 node3} Inf {node2 node4} Inf {node3 node1} Inf {node3 node2} Inf {node3 node4} Inf {node4 node1} Inf {node4 node2} Inf {node4 node3} Inf} + +#Test 1.8 - case when we are given a graph with all edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.8 { Johnsons, all weights set to 0 } { + SETUP_ZEROWEIGHTED_K4 + set result [dictsort [struct::graph::op::Johnsons mygraph]] + mygraph destroy + set result +} {{node1 node2} 0 {node1 node3} 0 {node1 node4} 0 {node2 node1} 0 {node2 node3} 0 {node2 node4} 0 {node3 node1} 0 {node3 node2} 0 {node3 node4} 0 {node4 node1} 0 {node4 node2} 0 {node4 node3} 0} + +#Test 1.9 - case when we are given a graph with some edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.9 { Johnsons, some weights set to 0 } { + SETUP_PARTIALLYZEROWEIGHTED + set result [dictsort [struct::graph::op::Johnsons mygraph]] + mygraph destroy + set result +} {{node1 node2} 0 {node1 node3} 0 {node1 node4} 1 {node2 node1} 2 {node2 node3} 0 {node2 node4} 1 {node3 node1} 2 {node3 node2} 2 {node3 node4} 1 {node4 node1} 1 {node4 node2} 1 {node4 node3} 1} + +#Test 1.10 - case when we are given a complete K4 graph with some edge's weights set to 0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-1.10 { Johnsons, some weights set to 0 } { + SETUP_PARTIALLYZEROWEIGHTED_K4 + set result [dictsort [struct::graph::op::Johnsons mygraph]] + mygraph destroy + set result +} {{node1 node2} 0 {node1 node3} 0 {node1 node4} 0 {node2 node1} 0 {node2 node3} 0 {node2 node4} 0 {node3 node1} 0 {node3 node2} 0 {node3 node4} 0 {node4 node1} 0 {node4 node2} 0 {node4 node3} 0} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-2.0 { Johnsons, wrong args, missing } { + catch {struct::graph::op::Johnsons} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::Johnsons {G args} 0] + + +# ------------------------------------------------------------------------- +# Logical arguments checks, failures and unproper graphs handling + +#Test 3.0 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-3.0 {Johnsons, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::Johnsons mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.1 - case when user sets wrong option to the procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-3.1 {Johnsons, bad option used } { + SETUP + catch {struct::graph::op::Johnsons mygraph -badoption} result + mygraph destroy + set result +} {Bad option "-badoption". Expected -filter} + +#Test 3.2 - case when given graph doesn't have weights at some edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-Johnsons-3.2 {Johnsons, partial lack of weights at edges } { + SETUP_PARTIALLYWEIGHTED_K4 + catch {struct::graph::op::Johnsons mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] diff --git a/tcllib/modules/struct/graph/tests/ops/kcenter.test b/tcllib/modules/struct/graph/tests/ops/kcenter.test new file mode 100644 index 0000000..66b2104 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/kcenter.test @@ -0,0 +1,179 @@ +# -*- tcl -*- +#Metric K-Center - Tests +# +#Set of tests includes also tests for subprocedures used by Unweighted Metric K-Center Algorithm: +#- Max Independent Set +#- Two Squared graph - create and extend. + +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.0 { Independent Set, 24 nodes graph } { + SETUP_INDEPENDENTSET_1 + set result [ismaxindependentset mygraph \ + [struct::graph::op::GreedyMaxIndependentSet mygraph]] + mygraph destroy + set result +} 1 +#{node5 node7 node9 node11 node13 node14 node15 node16} + +#Test 1.1 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.1 { Independent Set, complete K4 } { + SETUP_UNWEIGHTED_K4 + set result [ismaxindependentset mygraph \ + [struct::graph::op::GreedyMaxIndependentSet mygraph]] + mygraph destroy + set result +} 1 + +#Test 1.2 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.2 { Independent Set, C5 } { + SETUP_C5 + set result [ismaxindependentset mygraph \ + [struct::graph::op::GreedyMaxIndependentSet mygraph]] + mygraph destroy + set result +} 1 + +#Test 1.3 - Tight Example for K-Center, it chooses external node (with biggest adjacent edge weight = 2) +#when it's possible to choose central node ( with each adjacent edge weight = 1) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.3 { KCenter, Tight Example } { + # Note: Applied to non-complete graph, violating algorithm pre-conditions. + SETUP_KCENTER_1 + set result [lsort -dict [struct::graph::op::UnweightedKCenter mygraph 1]] + mygraph destroy + set result +} [tmE {node2} {node1}] + +#Test 1.4 - different k value +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.4 { KCenter, Tight Example } { + # Note: Applied to non-complete graph, violating algorithm pre-conditions. + SETUP_KCENTER_1 + set result [lsort -dict [struct::graph::op::UnweightedKCenter mygraph 2]] + mygraph destroy + set result +} [tmE {node2 node6} {node1 node2}] + +#Test 1.5 - case with max logical k value for that graph +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.5 { KCenter, Tight Example } { + # Note: Applied to non-complete graph, violating algorithm pre-conditions. + SETUP_KCENTER_1 + set result [lsort -dict [struct::graph::op::UnweightedKCenter mygraph 6]] + mygraph destroy + set result +} [tmE \ + {node2 node3 node4 node5 node6 node7} \ + {node1 node2 node3 node4 node5 node6}] + +#Test 1.6 - case when k is inexplicably big +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.6 { KCenter, Tight Example } { + # Note: Applied to non-complete graph, violating algorithm pre-conditions. + SETUP_KCENTER_1 + set result [lsort -dict [struct::graph::op::UnweightedKCenter mygraph 60]] + mygraph destroy + set result +} [tmE \ + {node2 node3 node4 node5 node6 node7} \ + {node1 node2 node3 node4 node5 node6}] + +#Test 1.7 - another graph test +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.7 { KCenter, graph simulation } { + SETUP_KCENTER_2 + set result [lsort -dict [struct::graph::op::UnweightedKCenter mygraph 2]] + mygraph destroy + set result +} [tmE {node2 node7} {node1 node8}] + +#Tests 1.8 - 1.12 - test cases for creating squared graphs operations +#Test 1.8 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.8 { KCenter, graph simulation } { + SETUP_TWOSQUARED_1 + set solution [struct::graph::op::createSquaredGraph mygraph] + set result [lsort -dict [undirected [$solution arcs]]] + $solution destroy + mygraph destroy + set result +} {{node1 node2} {node1 node3} {node1 node4} {node2 node3} {node2 node4} {node2 node5} {node3 node4} {node3 node5} {node3 node6} {node3 node7} {node4 node5} {node5 node6} {node5 node7} {node5 node8} {node6 node7} {node7 node8}} + +#Test 1.9 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.9 { KCenter, graph simulation } { + SETUP_TWOSQUARED_2 + set solution [struct::graph::op::createSquaredGraph mygraph] + set result [lsort -dict [undirected [$solution arcs]]] + $solution destroy + mygraph destroy + set result +} {{node1 node2} {node1 node3} {node2 node3} {node2 node4} {node3 node4} {node3 node5} {node4 node5}} + +#Test 1.10 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.10 { KCenter, graph simulation } { + SETUP_TWOSQUARED_2 + SETUP_TWOSQUARED_3 + set solution [struct::graph::op::extendTwoSquaredGraph mygraph2 mygraph node4 node5] + set result [lsort -dict [undirected [$solution arcs]]] + mygraph destroy + mygraph2 destroy + set result +} {{node1 node2} {node1 node3} {node2 node3} {node2 node4} {node3 node4} {node3 node5} {node4 node5}} + +#Test 1.11 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.11 { KCenter, graph simulation } { + SETUP_TWOSQUARED_1 + mygraph arc delete "node3 node5" + SETUP_TWOSQUARED_4 + set solution [struct::graph::op::extendTwoSquaredGraph mygraph2 mygraph node3 node4] + set result [lsort -dict [undirected [$solution arcs]]] + mygraph destroy + mygraph2 destroy + set result +} {{node1 node2} {node1 node3} {node1 node4} {node2 node3} {node2 node4} {node3 node4} {node5 node6} {node5 node7} {node5 node8} {node6 node7} {node7 node8}} + +#Test 1.12 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-1.12 { KCenter, graph simulation } { + SETUP_TWOSQUARED_1 + SETUP_TWOSQUARED_4 + set solution [struct::graph::op::extendTwoSquaredGraph mygraph2 mygraph node3 node5] + set result [lsort -dict [undirected [$solution arcs]]] + mygraph destroy + mygraph2 destroy + set result +} {{node1 node2} {node1 node3} {node1 node4} {node2 node3} {node2 node4} {node2 node5} {node3 node4} {node3 node5} {node3 node6} {node3 node7} {node4 node5} {node5 node6} {node5 node7} {node5 node8} {node6 node7} {node7 node8}} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-2.0 { KCenter, wrong args, missing } { + catch {struct::graph::op::UnweightedKCenter} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::UnweightedKCenter {G k} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-2.1 { KCenter, wrong args, missing } { + catch {struct::graph::op::UnweightedKCenter G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::UnweightedKCenter {G k} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-2.2 { KCenter, wrong args, too many} { + catch {struct::graph::op::UnweightedKCenter G y x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::UnweightedKCenter {G k}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + + +#Test 3.1 - case when k is too low +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-3.0 { KCenter, wrong input } { + SETUP_KCENTER_1 + catch { struct::graph::op::UnweightedKCenter mygraph 0 } result + mygraph destroy + set result +} [WrongValueAtInput {k}] + +#Test 3.0 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-KCenter-3.1 {KCenter, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::UnweightedKCenter mygraph k} result + mygraph destroy + set result +} [UnweightedArcOccurance] diff --git a/tcllib/modules/struct/graph/tests/ops/kruskal.test b/tcllib/modules/struct/graph/tests/ops/kruskal.test new file mode 100644 index 0000000..fccee12 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/kruskal.test @@ -0,0 +1,59 @@ +# -*- tcl -*- +# Graph ops tests - Minimum spanning tree/forest per Kruskal +# Copyright (c) 2008-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: kruskal.test,v 1.4 2010/09/09 21:48:27 andreas_kupries Exp $ + +# Syntax: struct::graph::op::kruskal G + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-kruskal-1.0 {kruskal, wrong args, missing} -body { + struct::graph::op::kruskal +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::kruskal {g} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-kruskal-1.1 {kruskal, wrong args, too many} -body { + struct::graph::op::kruskal g x +} -returnCodes error -result [tcltest::tooManyArgs struct::graph::op::kruskal {g}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-kruskal-2.0 {kruskal, arcs without weights} -setup { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a +} -body { + struct::graph::op::kruskal mygraph +} -returnCodes error -result {Operation invalid for graph with unweighted arcs.} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-kruskal-3.0 {kruskal, empty graph} -setup { + SETUP +} -body { + struct::graph::op::kruskal mygraph +} -cleanup { + mygraph destroy +} -result {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-kruskal-3.1 {kruskal, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 +} -body { + struct::graph::op::kruskal mygraph +} -cleanup { + mygraph destroy +} -result {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-kruskal-3.2 {kruskal, nodes, arcs} -setup { + SETUP_A +} -body { + lsort -dict [struct::graph::op::kruskal mygraph] +} -cleanup { + mygraph destroy +} -result {'arc0_1' 'arc0_3' 'arc3_2' 'arc3_4' 'arc3_6' 'arc6_5'} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/maxcut.test b/tcllib/modules/struct/graph/tests/ops/maxcut.test new file mode 100644 index 0000000..ecf9f77 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/maxcut.test @@ -0,0 +1,138 @@ +# -*-tcl -*- +#Maximum Cut - Tests +# +#Searches for such division into two sets of nodes in graph G, that the amount of +#edges linking both sets is as big as possible. + +#------------------------------------------------------------------------------------ +#Tests concerning returning right values by algorithm + +#Test 1.0 - Tight Example - goes right -> ALG = OPT +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.0 { MaxCut, Tight Example } { + SETUP_MAXCUT_1 + set result [list [struct::graph::op::MaxCut mygraph U V] [lsort $U] [lsort $V]] + mygraph destroy + set result +} {4 {node1 node3} {node2 node4}} + +#Test 1.1 - Tight Example - goes wrong -> ALG = 2 * OPT +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.1 { MaxCut, Tight Example } { + SETUP_MAXCUT_2 + set result [list [struct::graph::op::MaxCut mygraph U V] [lsort $U] [lsort $V]] + mygraph destroy + set result +} {2 {node1 node3} {node2 node4}} + +#Test 1.2 - Another graph case for testing finding proper solution +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.2 { MaxCut, graph simulation } { + SETUP_MAXCUT_3 + set result [list [struct::graph::op::MaxCut mygraph U V] [lsort $U] [lsort $V]] + mygraph destroy + set result +} {7 {node1 node4 node5} {node2 node3 node6}} + +#Test 1.3 - Another graph case for testing finding proper solution +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.3 { MaxCut, graph simulation } { + SETUP_MAXCUT_4 + set result [list [struct::graph::op::MaxCut mygraph U V] [lsort $U] [lsort $V]] + mygraph destroy + set result +} {9 {node1 node3 node5} {node2 node4 node6}} + +#Test 1.4 - Graph 1.4 with another order of nodes - algorithm is mistaken by one. +# Note: This is strongly influenced by the ordering of nodes in +# results of commands like '$g nodes ...'. The tcl implementation has +# a node ordering which demonstrates the algorithm running into a +# local optimum. The critcl implementation uses different node +# ordering and returns the optimal cut. +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.4a { MaxCut, graph simulation } { + SETUP_MAXCUT_5 + set result [list [struct::graph::op::MaxCut mygraph U V] [lsort $U] [lsort $V]] + mygraph destroy + set result +} [tmE \ + {8 {node1 node2 node5 node6} {node3 node4}} \ + {9 {node2 node3 node6} {node1 node4 node5}}] + +#Test 1.5 - Testing subprocedure countEdges - edges only between sets +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.5 { countEdges, graph simulation } { + SETUP_COUNTEDGES_1 U V + set result [struct::graph::op::countEdges mygraph $U $V] + mygraph destroy + set result +} 4 + +#Test 1.6 - Testing subprocedure countEdges - edges not only between sets +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.6 { countEdges, graph simulation } { + SETUP_COUNTEDGES_2 U V + set result [struct::graph::op::countEdges mygraph $U $V] + mygraph destroy + set result +} 4 + +#Test 1.7 - Testing subprocedure countEdges - no edges between sets +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.7 { countEdges, graph simulation } { + SETUP_COUNTEDGES_3 U V + set result [struct::graph::op::countEdges mygraph $U $V] + mygraph destroy + set result +} 0 + +#Test 1.8 - Testing subprocedure countEdges - mixed node sets U and V +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.8 { countEdges, graph simulation } { + SETUP_COUNTEDGES_4 U V + set result [struct::graph::op::countEdges mygraph $U $V] + mygraph destroy + set result +} 5 + +#Test 1.9 - Testing subprocedure cut - solution found +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.9 { cut, graph simulation } { + SETUP_CUT_1 U V param + set result [list [struct::graph::op::cut mygraph U V $param] [lsort $U] [lsort $V]] + mygraph destroy + set result +} {0 {node1 node4 node5} {node2 node3 node6}} + +#Test 1.10 - Testing subprocedure cut - better solution possible to find +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-1.10 { cut, graph simulation } { + SETUP_CUT_2 U V param + set result [list [struct::graph::op::cut mygraph U V $param] [lsort $U] [lsort $V]] + mygraph destroy + set result +} {7 {node1 node4 node5} {node2 node3 node6}} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-2.0 { MaxCut, wrong args, missing } { + catch {struct::graph::op::MaxCut} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MaxCut {G U V} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-2.1 { MaxCut, wrong args, missing } { + catch {struct::graph::op::MaxCut G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MaxCut {G U V} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-2.2 { MaxCut, wrong args, missing } { + catch {struct::graph::op::MaxCut G U} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MaxCut {G U V} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-2.3 { MaxCut, wrong args, too many } { + catch {struct::graph::op::MaxCut G U V x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::MaxCut {G U V}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when given graph doesn't have edges at all +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MaxCut-3.0 { MaxCut, no edges } { + SETUP_NOEDGES_1 + set result [struct::graph::op::MaxCut mygraph U V] + mygraph destroy + set result +} 0 + diff --git a/tcllib/modules/struct/graph/tests/ops/maxmatching.test b/tcllib/modules/struct/graph/tests/ops/maxmatching.test new file mode 100644 index 0000000..054e081 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/maxmatching.test @@ -0,0 +1,137 @@ +# -*- tcl -*- +# Graph ops tests - Maximal matchings from bi-partitions. +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: maxmatching.test,v 1.3 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::isBipartite? G ?partitionvar? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-1.0 {max matching, wrong args, missing} { + catch {struct::graph::op::maxMatching} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::maxMatching {g X Y} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-1.1 {max matching, wrong args, missing} { + catch {struct::graph::op::maxMatching g} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::maxMatching {g X Y} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-1.2 {max matching, wrong args, missing} { + catch {struct::graph::op::maxMatching g x} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::maxMatching {g X Y} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-1.3 {max matching, wrong args, too many} { + catch {struct::graph::op::maxMatching g x y z} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::maxMatching {g X Y}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-2.0 {max matching, bad bi-partition} knownBug { + SETUP_E + set result {} + struct::graph::op::isBipartite? mygraph result + foreach {A B} $result break + lappend A [lindex $B 0] ; # force intersection + catch {struct::graph::op::maxMatching mygraph $A $B} result + mygraph destroy + set result +} {Not a bi-partition} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-2.1 {max matching, bad bi-partition} knownBug { + SETUP_E + set result {} + struct::graph::op::isBipartite? mygraph result + foreach {A B} $result break + set A [lreplace $A end end] ; # force partial coverage + catch {struct::graph::op::maxMatching mygraph $A $B} result + mygraph destroy + set result +} {Not a bi-partition} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-2.2 {max matching, bad bi-partition} knownBug { + SETUP_E + set result {} + struct::graph::op::isBipartite? mygraph result + foreach {A B} $result break + lappend A bogus ; # force bogus node outside of graph + catch {struct::graph::op::maxMatching mygraph $A $B} result + mygraph destroy + set result +} {Not a bi-partition} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-2.3 {max matching, bad bi-partition} knownBug { + SETUP_E + set result {} + struct::graph::op::isBipartite? mygraph result + foreach {A B} $result break + mygraph arc insert [lindex $A 0] [lindex $A 1] ; # force arc violating bipart condition + catch {struct::graph::op::maxMatching mygraph $A $B} result + mygraph destroy + set result +} {Not a bi-partition} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-3.0 {max matching, empty graph} knownBug { + SETUP + set result {} + struct::graph::op::isBipartite? mygraph result + set result [lsort -dict [struct::graph::op::maxMatching mygraph [lindex $result 0] [lindex $result 1]]] + mygraph destroy + set result +} {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-3.1 {max matching, nodes, no arcs} knownBug { + SETUP + set result {} + mygraph node insert 0 1 2 3 4 5 + struct::graph::op::isBipartite? mygraph result + set result [lsort -dict [struct::graph::op::maxMatching mygraph [lindex $result 0] [lindex $result 1]]] + mygraph destroy + set result +} {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-3.3 {max matching} knownBug { + SETUP_E + set result {} + struct::graph::op::isBipartite? mygraph result + set result [lsort -dict [struct::graph::op::maxMatching mygraph [lindex $result 0] [lindex $result 1]]] + mygraph destroy + set result +} {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-3.4 {max matching} knownBug { + SETUP_F + set result {} + struct::graph::op::isBipartite? mygraph result + set result [lsort -dict [struct::graph::op::maxMatching mygraph [lindex $result 0] [lindex $result 1]]] + mygraph destroy + set result +} {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-3.5 {max matching} knownBug { + SETUP_G + set result {} + struct::graph::op::isBipartite? mygraph result + set result [lsort -dict [struct::graph::op::maxMatching mygraph [lindex $result 0] [lindex $result 1]]] + mygraph destroy + set result +} {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-maxmatch-3.6 {max matching} knownBug { + SETUP_C + set result {} + struct::graph::op::isBipartite? mygraph result + set result [lsort -dict [struct::graph::op::maxMatching mygraph [lindex $result 0] [lindex $result 1]]] + mygraph destroy + set result +} {} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/mdst.test b/tcllib/modules/struct/graph/tests/ops/mdst.test new file mode 100644 index 0000000..12737d4 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/mdst.test @@ -0,0 +1,131 @@ +# -*- tcl -*- +#Tests for Spanning Tree Problems +#1) Minimum Degree Spanning Tree +#2) Minimum Diameter Spanning Tree +# +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +# ------------------------------------------------------------------------------------ +#Minimum Diameter Spanning Tree Tests +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDiameterSpanningTree-1.0 { graph simulation } { + SETUP_MDST_1 + set solution [struct::graph::op::MinimumDiameterSpanningTree mygraph] + set result [list \ + [lsort -dict [$solution nodes]] \ + [lsort -dict [undirected [$solution arcs]]]] + $solution destroy + mygraph destroy + set result +} {{a b c d e f g h i j} {{a b} {b c} {c d} {c g} {d e} {d h} {e f} {g i} {h j}}} + +#Test 1.1 - case when given graph is a spanning tree already +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDiameterSpanningTree-1.1 { graph simulation } { + SETUP_MDST_3 + set solution [struct::graph::op::MinimumDiameterSpanningTree mygraph] + set result [list \ + [lsort -dict [$solution nodes]] \ + [lsort -dict [undirected [$solution arcs]]]] + $solution destroy + mygraph destroy + set result +} {{a b c d e} {{a b} {b c} {c d} {d e}}} + +#Test 1.2 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDiameterSpanningTree-1.2 { graph simulation } { + SETUP_MDST_4 + set solution [struct::graph::op::MinimumDiameterSpanningTree mygraph] + set result [list \ + [lsort -dict [$solution nodes]] \ + [lsort -dict [undirected [$solution arcs]]]] + $solution destroy + mygraph destroy + set result +} [tmE \ + {{a b c d e f g} {{a b} {b c} {c d} {d e} {d g} {e f}}} \ + {{a b c d e f g} {{a b} {b c} {c d} {d e} {d g} {f g}}}] + +#Test 1.3 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDiameterSpanningTree-1.3 { graph simulation } { + SETUP_MDST_5 + set solution [struct::graph::op::MinimumDiameterSpanningTree mygraph] + set result [list \ + [lsort -dict [$solution nodes]] \ + [lsort -dict [undirected [$solution arcs]]]] + $solution destroy + mygraph destroy + set result +} {{a b c d e} {{a c} {b c} {c d} {c e}}} + +#Minimum Degree Spanning Tree Tests + +#Test 1.4 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDegreeSpanningTree-1.4 { graph simulation } { + SETUP_MDST_2 + set solution [struct::graph::op::MinimumDegreeSpanningTree mygraph] + set result [list \ + [lsort -dict [$solution nodes]] \ + [lsort -dict [undirected [$solution arcs]]]] + $solution destroy + mygraph destroy + set result +} {{v1 v2 v3 v4 v5 v6 v7 v8} {{v1 v2} {v1 v3} {v2 v4} {v4 v5} {v5 v7} {v6 v8} {v7 v8}}} + +#Test 1.5 - case when graph is "wheel structured" (one central node and the rest of nodes around central one) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDegreeSpanningTree-1.5 { graph simulation } { + SETUP_MDST_6 + set solution [struct::graph::op::MinimumDegreeSpanningTree mygraph] + set result [list \ + [lsort -dict [$solution nodes]] \ + [lsort -dict [undirected [$solution arcs]]]] + $solution destroy + mygraph destroy + set result +} [tmE [tmSE \ + {{a b c d e f g} {{a f} {a g} {b c} {c g} {d e} {e f}}} \ + {{a b c d e f g} {{a b} {a f} {b c} {c g} {d g} {e f}}}] \ + {{a b c d e f g} {{a f} {b c} {b g} {d e} {d g} {f g}}}] + +#Test 1.6 - case when graph is "wheel structured" (one central node and the rest of nodes around central one) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDegreeSpanningTree-1.6 { graph simulation } { + SETUP_MDST_7 + set solution [struct::graph::op::MinimumDegreeSpanningTree mygraph] + set result [list \ + [lsort -dict [$solution nodes]] \ + [lsort -dict [undirected [$solution arcs]]]] + $solution destroy + mygraph destroy + set result +} [tmE \ + {{a b c d e f} {{a f} {b c} {b d} {c e} {e f}}} \ + {{a b c d e f} {{a f} {b c} {c d} {d e} {e f}}}] + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many +# Minimum Diameter Spanning Tree Tests + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDiameterSpanningTree-2.0 { MinimumDiameterSpanningTree, wrong args, missing } { + catch {struct::graph::op::MinimumDiameterSpanningTree} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MinimumDiameterSpanningTree {G} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDiameterSpanningTree-2.1 { MinimumDiameterSpanningTree, wrong args, too many} { + catch {struct::graph::op::MinimumDiameterSpanningTree G s} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::MinimumDiameterSpanningTree {G}] + +#Minimum Degree Spanning Tree Tests + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDegreeSpanningTree-2.2 { MinimumDegreeSpanningTree, wrong args, missing } { + catch {struct::graph::op::MinimumDegreeSpanningTree} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MinimumDegreeSpanningTree {G} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MinimumDegreeSpanningTree-2.3 { MinimumDegreeSpanningTree, wrong args, too many} { + catch {struct::graph::op::MinimumDegreeSpanningTree G s} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::MinimumDegreeSpanningTree {G}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures diff --git a/tcllib/modules/struct/graph/tests/ops/metrictsp.test b/tcllib/modules/struct/graph/tests/ops/metrictsp.test new file mode 100644 index 0000000..79ab838 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/metrictsp.test @@ -0,0 +1,208 @@ +# -*- tcl -*- +#Metric Travelling Salesman Algorithm - Tests +# +#Finding Hamilton Cycle in graph satisfying triangle inequality. +#Set of tests covers also subprocedures used by MTSP algorithm. + +#------------------------------------------------------------------------------------ +#Tests concerning returning right values by algorithm + +#Test 1.0 - graph which can cause reaching maximum approximation factor +# - The Tcl implementation yields a near-optimal route (having a +# length of 7, over 6). +# - The C implementation with different node ordering yields route off +# by two (8 over 6), this is still within 2x approximation factor, +# and also demonstrates how this algorithm is a heuristic and easy +# to disturb by even small things. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.0 { MetricTravellingSalesman, graph simulation } -setup { + SETUP_TSP_1 +} -body { + toursort [struct::graph::op::MetricTravellingSalesman mygraph] +} -cleanup { + mygraph destroy +} -result [tmE \ + {node1 node4 node3 node2 node6 node5 node1} \ + {node1 node3 node2 node6 node5 node4 node1}] + +#Test 1.1 - case with double edges and different edge weights at them +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.1 { MetricTravellingSalesman, graph simulation } -setup { + SETUP_TSP_3 +} -body { + toursorta [struct::graph::op::MetricTravellingSalesman mygraph] +} -cleanup { + mygraph destroy +} -result {node1 node2 node3 node4 node1} + +#Test 1.2 - graph which can cause reaching maximum approximation factor. +# We have slightly different tours based on the chosen implementation +# (Not only of struct::graph, but also of struct::set). +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.2 { MetricTravellingSalesman, graph simulation } -setup { + SETUP_TSP_2 +} -body { + toursort [struct::graph::op::MetricTravellingSalesman mygraph] +} -cleanup { + mygraph destroy +} -result [tmE [tmSE \ + {node1 node2 node3 node4 node5 node1} \ + {node1 node4 node3 node2 node5 node1}] \ + {node1 node3 node2 node5 node4 node1}] + +#Test 1.3 - testing subprocedure createTGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.3 { createTGraph, option 0 } -setup { + SETUP_CREATETGRAPH_1 E +} -body { + set tg [struct::graph::op::createTGraph mygraph $E 0] + list \ + [lsort [$tg arcs]] \ + [lsort [$tg nodes]] +} -cleanup { + $tg destroy + mygraph destroy +} -result {{{node1 node2} {node1 node4} {node2 node1} {node4 node1}} {node1 node2 node3 node4}} + +#Test 1.4 - testing subprocedure createTGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.4 { createTGraph, option 1 } -setup { + SETUP_CREATETGRAPH_1 E +} -body { + set tg [struct::graph::op::createTGraph mygraph $E 1] + list \ + [lsort [$tg arcs]] \ + [lsort [$tg nodes]] +} -cleanup { + $tg destroy + mygraph destroy +} -result {{{node2 node1} {node4 node1}} {node1 node2 node3 node4}} + +#Test 1.5 - testing subprocedure createTGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.5 { createTGraph, no edges exception } -setup { + SETUP_CREATETGRAPH_2 E +} -body { + struct::graph::op::createTGraph mygraph $E 0 +} -returnCodes 1 -cleanup { + mygraph destroy +} -result [LackOfEdgesOccurance {mygraph} {edge1}] + +#Test 1.6 - testing subprocedure createTGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.6 { createTGraph, no edges exception } -setup { + SETUP_CREATETGRAPH_2 E +} -body { + struct::graph::op::createTGraph mygraph $E 1 +} -returnCodes 1 -cleanup { + mygraph destroy +} -result [LackOfEdgesOccurance {mygraph} {edge1}] + +#Test 1.7 - testing subprocedure createTGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.7 { createTGraph, option 1 } -setup { + SETUP_CREATETGRAPH_3 E +} -body { + set tg [struct::graph::op::createTGraph mygraph $E 1] + list \ + [lsort [$tg arcs]] \ + [lsort [$tg nodes]] +} -cleanup { + $tg destroy + mygraph destroy +} -result {{{node1 node4} {node3 node1} {node4 node1}} {node1 node2 node3 node4}} + +#Test 1.8 - testing subprocedure createTGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.8 { createTGraph, option 0 } -setup { + SETUP_CREATETGRAPH_3 E +} -body { + set tg [struct::graph::op::createTGraph mygraph $E 0] + list \ + [lsort [$tg arcs]] \ + [lsort [$tg nodes]] +} -cleanup { + $tg destroy + mygraph destroy +} -result {{{node1 node3} {node1 node4} {node3 node1} {node4 node1}} {node1 node2 node3 node4}} + +#Test 1.9 - testing subprocedure createCompleteGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.9 { createCompleteGraph, no edges } -setup { + SETUP_NOEDGES_1 +} -body { + struct::graph::op::createCompleteGraph mygraph originalEdges + list \ + [lsort [undirected [mygraph arcs]]] \ + [lsort [mygraph nodes]] \ + [lsort $originalEdges] +} -cleanup { + mygraph destroy +} -result {{{node1 node2} {node1 node3} {node1 node4} {node2 node3} {node2 node4} {node3 node4}} {node1 node2 node3 node4} {}} + +#Test 1.10 - testing subprocedure createCompleteGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.10 { createCompleteGraph, complete graph } -setup { + SETUP_UNDIRECTED_K4 +} -body { + struct::graph::op::createCompleteGraph mygraph originalEdges + list \ + [lsort [mygraph arcs]] \ + [lsort [mygraph nodes]] \ + [lsort $originalEdges] +} -cleanup { + mygraph destroy +} -result {{edge12 edge13 edge14 edge23 edge24 edge34} {node1 node2 node3 node4} {{node1 node2} {node1 node3} {node1 node4} {node2 node3} {node2 node4} {node3 node4}}} + +#Test 1.11 - testing subprocedure createCompleteGraph used by Metric Travelling Salesman procedure +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.11 { createCompleteGraph, partially connected graph } -setup { + SETUP_PARTIALLYCONNECTED_1 +} -body { + struct::graph::op::createCompleteGraph mygraph originalEdges + list \ + [lsort [undirected [mygraph arcs]]] \ + [lsort [mygraph nodes]] \ + [lsort $originalEdges] +} -cleanup { + mygraph destroy +} -result {{arc1 arc2 arc3 arc4 {node1 node2} {node1 node3} {node1 node4} {node2 node3} {node2 node4} {node3 node4}} {node1 node2 node3 node4 node5} {{node1 node5} {node2 node5} {node3 node5} {node4 node5}}} + +#Test 1.12 - graph which can cause reaching maximum approximation factor +# this also has considerable freedom in the order it can choose the nodes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-1.12 { MetricTravellingSalesman, graph simulation } -setup { + SETUP_PARTIALLYCONNECTED_1 +} -body { + toursort [struct::graph::op::MetricTravellingSalesman mygraph] +} -cleanup { + mygraph destroy +} -result {node1 node5 node4 node5 node3 node5 node2 node5 node1} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-2.0 { MetricTravellingSalesman, wrong args, missing } { + catch {struct::graph::op::MetricTravellingSalesman} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::MetricTravellingSalesman {G} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-2.1 { MetricTravellingSalesman, wrong args, too many} { + catch {struct::graph::op::MetricTravellingSalesman G y x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::MetricTravellingSalesman {G}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +#Test 3.0 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-3.0 {MetricTravellingSalesman, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::MetricTravellingSalesman mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.1 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-3.1 {MetricTravellingSalesman, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::MetricTravellingSalesman mygraph} result + mygraph destroy + set result +} [UnweightedArcOccurance] + +#Test 3.2 - case when given graph is not a connected graph +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-MetricTravellingSalesman-3.2 { MetricTravellingSalesman, unconnected graph } { + SETUP_NOEDGES_1 + catch { struct::graph::op::MetricTravellingSalesman mygraph } result + mygraph destroy + set result +} [UnconnectedGraphOccurance {mygraph}] diff --git a/tcllib/modules/struct/graph/tests/ops/mkmblockingflow.test b/tcllib/modules/struct/graph/tests/ops/mkmblockingflow.test new file mode 100644 index 0000000..56d9bf8 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/mkmblockingflow.test @@ -0,0 +1,67 @@ +# -*- tcl -*- +#Blocking flow by MKM - Tests +# +# + +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +#Test 1.0 - +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-1.0 { Tight Example, n+4 - nodes graph } { + SETUP_BLOCKINGFLOW_1 + set result [dictsort [struct::graph::op::BlockingFlowByMKM mygraph s t]] + mygraph destroy + set result +} {{s v1} 3 {s v3} 2 {v1 v2} 2 {v1 v4} 1 {v2 v5} 2 {v3 v4} 1 {v3 v6} 1 {v4 v5} 1 {v4 v7} 1 {v5 t} 3 {v6 v7} 1 {v7 t} 2} + +#Test 1.1 - case when input residual graph is created from network that hasn't any flows yet +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-1.1 { graph simulation } { + SETUP_MAXIMUMFLOW_1 + set result [dictsort [struct::graph::op::BlockingFlowByMKM mygraph s t]] + mygraph destroy + set result +} {{s v1} 10 {s v2} 4 {v1 v3} 4 {v1 v4} 6 {v2 v4} 4 {v3 t} 4 {v4 t} 10} + +#Test 1.2 - case when input residual graph is created from network that has already some flows used in it +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-1.2 { graph simulation } { + SETUP_BLOCKINGFLOW_2 + set result [dictsort [struct::graph::op::BlockingFlowByMKM mygraph s t]] + mygraph destroy + set result +} {{s v2} 5 {v2 v4} 5 {v3 t} 5 {v4 v3} 5} + +#Test 1.3 - case when from residual graph we get level graph with no arcs - the blocking flow is not found +#cause there are no paths between sink and source in residual graph. +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-1.3 { graph simulation } { + SETUP_BLOCKINGFLOW_3 + set result [dictsort [struct::graph::op::BlockingFlowByMKM mygraph s t]] + mygraph destroy + set result +} {} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-2.0 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::BlockingFlowByMKM} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BlockingFlowByMKM {G s t} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-2.1 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::BlockingFlowByMKM G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BlockingFlowByMKM {G s t} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-2.2 { BlockingFlow, wrong args, missing } { + catch {struct::graph::op::BlockingFlowByMKM G s} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::BlockingFlowByMKM {G s t} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-BlockingFlowMKM-2.3 { BlockingFlow, wrong args, too many} { + catch {struct::graph::op::BlockingFlowByMKM G y x z} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::BlockingFlowByMKM {G s t}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + diff --git a/tcllib/modules/struct/graph/tests/ops/prim.test b/tcllib/modules/struct/graph/tests/ops/prim.test new file mode 100644 index 0000000..0e06ddb --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/prim.test @@ -0,0 +1,67 @@ +# -*- tcl -*- +# Graph ops tests - Minimum spanning tree/forest per Prim +# Copyright (c) 2008-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: prim.test,v 1.4 2010/09/09 21:48:27 andreas_kupries Exp $ + +# Syntax: struct::graph::op::prim G + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-prim-1.0 {prim, wrong args, missing} -body { + struct::graph::op::prim +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::prim {g} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-prim-1.1 {prim, wrong args, too many} -body { + struct::graph::op::prim g x +} -returnCodes error -result [tcltest::tooManyArgs struct::graph::op::prim {g}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-prim-2.0 {prim, arcs without weights} -setup { + SETUP + mygraph node insert 0 1 + mygraph arc insert 0 1 a +} -body { + struct::graph::op::prim mygraph +} -returnCodes error -result {Operation invalid for graph with unweighted arcs.} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-prim-3.0 {prim, empty graph} -setup { + SETUP +} -body { + struct::graph::op::prim mygraph +} -cleanup { + mygraph destroy +} -result {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-prim-3.1 {prim, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 +} -body { + struct::graph::op::prim mygraph +} -cleanup { + mygraph destroy +} -result {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-prim-3.2 {prim, nodes, arcs} -setup { + SETUP_A +} -body { + lsort -dict [struct::graph::op::prim mygraph] +} -cleanup { + mygraph destroy +} -result {'arc0_1' 'arc0_3' 'arc3_2' 'arc3_4' 'arc3_6' 'arc6_5'} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-prim-3.3 {prim, nodes, arcs} -setup { + SETUP_B +} -body { + lsort -dict [struct::graph::op::prim mygraph] +} -cleanup { + mygraph destroy +} -result {A_B A_C C_D D_E S_B} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/radius.test b/tcllib/modules/struct/graph/tests/ops/radius.test new file mode 100644 index 0000000..50d1883 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/radius.test @@ -0,0 +1,45 @@ +# -*- tcl -*- +# Graph ops tests - Dijkstra, distances, radius +# Copyright (c) 2008 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: radius.test,v 1.2 2009/09/15 19:24:12 andreas_kupries Exp $ + +# Syntax: struct::graph::op::radius G ?options? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-radius-1.0 {radius, wrong args, missing} { + catch {struct::graph::op::radius} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::radius {g args} 0] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +set n 0 +foreach {setup radius unradius} { + SETUP_A 6 5 + SETUP_B 6 4 +} { + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-radius-3.$n "radius, $setup, directed" { + $setup + set result [struct::graph::op::radius mygraph -arcmode directed] + mygraph destroy + set result + } $radius + + test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-radius-4.$n "radius, $setup, undirected" { + $setup + set result [struct::graph::op::radius mygraph -arcmode undirected] + mygraph destroy + set result + } $unradius + + incr n +} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/tarjan.test b/tcllib/modules/struct/graph/tests/ops/tarjan.test new file mode 100644 index 0000000..179e6e3 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/tarjan.test @@ -0,0 +1,99 @@ +# -*- tcl -*- +# Graph ops tests - Strongly connected components per Tarjan's algorithm +# Copyright (c) 2008-2010 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: tarjan.test,v 1.4 2010/09/09 21:48:27 andreas_kupries Exp $ + +# Syntax: struct::graph::op::tarjan G + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-1.0 {tarjan, wrong args, missing} -body { + struct::graph::op::tarjan +} -returnCodes error -result [tcltest::wrongNumArgs struct::graph::op::tarjan {g} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-1.1 {tarjan, wrong args, too many} -body { + struct::graph::op::tarjan g x +} -returnCodes error -result [tcltest::tooManyArgs struct::graph::op::tarjan {g}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.0 {tarjan, empty graph} -setup { + SETUP +} -body { + struct::graph::op::tarjan mygraph +} -cleanup { + mygraph destroy +} -result {} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.1 {tarjan, nodes, no arcs} -setup { + SETUP + mygraph node insert 0 1 2 3 4 5 +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {0 1 2 3 4 5} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.2 {tarjan, nodes, arcs} -setup { + SETUP_A +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {{'node0' 'node1' 'node2' 'node3'} 'node4' 'node5' 'node6'} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.3 {tarjan, nodes, arcs} -setup { + SETUP_B +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {A B C D E S} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.4 {tarjan, nodes, arcs} -setup { + SETUP_C +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {{A B C D} E F} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.5 {tarjan, nodes, arcs} -setup { + SETUP_D +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {{a b c d} {f g h} i j} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.6 {tarjan, nodes, arcs} -setup { + SETUP_E +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {1b 1w 2b 2w 3b {3w 4b} 4w 5b 5w 6b 6w {7b 7w 8b 8w}} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.7 {tarjan, nodes, arcs} -setup { + SETUP_F +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {1b 1w 2b 2w 3b 3w 4b 4w} + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-tarjan-3.8 {tarjan, nodes, arcs} -setup { + SETUP_G +} -body { + setsetcanon [struct::graph::op::tarjan mygraph] +} -cleanup { + mygraph destroy +} -result {1b 1w 2b 2w 3b 3w 4b 4w 5b 5w} + +# --------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/ops/tspheuristics.test b/tcllib/modules/struct/graph/tests/ops/tspheuristics.test new file mode 100644 index 0000000..814b685 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/tspheuristics.test @@ -0,0 +1,44 @@ +#-*- tcl -*- +#Tests for heuristics of local searching for Traveling Salesman Problem. +#2 and 3 approximation algorithms. +# +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +#Test 1.0 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-TSPHeuristic2OPT-1.0 { graph simulation } -setup { + SETUP_TSPHEURISTIC_1 C +} -body { + lsort -dict [struct::graph::op::TSPLocalSearching mygraph $C] +} -cleanup { + mygraph destroy + unset C +} -result {{a b} {a c} {b e} {c d} {d e}} + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-TSPHeuristic2OPT-2.0 { wrong args, missing } { + catch {struct::graph::op::TSPLocalSearching} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::TSPLocalSearching {G C} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-TSPHeuristic2OPT-2.1 { wrong args, missing } { + catch {struct::graph::op::TSPLocalSearching G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::TSPLocalSearching {G C} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-TSPHeuristic2OPT-2.2 { wrong args, too many} { + catch {struct::graph::op::TSPLocalSearching G a b} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::TSPLocalSearching {G C}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-TSPHeuristic2OPT-2.0 { wrong args, missing } -setup { + SETUP_TSPHEURISTIC_1 C +} -body { + struct::graph::op::TSPLocalSearching mygraph {h j k} +} -returnCodes error -cleanup { + mygraph destroy +} -result {Given cycle has arcs not included in graph G.} diff --git a/tcllib/modules/struct/graph/tests/ops/verticescover.test b/tcllib/modules/struct/graph/tests/ops/verticescover.test new file mode 100644 index 0000000..354f724 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/verticescover.test @@ -0,0 +1,81 @@ +# -*- tcl -*- +#Vertices Cover, 2 approximation algorithm - Tests +# +#Algorithm searches for the minimum set of vertices such that each edge of the graph +#is incident to at least one vertex of the set. +# +#------------------------------------------------------------------------------------ +#Tests concerning returning right values by algorithm + +#Test 1.0 - case when graph is complete - the same degrees and even number of nodes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-1.0 { VerticesCover, complete K4 } { + SETUP_UNDIRECTED_K4 + set result [lsort -dict [struct::graph::op::VerticesCover mygraph]] + mygraph destroy + set result +} {node1 node2 node3 node4} + +#Test 1.1 - case with big degree differences at nodes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-1.1 { VerticesCover, graph simulation } { + SETUP_VC_1 + set result [lsort -dict [struct::graph::op::VerticesCover mygraph]] + mygraph destroy + set result +} [tmE {node1 node3} {node2 node3}] + +#Test 1.2 - another test case testing the improvement given by degree conditions +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-1.2 { VerticesCover, graph simulation } { + SETUP_VC_2 + set result [lsort -dict [struct::graph::op::VerticesCover mygraph]] + mygraph destroy + set result +} {node2 node3 node4 node5} + +#Test 1.3 - case when graph is a cycle - degrees are the same for all nodes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-1.3 { VerticesCover, cycle C5 } { + SETUP_C5 + set result [lsort -dict [struct::graph::op::VerticesCover mygraph]] + mygraph destroy + set result +} [tmE {node2 node3 node4 node5} {node1 node3 node4 node5}] +# should custom match code verifying that result is a cover. + +#Test 1.4 - case when given graph is a K4, but with doubled arcs (directed) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-1.4 { VerticesCover, directed K4 } { + SETUP_K4 + set result [lsort -dict [struct::graph::op::VerticesCover mygraph]] + mygraph destroy + set result +} {node1 node2 node3 node4} + +#Test 1.5 - graph from Test 1.1, but with doubled arcs (directed) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-1.5 { VerticesCover, directed, complete } { + SETUP_VC_1_2 + set result [lsort -dict [struct::graph::op::VerticesCover mygraph]] + mygraph destroy + set result +} [tmE {node1 node3} {node2 node3}] + +#Test 1.6 - graph from Test 1.1, but with some doubled arcs (directed) +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-1.6 { VerticesCover, directed, uncomplete } { + SETUP_VC_1_3 + set result [lsort -dict [struct::graph::op::VerticesCover mygraph]] + mygraph destroy + set result +} [tmE {node1 node3} {node2 node3}] + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-2.0 { VerticesCover, wrong args, missing } { + catch {struct::graph::op::VerticesCover} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::VerticesCover {G} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-VerticesCover-2.1 { VerticesCover, wrong args, too many} { + catch {struct::graph::op::VerticesCover G y x} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::VerticesCover {G}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failure diff --git a/tcllib/modules/struct/graph/tests/ops/weightedkcenter.test b/tcllib/modules/struct/graph/tests/ops/weightedkcenter.test new file mode 100644 index 0000000..acaf2d5 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/ops/weightedkcenter.test @@ -0,0 +1,137 @@ +# -*- tcl -*- +#Metric Weighted K-Center - Tests +# +# +#Set of tests includes also tests for subprocedures used by Weighted Metric K-Center Algorithm: +#- Max Weighted Independent Set + +# ------------------------------------------------------------------------------------ +# Tests concerning returning right values by algorithm + +#Test 1.0 - Tight Example simulation for graph with 8 nodes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.0 { Tight Example, n+4 - nodes graph } { + SETUP_WEIGHTEDKCENTER_1 nodeWeights + set result [lsort -dict [struct::graph::op::WeightedKCenter mygraph $nodeWeights 3]] + mygraph destroy + set result +} {node1 node4} + +#Test 1.1 - Tight Example simulation for graph with 8 nodes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.1 { Tight Example, n+4 - nodes graph } { + SETUP_WEIGHTEDKCENTER_1 nodeWeights + set result [lsort -dict [struct::graph::op::WeightedKCenter mygraph $nodeWeights 9]] + mygraph destroy + set result +} {node1 node4} + +#Test 1.2 - Tight Example simulation for graph with 8 nodes +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.2 { Tight Example, n+4 - nodes graph } { + SETUP_WEIGHTEDKCENTER_1 nodeWeights + catch { struct::graph::op::WeightedKCenter mygraph $nodeWeights 1 } result + mygraph destroy + set result +} {No k-center found for restriction W = 1} + +#Test 1.3 - +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.3 { } { + SETUP_WEIGHTEDKCENTER_2 nodeWeights + set result [lsort -dict [struct::graph::op::WeightedKCenter mygraph $nodeWeights 2]] + mygraph destroy + set result +} {node6} + +#Test 1.4 - +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.4 { } { + SETUP_WEIGHTEDKCENTER_3 nodeWeights + set result [lsort -dict [struct::graph::op::WeightedKCenter mygraph $nodeWeights 1]] + mygraph destroy + set result +} {node1} + +#Test 1.5 - +# Tcl: 12345->1234->124 | Initial different sorting of the arcs causes selection of different maximal +# C: 12346->1246->146->14 | independent sets, which then drives the heuristics to different solutions. + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.5 { } { + SETUP_WEIGHTEDKCENTER_3 nodeWeights + set result [lsort -dict [struct::graph::op::WeightedKCenter mygraph $nodeWeights 3]] + mygraph destroy + set result +} [tmE {node1 node2 node4} {node1 node4}] + +#Test 1.6 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.6 { Independent Set, 24 nodes graph } { + SETUP_INDEPENDENTSET_1 + set nodeWeights {} + foreach node [mygraph nodes] { + lappend nodeWeights [list $node 1] + } + set result [struct::graph::op::GreedyWeightedMaxIndependentSet mygraph $nodeWeights] + set result [list [ismaxindependentset mygraph $result] [llength $result]] + mygraph destroy + set result +} {1 8} + +#Test 1.7 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.7 { Independent Set, complete K4 } { + SETUP_UNWEIGHTED_K4 + set nodeWeights {{node1 1} {node2 2} {node3 2} {node4 2}} + set result [lsort -dict [struct::graph::op::GreedyWeightedMaxIndependentSet mygraph \ + $nodeWeights]] + mygraph destroy + set result +} {node1} + +#Test 1.8 +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-1.8 { Independent Set, C5 } { + SETUP_C5 + set nodeWeights {{node1 1} {node2 2} {node3 3} {node4 4} {node5 5}} + set result [lsort -dict [struct::graph::op::GreedyWeightedMaxIndependentSet mygraph \ + $nodeWeights]] + mygraph destroy + set result +} {node1 node3} + + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-2.0 { WeightedKCenter, wrong args, missing } { + catch {struct::graph::op::WeightedKCenter} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::WeightedKCenter {G nodeWeights W} 0] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-2.1 { WeightedKCenter, wrong args, missing } { + catch {struct::graph::op::WeightedKCenter G} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::WeightedKCenter {G nodeWeights W} 1] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-2.2 { WeightedKCenter, wrong args, missing } { + catch {struct::graph::op::WeightedKCenter G x} msg + set msg +} [tcltest::wrongNumArgs struct::graph::op::WeightedKCenter {G nodeWeights W} 2] + +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-2.3 { WeightedKCenter, wrong args, too many} { + catch {struct::graph::op::WeightedKCenter G y x z} msg + set msg +} [tcltest::tooManyArgs struct::graph::op::WeightedKCenter {G nodeWeights W}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + + +#Test 3.0 - case when W is too low +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-3.0 { WeightedKCenter, wrong input } { + SETUP_KCENTER_1 + catch { struct::graph::op::WeightedKCenter mygraph nodeWeights 0 } result + mygraph destroy + set result +} [WrongValueAtInput {W}] + +#Test 3.1 - case when given graph doesn't have weights at all edges +test graphop-t${treeimpl}-g${impl}-s${setimpl}-st${stkimpl}-q${queimpl}-WeightedKCenter-3.1 {WeightedKCenter, lack of weights at edges } { + SETUP_UNWEIGHTED_K4 + catch {struct::graph::op::WeightedKCenter mygraph nodeWeights 5 } result + mygraph destroy + set result +} [UnweightedArcOccurance] diff --git a/tcllib/modules/struct/graph/tests/rassign.test b/tcllib/modules/struct/graph/tests/rassign.test new file mode 100644 index 0000000..046dc19 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/rassign.test @@ -0,0 +1,75 @@ +# -*- tcl -*- +# Graph tests - revers assignment (-->) +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: rassign.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph --> GRAPH + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-revers-assign-1.0 {revers assign, wrong#args, missing} { + SETUP + catch {mygraph -->} result + mygraph destroy + set result +} [tmWrong --> dest 0] + +test graph-${impl}-${setimpl}-revers-assign-1.1 {revers assign, wrong#args, too many} { + SETUP + catch {mygraph --> foo bar} result + mygraph destroy + set result +} [tmTooMany --> dest] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-revers-assign-2.0 {revers assign, bad src command} { + SETUP + catch {mygraph --> foo} result + mygraph destroy + set result +} {invalid command name "foo"} + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-revers-assign-3.0 {revers assign, direct} { + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + + SETUP + SETUP bgraph + + mygraph deserialize $serial + + set result [validate_serial bgraph $serial] + mygraph --> bgraph + lappend result [validate_serial bgraph $serial] + + mygraph destroy + bgraph destroy + set result +} {attr/graph/data-mismatch ok} + +test graph-${impl}-${setimpl}-revers-assign-3.1 {revers assign, deserial/serial} { + set serial {%3 {} {{f 6 {}}} %0 {foo bar} {{a 6 {}} {b 9 {bar snarf}} {c 0 {}}} %1 {} {{d 9 {}}} %2 {} {{e 0 {}}} {data foo}} + + SETUP + SETUP bgraph + proc bwrap {args} {uplevel #0 [linsert $args 0 bgraph]} + + mygraph deserialize $serial + + set result [validate_serial bgraph $serial] + mygraph --> bwrap + lappend result [validate_serial bgraph $serial] + + mygraph destroy + bgraph destroy + rename bwrap {} + set result +} {attr/graph/data-mismatch ok} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/serialize.test b/tcllib/modules/struct/graph/tests/serialize.test new file mode 100644 index 0000000..8c614eb --- /dev/null +++ b/tcllib/modules/struct/graph/tests/serialize.test @@ -0,0 +1,199 @@ +# -*- tcl -*- +# Graph tests - serialize +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: serialize.test,v 1.3 2008/10/11 23:23:48 andreas_kupries Exp $ + +# Syntax: graph serialize ?NODE...? + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +# Cannot have missing arguments, nor too many. + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-serialize-1.0 {serialize, missing node} { + SETUP + catch {mygraph serialize foo} result + mygraph destroy + set result +} [MissingNode $MY foo] + +# ------------------------------------------------------------------------- +# Ok arguments. + +test graph-${impl}-${setimpl}-serialize-2.0 {serialize, empty graph} { + SETUP + set serial [mygraph serialize] + set result [validate_serial mygraph $serial] + mygraph destroy + set result + + # serial = {{}} +} ok + +test graph-${impl}-${setimpl}-serialize-2.1 {serialize, complete graph} { + SETUP + + mygraph node insert %0 %1 %2 %3 + mygraph arc insert %0 %1 a + mygraph arc insert %0 %2 b + mygraph arc insert %0 %3 c + mygraph arc insert %1 %2 d + mygraph arc insert %2 %3 e + mygraph arc insert %3 %1 f + + mygraph set data foo + mygraph node set %0 foo bar + mygraph arc set b bar snarf + + set serial [mygraph serialize] + set result [validate_serial mygraph $serial] + mygraph destroy + set result + + # serial = + # %3 {} { /0 + # {f 6 {}} + # } + # %0 {foo bar} { /3 + # {a 6 {}} + # {b 9 {bar snarf}} + # {c 0 {}} + # } + # %1 {} { /6 + # {d 9 {}} + # } + # %2 {} { /9 + # {e 0 {}} + # } + # {data foo} +} ok + + +test graph-${impl}-${setimpl}-serialize-2.2 {serialize, complete graph, no attributes} { + SETUP + + mygraph node insert %0 %1 %2 %3 + mygraph arc insert %0 %1 a + mygraph arc insert %0 %2 b + mygraph arc insert %0 %3 c + mygraph arc insert %1 %2 d + mygraph arc insert %2 %3 e + mygraph arc insert %3 %1 f + + set serial [mygraph serialize] + set result [validate_serial mygraph $serial] + mygraph destroy + set result + + # serial = + # %3 {} { /0 + # {f 6 {}} + # } + # %0 {} { /3 + # {a 6 {}} + # {b 9 {}} + # {c 0 {}} + # } + # %1 {} { /6 + # {d 9 {}} + # } + # %2 {} { /9 + # {e 0 {}} + # } + # {} +} ok + +test graph-${impl}-${setimpl}-serialize-2.3 {serialize, subgraph} { + SETUP + + mygraph node insert %0 %1 %2 %3 + mygraph arc insert %0 %1 a + mygraph arc insert %0 %2 b + mygraph arc insert %0 %3 c + mygraph arc insert %1 %2 d + mygraph arc insert %2 %3 e + mygraph arc insert %3 %1 f + + mygraph set data foo + mygraph node set %0 foo bar + mygraph arc set b bar snarf + + set serial [mygraph serialize %0 %1 %3] + set result [validate_serial mygraph $serial {%0 %1 %3}] + mygraph destroy + set result + + # serial = + # %0 {foo bar} {{a 3 {}} {c 6 {}}} /0 + # %1 {} {} /3 + # %3 {} {{f 3 {}}} /6 + # {data foo} +} ok + + +test graph-${impl}-${setimpl}-serialize-2.4 {serialize, subgraph, duplicate nodes} { + SETUP + + mygraph node insert %0 %1 %2 %3 + mygraph arc insert %0 %1 a + mygraph arc insert %0 %2 b + mygraph arc insert %0 %3 c + mygraph arc insert %1 %2 d + mygraph arc insert %2 %3 e + mygraph arc insert %3 %1 f + + mygraph set data foo + mygraph node set %0 foo bar + mygraph arc set b bar snarf + + set serial [mygraph serialize %0 %1 %3 %0] + set result [validate_serial mygraph $serial {%0 %1 %3}] + mygraph destroy + set result + + # serial = + # %0 {foo bar} {{a 3 {}} {c 6 {}}} /0 + # %1 {} {} /3 + # %3 {} {{f 3 {}}} /6 + # {data foo} +} ok + +test graph-${impl}-${setimpl}-serialize-2.5 {serialize, complete graph, some weights} { + SETUP + + mygraph node insert %0 %1 %2 %3 + mygraph arc insert %0 %1 a + mygraph arc insert %0 %2 b + mygraph arc insert %0 %3 c + mygraph arc insert %1 %2 d ; mygraph arc setweight d 100 + mygraph arc insert %2 %3 e ; mygraph arc setweight e 200 + mygraph arc insert %3 %1 f ; mygraph arc setweight f 400 + + set serial [mygraph serialize] + set result [validate_serial mygraph $serial] + mygraph destroy + set result + + # serial = + # %3 {} { /0 + # {f 6 {} 400} + # } + # %0 {} { /3 + # {a 6 {}} + # {b 9 {}} + # {c 0 {}} + # } + # %1 {} { /6 + # {d 9 {} 100} + # } + # %2 {} { /9 + # {e 0 {} 200} + # } + # {} +} ok + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/swap.test b/tcllib/modules/struct/graph/tests/swap.test new file mode 100644 index 0000000..c785b38 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/swap.test @@ -0,0 +1,121 @@ +# -*- tcl -*- +# Graph tests - swap +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: swap.test,v 1.2 2007/04/12 03:01:55 andreas_kupries Exp $ + +# Syntax: graph swap NODE-1 NODE-2 + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-swap-1.0 {swap, wrong#args, missing} { + SETUP + catch {mygraph swap} msg + mygraph destroy + set msg +} [tmWrong swap {node1 node2} 0] + +test graph-${impl}-${setimpl}-swap-1.1 {swap, wrong#args, missing} { + SETUP + catch {mygraph swap a} msg + mygraph destroy + set msg +} [tmWrong swap {node1 node2} 1] + +test graph-${impl}-${setimpl}-swap-1.2 {swap, wrong#args, too many} { + SETUP + catch {mygraph swap a b c} msg + mygraph destroy + set msg +} [tmTooMany swap {node1 node2}] + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-swap-2.0 {swap, missing node} { + SETUP + mygraph node insert node1 + catch {mygraph swap node0 node1} msg + mygraph destroy + set msg +} [MissingNode $MY node0] + +test graph-${impl}-${setimpl}-swap-2.1 {swap, missing node} { + SETUP + mygraph node insert node0 + catch {mygraph swap node0 node1} msg + mygraph destroy + set msg +} [MissingNode $MY node1] + +test graph-${impl}-${setimpl}-swap-2.2 {swap, self} { + SETUP + mygraph node insert node0 + catch {mygraph swap node0 node0} msg + mygraph destroy + set msg +} "cannot swap node \"node0\" with itself" + +# ------------------------------------------------------------------------- +# Ok arguments. + +proc SETUP_2 {} { + + # +--/a4/-> n4 + # | + # n0 -/a1/-> n1 -/a3/-> n3 + # | + # +--/a2/-> n2 + + mygraph node insert n0 n1 n2 n3 n4 + mygraph arc insert n0 n1 a1 + mygraph arc insert n0 n2 a2 + mygraph arc insert n1 n3 a3 + mygraph arc insert n1 n4 a4 + return +} + +test graph-${impl}-${setimpl}-swap-3.0 {swap, node relationships} { + SETUP + SETUP_2 + + mygraph swap n0 n1 + + set result {} + lappend result [lsort [mygraph nodes -out n0]] + lappend result [lsort [mygraph nodes -out n1]] + + mygraph destroy + set result +} {{n3 n4} {n0 n2}} + +test graph-${impl}-${setimpl}-swap-3.1 {swap, node relationships} { + SETUP + SETUP_2 + + mygraph swap n0 n3 + + set result {} + lappend result [lsort [mygraph nodes -out n0]] + lappend result [lsort [mygraph nodes -out n3]] + + mygraph destroy + set result +} {{} {n1 n2}} + +test graph-${impl}-${setimpl}-swap-3.2 {swap, node relationships} { + SETUP + SETUP_2 + + mygraph swap n1 n0 + + set result {} + lappend result [lsort [mygraph nodes -out n0]] + lappend result [lsort [mygraph nodes -out n1]] + + mygraph destroy + set result +} {{n3 n4} {n0 n2}} + +# ------------------------------------------------------------------------- diff --git a/tcllib/modules/struct/graph/tests/walk.test b/tcllib/modules/struct/graph/tests/walk.test new file mode 100644 index 0000000..1741af5 --- /dev/null +++ b/tcllib/modules/struct/graph/tests/walk.test @@ -0,0 +1,207 @@ +# -*- tcl -*- +# Graph tests - walk +# Copyright (c) 2006 Andreas Kupries <andreas_kupries@users.sourceforge.net> +# All rights reserved. +# RCS: @(#) $Id: walk.test,v 1.3 2008/12/13 03:57:33 andreas_kupries Exp $ + +# Syntax: graph walk NODE ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd + +# ------------------------------------------------------------------------- +# Wrong # args: Missing, Too many + +test graph-${impl}-${setimpl}-walk-1.0 {walk, wrong#args, missing} {} { + SETUP + catch {mygraph walk} msg + mygraph destroy + set msg +} [tmWrong walk {node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd} 0 {node args}] + +test graph-${impl}-${setimpl}-walk-1.1 {walk, wrong#args, missing} {} { + SETUP + catch {mygraph walk %0} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\"" + +test graph-${impl}-${setimpl}-walk-1.2 {walk, wrong#args, missing} {} { + SETUP + catch {mygraph walk %0 -dir} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\"" + +test graph-${impl}-${setimpl}-walk-1.3 {walk, wrong#args, missing} {} { + SETUP + catch {mygraph walk %0 -order} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\"" + +test graph-${impl}-${setimpl}-walk-1.4 {walk, wrong#args, missing} {} { + SETUP + catch {mygraph walk %0 -type} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\"" + +test graph-${impl}-${setimpl}-walk-1.5 {walk, wrong#args, missing} {} { + SETUP + catch {mygraph walk %0 -command} msg + mygraph destroy + set msg +} "wrong # args: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\"" + +# ------------------------------------------------------------------------- +# Logical arguments checks and failures + +test graph-${impl}-${setimpl}-walk-2.0 {walk, missing node} { + SETUP + catch {mygraph walk node0 -command {}} msg + mygraph destroy + set msg +} [MissingNode $MY node0] + +test graph-${impl}-${setimpl}-walk-2.1 {walk, unknown option} { + SETUPwalk + catch {mygraph walk i -foo x -command {}} msg + mygraph destroy + set msg +} "unknown option \"-foo\": should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\"" + +test graph-${impl}-${setimpl}-walk-2.2 {walk, empty command} { + SETUPwalk + catch {mygraph walk i -command {}} msg + mygraph destroy + set msg +} "no command specified: should be \"$MY walk node ?-dir forward|backward? ?-order pre|post|both? ?-type bfs|dfs? -command cmd\"" + +test graph-${impl}-${setimpl}-walk-2.3 {walk, bad search type} { + SETUPwalk + catch {mygraph walk i -command foo -type foo} msg + mygraph destroy + set msg +} {bad search type "foo": must be bfs or dfs} + +test graph-${impl}-${setimpl}-walk-2.4 {walk, bad search direction} { + SETUPwalk + catch {mygraph walk i -command foo -type dfs -dir oneway} msg + mygraph destroy + set msg +} {bad search direction "oneway": must be backward or forward} + +test graph-${impl}-${setimpl}-walk-2.5 {walk, bad search order} { + SETUPwalk + catch {mygraph walk i -command foo -order none} msg + mygraph destroy + set msg +} {bad search order "none": must be both, pre, or post} + +test graph-${impl}-${setimpl}-walk-2.6 {walk, bad order/type combination} { + SETUPwalk + catch {mygraph walk i -command foo -order both -type bfs} msg + mygraph destroy + set msg +} {unable to do a both-order breadth first walk} + +test graph-${impl}-${setimpl}-walk-2.7 {walk, bad order/type combination} { + SETUPwalk + catch {mygraph walk i -command foo -order post -type bfs} msg + mygraph destroy + set msg +} {unable to do a post-order breadth first walk} + +# ------------------------------------------------------------------------- +# Ok arguments. + +proc record {a g n} {global t ; lappend t $a $n ; return} + +test graph-${impl}-${setimpl}-walk-3.0 {walk, forward pre dfs, default} { + SETUPwalk + set t {} + mygraph walk i -command record + mygraph destroy + set t +} [tmE {enter i enter ii enter iii enter iv enter v enter vi enter viii enter ix enter vii} \ + {enter i enter vii enter vi enter viii enter ix enter ii enter iii enter iv enter v}] + +test graph-${impl}-${setimpl}-walk-3.1 {walk, forward post dfs} { + SETUPwalk + set t [list ] + mygraph walk i -order post -command record + mygraph destroy + set t +} [tmE {leave viii leave vi leave v leave iv leave iii leave ii leave ix leave vii leave i} \ + {leave viii leave vi leave vii leave ix leave v leave iv leave iii leave ii leave i}] + +test graph-${impl}-${setimpl}-walk-3.1.1 {walk, forward post dfs} { + SETUP + mygraph node insert i ii iii + mygraph arc insert i ii 1 + mygraph arc insert i iii 2 + mygraph arc insert ii iii 3 + set t [list ] + mygraph walk i -order post -command record + mygraph destroy + set t +} [tmE {leave iii leave ii leave i} \ + {leave iii leave ii leave i}] + +test graph-${impl}-${setimpl}-walk-3.2 {walk, forward both dfs} { + SETUPwalk + set t [list ] + mygraph walk i -order both -command record + mygraph destroy + set t +} [tmE {enter i enter ii enter iii enter iv enter v enter vi enter viii leave viii leave vi leave v leave iv leave iii leave ii enter ix leave ix enter vii leave vii leave i} \ + {enter i enter vii enter vi enter viii leave viii leave vi leave vii enter ix leave ix enter ii enter iii enter iv enter v leave v leave iv leave iii leave ii leave i}] + +test graph-${impl}-${setimpl}-walk-3.3 {walk, forward pre bfs} { + SETUPwalk + set t [list ] + mygraph walk i -type bfs -command record + mygraph destroy + set t +} [tmE {enter i enter ii enter ix enter vii enter iii enter vi enter iv enter viii enter v} \ + {enter i enter vii enter ix enter ii enter vi enter iii enter viii enter iv enter v}] + +test graph-${impl}-${setimpl}-walk-3.4 {walk, backward pre bfs} { + SETUPwalk + set t [list ] + mygraph walk ix -type bfs -dir backward -command record + mygraph destroy + set t +} [tmE {enter ix enter i enter viii enter vi enter v enter vii enter iv enter iii enter ii} \ + {enter ix enter i enter viii enter vi enter vii enter v enter iv enter iii enter ii}] + +test graph-${impl}-${setimpl}-walk-3.5 {walk, backward pre dfs} { + SETUPwalk + set t [list ] + mygraph walk ix -dir backward -command record + mygraph destroy + set t +} [tmE {enter ix enter i enter viii enter vi enter v enter iv enter iii enter ii enter vii} \ + {enter ix enter i enter viii enter vi enter vii enter v enter iv enter iii enter ii}] + +test graph-${impl}-${setimpl}-walk-3.6 {walk, backward post dfs} { + SETUPwalk + set t [list ] + mygraph walk ix -dir backward -order post -command record + mygraph destroy + set t +} [tmE {leave ii leave iii leave iv leave v leave vii leave vi leave viii leave i leave ix} \ + {leave vii leave ii leave iii leave iv leave v leave vi leave viii leave i leave ix}] + +test graph-${impl}-${setimpl}-walk-3.7 {walk, backward both dfs} { + SETUPwalk + set t [list ] + mygraph walk ix -dir backward -order both -command record + mygraph destroy + set t +} [tmE {enter ix enter i enter viii enter vi enter v enter iv enter iii enter ii leave ii leave iii leave iv leave v enter vii leave vii leave vi leave viii leave i leave ix} \ + {enter ix enter i enter viii enter vi enter vii leave vii enter v enter iv enter iii enter ii leave ii leave iii leave iv leave v leave vi leave viii leave i leave ix}] + +# ------------------------------------------------------------------------- + +rename record {} + +# ------------------------------------------------------------------------- |