Commit | Line | Data |
---|---|---|
967c39ef MM |
1 | module Test ( |
2 | -- Export everything we need to have fun in GHCi: | |
3 | ||
4 | -- See the results of examples. | |
5 | module Test, | |
6 | ||
7 | -- Generate instances. | |
8 | module Instance, | |
9 | module InstanceGenerator, | |
10 | ||
11 | -- Solve instances. | |
12 | module ProposalMatcher, | |
13 | module ProposalMatcherConfig, | |
14 | ||
15 | -- Run randomized things. | |
16 | module System.Random, | |
17 | module RandomizedMonad, | |
18 | ||
19 | -- Visualize graphs. | |
20 | module Data.Graph.Inductive.Graphviz | |
21 | ) where | |
22 | import Instance | |
23 | import InstanceGenerator | |
24 | import ProposalMatcher | |
25 | import ProposalMatcherConfig | |
26 | import System.Random | |
27 | import RandomizedMonad | |
28 | import Data.Graph.Inductive.Graphviz | |
29 | ||
30 | -- Other imports we need | |
d7d9561e | 31 | import BellmanFord |
5a07db44 | 32 | import NaiveMinCostFlow |
967c39ef MM |
33 | import Data.Array.IArray |
34 | import Data.Array.Unboxed | |
d7d9561e MM |
35 | import Data.Graph.Inductive.Graph |
36 | import Data.Graph.Inductive.Tree | |
967c39ef | 37 | import ArrayStuff |
2e7d5426 | 38 | |
2ed0056e MM |
39 | -- A fixed-seeded random number generator for reproducible experimentation. |
40 | myGen = read "314159265 1" :: StdGen | |
41 | ||
42 | -- TESTING GRAPH ALGORITHMS | |
d7d9561e | 43 | myGraph = mkGraph [(0, ()), (1, ()), (2, ())] |
5a07db44 | 44 | [(0, 1, (0, 2)), (0, 2, (1, 3)), (2, 1, (2, -2))] :: Gr () (Int, Int) |
d7d9561e | 45 | |
5a07db44 | 46 | bfResult = bellmanFord snd 0 myGraph |
d7d9561e | 47 | |
5a07db44 MM |
48 | flowArray = minCostFlow (0, 2) fst (const 1) snd myGraph (0, 1) |
49 | ||
50 | myNCGraph = mkGraph [(0, ())] [(0, 0, -1)] :: Gr () Int | |
51 | bfNCResult = bellmanFord id 0 myNCGraph | |
52 | ||
2ed0056e | 53 | -- VISUALIZATION STUFF |
5a07db44 MM |
54 | data REdgeF = REdgeF Int Int Int Wt |
55 | instance Show REdgeF where | |
56 | show (REdgeF idx cap flow cost) = "#" ++ (show idx) ++ ": " | |
57 | ++ (show flow) ++ " of " ++ (show cap) ++ " @ " ++ (show cost) | |
58 | flowAnnotate g fa = | |
59 | mkGraph (labNodes g) (map (\(n1, n2, REdge i ca co) -> | |
60 | (n1, n2, REdgeF i ca (fa ! i) co)) $ labEdges g) :: Gr () REdgeF | |
d7d9561e | 61 | |
2ed0056e MM |
62 | showInstanceAsGraph :: Instance -> [(Int, Int)] -> Gr String String |
63 | showInstanceAsGraph (Instance numRvrs numProps rloadA prefA) matchedPairs = | |
64 | let | |
65 | rvrNode i = i | |
66 | propNode j = numRvrs + j | |
67 | numNodes = numRvrs + numProps | |
68 | theNodes = map (\i -> (rvrNode i, "R#" ++ show i ++ | |
69 | " (RLoad " ++ show (rloadA ! i) ++ ")")) [0..numRvrs-1] ++ | |
70 | map (\j -> (propNode j, "P#" ++ show j)) [0..numProps-1] | |
71 | parenthesizeIf False s = s | |
72 | parenthesizeIf True s = "(" ++ s ++ ")" | |
73 | theEdges = do | |
74 | i <- [0..numRvrs-1] | |
75 | j <- [0..numProps-1] | |
76 | return (rvrNode i, propNode j, | |
77 | parenthesizeIf (elem (i, j) matchedPairs) $ show (prefA ! (i, j))) | |
78 | in mkGraph theNodes theEdges | |
79 | ||
80 | -- PROPOSAL-MATCHING EXAMPLES | |
d7d9561e MM |
81 | -- Example from idea book p. 425 |
82 | {- | |
83 | (myNumRvrs, myNumProps) = (4, 3) | |
84 | ||
85 | myPrefsArray = array ((0,0), (myNumRvrs-1,myNumProps-1)) [ | |
86 | ((0, 0), 15), ((1, 0), 10), ((2, 0), 15), ((3, 0), 40), | |
87 | ((0, 1), 30), ((1, 1), 7), ((2, 1), 10), ((3, 1), 15), | |
88 | ((0, 2), 15), ((1, 2), 25), ((2, 2), 20), ((3, 2), 20) | |
89 | ] | |
90 | -} | |
91 | ||
92 | (myNumRvrs, myNumProps) = (5, 3) | |
93 | ||
967c39ef MM |
94 | myPrefs = transposeArray $ listArray ((0,0), (myNumProps-1,myNumRvrs-1)) [ |
95 | 15, 10, 15, 40, 20, | |
96 | 30, 7, 10, 15, 15, | |
97 | 15, 25, 20, 20, 15 | |
98 | ] :: UArray (Int, Int) Wt | |
d7d9561e | 99 | |
967c39ef | 100 | myInst = Instance myNumRvrs myNumProps (funcArray (0, myNumRvrs-1) $ const 1) myPrefs |
d7d9561e | 101 | |
5a07db44 MM |
102 | rdnResult = doReduction myInst |
103 | ReductionResult rrg rrso rrsi rreib rredi = rdnResult | |
104 | rdnFlowArray = minCostFlow rreib reIdx reCap reCost rrg (rrso, rrsi) | |
105 | rrg2 = flowAnnotate rrg rdnFlowArray | |
d7d9561e | 106 | myMatching = doMatching myInst |
2ed0056e MM |
107 | |
108 | iGraph = showInstanceAsGraph myInst myMatching -- Visualize me! |