Revision 7dfaafb1 src/hbal.hs
| b/src/hbal.hs | ||
|---|---|---|
| 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 |
Also available in: Unified diff