60 |
60 |
[ oPrintNodes
|
61 |
61 |
, oPrintInsts
|
62 |
62 |
, oPrintCommands
|
63 |
|
, oOneline
|
64 |
63 |
, oDataFile
|
65 |
64 |
, oEvacMode
|
66 |
65 |
, oRapiMaster
|
... | ... | |
98 |
97 |
-> Int -- ^ Max node name len
|
99 |
98 |
-> Int -- ^ Max instance name len
|
100 |
99 |
-> [MoveJob] -- ^ Current command list
|
101 |
|
-> Bool -- ^ Whether to be silent
|
102 |
100 |
-> Score -- ^ Score at which to stop
|
103 |
101 |
-> Score -- ^ Min gain limit
|
104 |
102 |
-> Score -- ^ Min score gain
|
... | ... | |
106 |
104 |
-> IO (Cluster.Table, [MoveJob]) -- ^ The resulting table
|
107 |
105 |
-- and commands
|
108 |
106 |
iterateDepth ini_tbl max_rounds disk_moves inst_moves nmlen imlen
|
109 |
|
cmd_strs oneline min_score mg_limit min_gain evac_mode =
|
|
107 |
cmd_strs min_score mg_limit min_gain evac_mode =
|
110 |
108 |
let Cluster.Table ini_nl ini_il _ _ = ini_tbl
|
111 |
109 |
allowed_next = Cluster.doNextBalance ini_tbl max_rounds min_score
|
112 |
110 |
m_fin_tbl = if allowed_next
|
... | ... | |
125 |
123 |
nmlen imlen cur_plc fin_plc_len
|
126 |
124 |
afn = Cluster.involvedNodes ini_il cur_plc
|
127 |
125 |
upd_cmd_strs = (afn, idx, move, cmds):cmd_strs
|
128 |
|
unless oneline $ do
|
129 |
|
putStrLn sol_line
|
130 |
|
hFlush stdout
|
|
126 |
putStrLn sol_line
|
|
127 |
hFlush stdout
|
131 |
128 |
iterateDepth fin_tbl max_rounds disk_moves inst_moves
|
132 |
|
nmlen imlen upd_cmd_strs oneline min_score
|
|
129 |
nmlen imlen upd_cmd_strs min_score
|
133 |
130 |
mg_limit min_gain evac_mode
|
134 |
131 |
Nothing -> return (ini_tbl, cmd_strs)
|
135 |
132 |
|
136 |
|
-- | Formats the solution for the oneline display.
|
137 |
|
formatOneline :: Double -> Int -> Double -> String
|
138 |
|
formatOneline ini_cv plc_len fin_cv =
|
139 |
|
printf "%.8f %d %.8f %8.3f" ini_cv plc_len fin_cv
|
140 |
|
(if fin_cv == 0 then 1 else ini_cv / fin_cv)
|
141 |
|
|
142 |
133 |
-- | Displays the cluster stats.
|
143 |
134 |
printStats :: Node.List -> Node.List -> IO ()
|
144 |
135 |
printStats ini_nl fin_nl = do
|
... | ... | |
324 |
315 |
Just cdata -> return (Group.name grp, cdata)
|
325 |
316 |
|
326 |
317 |
-- | Do a few checks on the cluster data.
|
327 |
|
checkCluster :: Bool -> Int -> Node.List -> Instance.List -> IO ()
|
328 |
|
checkCluster oneline verbose nl il = do
|
|
318 |
checkCluster :: Int -> Node.List -> Instance.List -> IO ()
|
|
319 |
checkCluster verbose nl il = do
|
329 |
320 |
-- nothing to do on an empty cluster
|
330 |
321 |
when (Container.null il) $ do
|
331 |
|
(if oneline then putStrLn $ formatOneline 0 0 0
|
332 |
|
else printf "Cluster is empty, exiting.\n")
|
|
322 |
printf "Cluster is empty, exiting.\n"::IO ()
|
333 |
323 |
exitWith ExitSuccess
|
334 |
324 |
|
335 |
325 |
-- hbal doesn't currently handle split clusters
|
... | ... | |
340 |
330 |
hPutStrLn stderr "Aborting."
|
341 |
331 |
exitWith $ ExitFailure 1
|
342 |
332 |
|
343 |
|
unless oneline $ printf "Loaded %d nodes, %d instances\n"
|
|
333 |
printf "Loaded %d nodes, %d instances\n"
|
344 |
334 |
(Container.size nl)
|
345 |
|
(Container.size il)
|
|
335 |
(Container.size il)::IO ()
|
346 |
336 |
|
347 |
337 |
let csf = commonSuffix nl il
|
348 |
|
when (not (null csf) && not oneline && verbose > 1) $
|
|
338 |
when (not (null csf) && verbose > 1) $
|
349 |
339 |
printf "Note: Stripping common suffix of '%s' from names\n" csf
|
350 |
340 |
|
351 |
341 |
-- | Do a few checks on the selected group data.
|
352 |
|
checkGroup :: Bool -> Int -> String -> Node.List -> Instance.List -> IO ()
|
353 |
|
checkGroup oneline verbose gname nl il = do
|
354 |
|
unless oneline $ printf "Group size %d nodes, %d instances\n"
|
|
342 |
checkGroup :: Int -> String -> Node.List -> Instance.List -> IO ()
|
|
343 |
checkGroup verbose gname nl il = do
|
|
344 |
printf "Group size %d nodes, %d instances\n"
|
355 |
345 |
(Container.size nl)
|
356 |
|
(Container.size il)
|
|
346 |
(Container.size il)::IO ()
|
357 |
347 |
|
358 |
348 |
putStrLn $ "Selected node group: " ++ gname
|
359 |
349 |
|
360 |
350 |
let (bad_nodes, bad_instances) = Cluster.computeBadItems nl il
|
361 |
|
unless (oneline || verbose == 0) $ printf
|
|
351 |
unless (verbose == 0) $ printf
|
362 |
352 |
"Initial check done: %d bad nodes, %d bad instances.\n"
|
363 |
353 |
(length bad_nodes) (length bad_instances)
|
364 |
354 |
|
... | ... | |
370 |
360 |
checkNeedRebalance :: Options -> Score -> IO ()
|
371 |
361 |
checkNeedRebalance opts ini_cv = do
|
372 |
362 |
let min_cv = optMinScore opts
|
373 |
|
oneline = optOneline opts
|
374 |
363 |
when (ini_cv < min_cv) $ do
|
375 |
|
(if oneline then
|
376 |
|
putStrLn $ formatOneline ini_cv 0 ini_cv
|
377 |
|
else printf "Cluster is already well balanced (initial score %.6g,\n\
|
378 |
|
\minimum score %.6g).\nNothing to do, exiting\n"
|
379 |
|
ini_cv min_cv)
|
|
364 |
printf "Cluster is already well balanced (initial score %.6g,\n\
|
|
365 |
\minimum score %.6g).\nNothing to do, exiting\n"
|
|
366 |
ini_cv min_cv:: IO ()
|
380 |
367 |
exitWith ExitSuccess
|
381 |
368 |
|
382 |
369 |
-- | Main function.
|
... | ... | |
389 |
376 |
hPutStrLn stderr "Error: this program doesn't take any arguments."
|
390 |
377 |
exitWith $ ExitFailure 1
|
391 |
378 |
|
392 |
|
let oneline = optOneline opts
|
393 |
|
verbose = optVerbose opts
|
|
379 |
let verbose = optVerbose opts
|
394 |
380 |
shownodes = optShowNodes opts
|
395 |
381 |
showinsts = optShowInsts opts
|
396 |
382 |
|
397 |
383 |
ini_cdata@(ClusterData gl fixed_nl ilf ctags) <- loadExternalData opts
|
398 |
384 |
|
399 |
|
when (not oneline && verbose > 1) $
|
|
385 |
when (verbose > 1) $
|
400 |
386 |
putStrLn $ "Loaded cluster tags: " ++ intercalate "," ctags
|
401 |
387 |
|
402 |
388 |
nlf <- setNodesStatus opts fixed_nl
|
403 |
|
checkCluster oneline verbose nlf ilf
|
|
389 |
checkCluster verbose nlf ilf
|
404 |
390 |
|
405 |
391 |
maybeSaveData (optSaveCluster opts) "original" "before balancing" ini_cdata
|
406 |
392 |
|
407 |
393 |
(gname, (nl, il)) <- selectGroup opts gl nlf ilf
|
408 |
394 |
|
409 |
|
checkGroup oneline verbose gname nl il
|
|
395 |
checkGroup verbose gname nl il
|
410 |
396 |
|
411 |
397 |
maybePrintInsts showinsts "Initial" (Cluster.printInsts nl il)
|
412 |
398 |
|
... | ... | |
418 |
404 |
|
419 |
405 |
checkNeedRebalance opts ini_cv
|
420 |
406 |
|
421 |
|
unless oneline (if verbose > 2 then
|
422 |
|
printf "Initial coefficients: overall %.8f, %s\n"
|
423 |
|
ini_cv (Cluster.printStats nl)
|
424 |
|
else
|
425 |
|
printf "Initial score: %.8f\n" ini_cv)
|
|
407 |
(if verbose > 2
|
|
408 |
then printf "Initial coefficients: overall %.8f, %s\n"
|
|
409 |
ini_cv (Cluster.printStats nl)::IO ()
|
|
410 |
else printf "Initial score: %.8f\n" ini_cv)
|
426 |
411 |
|
427 |
|
unless oneline $ putStrLn "Trying to minimize the CV..."
|
|
412 |
putStrLn "Trying to minimize the CV..."
|
428 |
413 |
let imlen = maximum . map (length . Instance.alias) $ Container.elems il
|
429 |
414 |
nmlen = maximum . map (length . Node.alias) $ Container.elems nl
|
430 |
415 |
|
431 |
416 |
(fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
|
432 |
417 |
(optDiskMoves opts)
|
433 |
418 |
(optInstMoves opts)
|
434 |
|
nmlen imlen [] oneline min_cv
|
|
419 |
nmlen imlen [] min_cv
|
435 |
420 |
(optMinGainLim opts) (optMinGain opts)
|
436 |
421 |
(optEvacMode opts)
|
437 |
422 |
let (Cluster.Table fin_nl fin_il fin_cv fin_plc) = fin_tbl
|
... | ... | |
445 |
430 |
printf "Cluster score improved from %.8f to %.8f\n"
|
446 |
431 |
ini_cv fin_cv ::String
|
447 |
432 |
|
448 |
|
unless oneline $ putStr sol_msg
|
|
433 |
putStr sol_msg
|
449 |
434 |
|
450 |
|
unless (oneline || verbose == 0) $
|
|
435 |
unless (verbose == 0) $
|
451 |
436 |
printf "Solution length=%d\n" (length ord_plc)
|
452 |
437 |
|
453 |
438 |
let cmd_jobs = Cluster.splitJobs cmd_strs
|
... | ... | |
464 |
449 |
|
465 |
450 |
when (verbose > 3) $ printStats nl fin_nl
|
466 |
451 |
|
467 |
|
when oneline $ putStrLn $ formatOneline ini_cv (length ord_plc) fin_cv
|
468 |
|
|
469 |
452 |
eval <- maybeExecJobs opts ord_plc fin_nl il cmd_jobs
|
470 |
453 |
unless eval (exitWith (ExitFailure 1))
|