27 |
27 |
, optOneline :: Bool
|
28 |
28 |
, optNodef :: FilePath
|
29 |
29 |
, optInstf :: FilePath
|
30 |
|
, optMaxRounds :: Int
|
|
30 |
, optMaxLength :: Int
|
31 |
31 |
, optMaster :: String
|
32 |
32 |
} deriving Show
|
33 |
33 |
|
... | ... | |
39 |
39 |
, optOneline = False
|
40 |
40 |
, optNodef = "nodes"
|
41 |
41 |
, optInstf = "instances"
|
42 |
|
, optMaxRounds = -1
|
|
42 |
, optMaxLength = -1
|
43 |
43 |
, optMaster = ""
|
44 |
44 |
}
|
45 |
45 |
|
... | ... | |
47 |
47 |
we find a valid solution or we exceed the maximum depth.
|
48 |
48 |
|
49 |
49 |
-}
|
50 |
|
iterateDepth :: Cluster.Table -- The starting table
|
51 |
|
-> Int -- ^ Current round
|
52 |
|
-> Int -- ^ Max rounds
|
|
50 |
iterateDepth :: Cluster.Table -- ^ The starting table
|
|
51 |
-> Int -- ^ Remaining length
|
|
52 |
-> [(Int, String)] -- ^ Node idx to name list
|
|
53 |
-> [(Int, String)] -- ^ Inst idx to name list
|
|
54 |
-> Int -- ^ Max node name len
|
|
55 |
-> Int -- ^ Max instance name len
|
|
56 |
-> [[String]] -- ^ Current command list
|
53 |
57 |
-> Bool -- ^ Wheter to be silent
|
54 |
|
-> IO Cluster.Table -- The resulting table
|
55 |
|
iterateDepth ini_tbl cur_round max_rounds oneline =
|
|
58 |
-> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
|
|
59 |
-- commands
|
|
60 |
iterateDepth ini_tbl max_rounds ktn kti nmlen imlen cmd_strs oneline =
|
56 |
61 |
let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
|
57 |
62 |
all_inst = Container.elems ini_il
|
58 |
63 |
node_idx = Container.keys ini_nl
|
... | ... | |
60 |
65 |
(Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
|
61 |
66 |
ini_plc_len = length ini_plc
|
62 |
67 |
fin_plc_len = length fin_plc
|
63 |
|
allowed_next = (max_rounds < 0 || cur_round < max_rounds)
|
|
68 |
allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
|
64 |
69 |
in
|
65 |
70 |
do
|
66 |
|
unless oneline $ printf " - round %d: " cur_round
|
67 |
|
hFlush stdout
|
68 |
|
let msg =
|
69 |
|
if fin_cv < ini_cv then
|
70 |
|
if not allowed_next then
|
71 |
|
printf "%.8f, %d moves (stopping due to round limit)\n"
|
72 |
|
fin_cv
|
73 |
|
(fin_plc_len - ini_plc_len)
|
74 |
|
else
|
75 |
|
printf "%.8f, %d moves\n" fin_cv
|
76 |
|
(fin_plc_len - ini_plc_len)
|
77 |
|
else
|
78 |
|
"no improvement, stopping\n"
|
79 |
|
unless oneline $ do
|
80 |
|
putStr msg
|
|
71 |
let
|
|
72 |
(sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti
|
|
73 |
nmlen imlen (head fin_plc)
|
|
74 |
upd_cmd_strs = cmds:cmd_strs
|
|
75 |
unless (oneline || fin_plc_len == ini_plc_len) $ do
|
|
76 |
putStrLn sol_line
|
81 |
77 |
hFlush stdout
|
82 |
78 |
(if fin_cv < ini_cv then -- this round made success, try deeper
|
83 |
79 |
if allowed_next
|
84 |
|
then iterateDepth fin_tbl (cur_round + 1) max_rounds oneline
|
|
80 |
then iterateDepth fin_tbl max_rounds ktn kti
|
|
81 |
nmlen imlen upd_cmd_strs oneline
|
85 |
82 |
-- don't go deeper, but return the better solution
|
86 |
|
else return fin_tbl
|
|
83 |
else return (fin_tbl, upd_cmd_strs)
|
87 |
84 |
else
|
88 |
|
return ini_tbl)
|
|
85 |
return (ini_tbl, cmd_strs))
|
89 |
86 |
|
90 |
87 |
-- | Options list and functions
|
91 |
88 |
options :: [OptDescr (Options -> Options)]
|
... | ... | |
108 |
105 |
, Option ['m'] ["master"]
|
109 |
106 |
(ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
|
110 |
107 |
"collect data via RAPI at the given ADDRESS"
|
111 |
|
, Option ['r'] ["max-rounds"]
|
112 |
|
(ReqArg (\ i opts -> opts { optMaxRounds = (read i)::Int }) "N")
|
113 |
|
"do not run for more than R rounds(useful for very unbalanced clusters)"
|
|
108 |
, Option ['l'] ["max-length"]
|
|
109 |
(ReqArg (\ i opts -> opts { optMaxLength = (read i)::Int }) "N")
|
|
110 |
"cap the solution at this many moves (useful for very unbalanced \
|
|
111 |
\clusters)"
|
114 |
112 |
]
|
115 |
113 |
|
116 |
114 |
-- | Command line parser, using the 'options' structure.
|
... | ... | |
167 |
165 |
ini_cv (Cluster.printStats nl)
|
168 |
166 |
|
169 |
167 |
unless oneline $ putStrLn "Trying to minimize the CV..."
|
170 |
|
fin_tbl <- iterateDepth ini_tbl 1 (optMaxRounds opts) oneline
|
|
168 |
let mlen_fn = maximum . (map length) . snd . unzip
|
|
169 |
imlen = mlen_fn kti
|
|
170 |
nmlen = mlen_fn ktn
|
|
171 |
|
|
172 |
(fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
|
|
173 |
ktn kti nmlen imlen [] oneline
|
171 |
174 |
let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
|
172 |
175 |
ord_plc = reverse fin_plc
|
173 |
|
unless oneline $ printf "Final coefficients: overall %.8f, %s\n"
|
174 |
|
fin_cv
|
175 |
|
(Cluster.printStats fin_nl)
|
|
176 |
unless oneline $ do
|
|
177 |
(if null fin_plc
|
|
178 |
then printf "No solution found\n"
|
|
179 |
else printf "Final coefficients: overall %.8f, %s\n"
|
|
180 |
fin_cv (Cluster.printStats fin_nl))
|
176 |
181 |
|
177 |
182 |
unless oneline $ printf "Solution length=%d\n" (length ord_plc)
|
178 |
183 |
|
179 |
|
let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti ord_plc
|
180 |
|
unless oneline $ putStr $ unlines $ sol_strs
|
181 |
184 |
when (optShowCmds opts) $
|
182 |
185 |
do
|
183 |
186 |
putStrLn ""
|
184 |
187 |
putStrLn "Commands to run to reach the above solution:"
|
185 |
|
putStr $ unlines $ map (" echo gnt-instance " ++) $ concat cmd_strs
|
|
188 |
putStr $ unlines $ map (" echo gnt-instance " ++)
|
|
189 |
$ concat $ reverse cmd_strs
|
186 |
190 |
when (optShowNodes opts) $
|
187 |
191 |
do
|
188 |
192 |
let (orig_mem, orig_disk) = Cluster.totalResources nl
|