Stop GHC 6.6.1 from fussing about lack of a trailing newline.
[match/match.git] / program / Test.hs
... / ...
CommitLineData
1module Test (
2 -- Export everything we need to have fun in GHCi:
3 module Test,
4 module TestUtils,
5
6 -- Generate instances.
7 module PMInstance,
8 module PMInstanceGenerator,
9
10 -- Solve instances.
11 module ProposalMatcher,
12 module PMDefaults,
13
14 -- Run randomized things.
15 module System.Random,
16 module RandomizedMonad,
17
18 -- Evaluate.
19 module Evaluation
20) where
21import TestUtils
22import PMInstance
23import PMInstanceGenerator
24import ProposalMatcher
25import PMDefaults
26import System.Random
27import RandomizedMonad
28import Evaluation
29
30-- Other imports we need
31import BellmanFord
32import Data.Array.IArray
33import Data.Array.Unboxed
34import Data.Graph.Inductive.Graph
35import Data.Graph.Inductive.Tree
36import ArrayStuff
37
38-- TESTING GRAPH ALGORITHMS
39myGraph = mkGraph [(0, ()), (1, ()), (2, ())]
40 [(0, 1, (0, 2)), (0, 2, (1, 3)), (2, 1, (2, -2))] :: Gr () (Int, Int)
41
42bfResult = bellmanFord snd 0 myGraph
43
44flowArray = minCostFlow pmDefaults (0, 2) fst (const 1) snd myGraph (0, 1)
45
46myNCGraph = mkGraph [(0, ())] [(0, 0, -1)] :: Gr () Int
47bfNCResult = bellmanFord id 0 myNCGraph
48
49-- PROPOSAL-MATCHING EXAMPLES
50-- Example from idea book p. 425
51{-
52(myNumRvrs, myNumProps) = (4, 3)
53
54myPrefsArray = array ((0,0), (myNumRvrs-1,myNumProps-1)) [
55 ((0, 0), 15), ((1, 0), 10), ((2, 0), 15), ((3, 0), 40),
56 ((0, 1), 30), ((1, 1), 7), ((2, 1), 10), ((3, 1), 15),
57 ((0, 2), 15), ((1, 2), 25), ((2, 2), 20), ((3, 2), 20)
58 ]
59-}
60
61(myNumRvrs, myNumProps) = (5, 3)
62
63myPrefs = transposeArray $ listArray ((0,0), (myNumProps-1,myNumRvrs-1)) [
64 15, 10, 15, 40, 20,
65 30, 7, 10, 15, 15,
66 15, 25, 20, 20, 15
67 ] :: UArray (Int, Int) Wt
68
69myInst = PMInstance myNumRvrs myNumProps (constArray (0, myNumRvrs-1) 1) myPrefs
70
71rdnResult = doReduction pmDefaults myInst
72ReductionResult rrg rrso rrsi rreib rredi = rdnResult
73rdnFlowArray = minCostFlow pmDefaults rreib reIdx reCap reCost rrg (rrso, rrsi)
74rrg2 = flowAnnotate rrg rdnFlowArray
75myMatching = doMatching pmDefaults myInst
76
77iGraph = showInstanceAsGraph myInst myMatching -- Visualize me!