From 7dfaafb1a57a08579b8cd0208ebee0d9313006df Mon Sep 17 00:00:00 2001
From: Iustin Pop <iustin@google.com>
Date: Fri, 13 Mar 2009 08:49:12 +0100
Subject: [PATCH] Convert hbal from multiple rounds to a step-method

Currently hbal does multiple rounds, stopping when a rounds doesn't
bring improvements. With the recent changes to not remove instances from
the candidate list, this is obsolete as the first round will always run
to the end of the improvements.

This patch changes this so that the Cluster.checkMove function doesn't
recurse, but just computes the next best move (as its docstring says).
This means we can actually incrementally compute and print the solution,
and this is needed as otherwise an instance could move twice and the
second time it needs the current placement to compute the exact command
line and operation needed for the move.
---
 src/Cluster.hs |  5 ++--
 src/hbal.hs    | 76 ++++++++++++++++++++++++++------------------------
 2 files changed, 42 insertions(+), 39 deletions(-)

diff --git a/src/Cluster.hs b/src/Cluster.hs
index 2ae8e8689..8e2081847 100644
--- a/src/Cluster.hs
+++ b/src/Cluster.hs
@@ -22,6 +22,7 @@ module Cluster
     , computeSolution
     , applySolution
     , printSolution
+    , printSolutionLine
     , printNodes
     -- * Balacing functions
     , checkMove
@@ -423,9 +424,7 @@ checkMove nodes_idx ini_tbl victims =
       if length best_plc == length ini_plc then -- no advancement
           ini_tbl
       else
-          -- FIXME: replace 100 with a real constant
-          if (length best_plc > 100) then best_tbl
-          else checkMove nodes_idx best_tbl victims
+          best_tbl
 
 {- | Auxiliary function for solution computation.
 
diff --git a/src/hbal.hs b/src/hbal.hs
index 7b98d1940..352fbb4b7 100644
--- a/src/hbal.hs
+++ b/src/hbal.hs
@@ -27,7 +27,7 @@ data Options = Options
     , optOneline   :: Bool
     , optNodef     :: FilePath
     , optInstf     :: FilePath
-    , optMaxRounds :: Int
+    , optMaxLength :: Int
     , optMaster    :: String
     } deriving Show
 
@@ -39,7 +39,7 @@ defaultOptions  = Options
  , optOneline   = False
  , optNodef     = "nodes"
  , optInstf     = "instances"
- , optMaxRounds = -1
+ , optMaxLength = -1
  , optMaster    = ""
  }
 
@@ -47,12 +47,17 @@ defaultOptions  = Options
 we find a valid solution or we exceed the maximum depth.
 
 -}
-iterateDepth :: Cluster.Table    -- The starting table
-             -> Int              -- ^ Current round
-             -> Int              -- ^ Max rounds
+iterateDepth :: Cluster.Table    -- ^ The starting table
+             -> Int              -- ^ Remaining length
+             -> [(Int, String)]  -- ^ Node idx to name list
+             -> [(Int, String)]  -- ^ Inst idx to name list
+             -> Int              -- ^ Max node name len
+             -> Int              -- ^ Max instance name len
+             -> [[String]]       -- ^ Current command list
              -> Bool             -- ^ Wheter to be silent
-             -> IO Cluster.Table -- The resulting table
-iterateDepth ini_tbl cur_round max_rounds oneline =
+             -> IO (Cluster.Table, [[String]]) -- ^ The resulting table and
+                                               -- commands
+iterateDepth ini_tbl max_rounds ktn kti nmlen imlen cmd_strs oneline =
     let Cluster.Table ini_nl ini_il ini_cv ini_plc = ini_tbl
         all_inst = Container.elems ini_il
         node_idx = Container.keys ini_nl
@@ -60,32 +65,24 @@ iterateDepth ini_tbl cur_round max_rounds oneline =
         (Cluster.Table _ _ fin_cv fin_plc) = fin_tbl
         ini_plc_len = length ini_plc
         fin_plc_len = length fin_plc
-        allowed_next = (max_rounds < 0 || cur_round < max_rounds)
+        allowed_next = (max_rounds < 0 || length fin_plc < max_rounds)
     in
       do
-        unless oneline $ printf "  - round %d: " cur_round
-        hFlush stdout
-        let msg =
-                if fin_cv < ini_cv then
-                    if not allowed_next then
-                        printf "%.8f, %d moves (stopping due to round limit)\n"
-                               fin_cv
-                               (fin_plc_len - ini_plc_len)
-                    else
-                        printf "%.8f, %d moves\n" fin_cv
-                                   (fin_plc_len - ini_plc_len)
-                else
-                    "no improvement, stopping\n"
-        unless oneline $ do
-          putStr msg
+        let
+            (sol_line, cmds) = Cluster.printSolutionLine ini_il ktn kti
+                               nmlen imlen (head fin_plc)
+            upd_cmd_strs = cmds:cmd_strs
+        unless (oneline || fin_plc_len == ini_plc_len) $ do
+          putStrLn sol_line
           hFlush stdout
         (if fin_cv < ini_cv then -- this round made success, try deeper
              if allowed_next
-             then iterateDepth fin_tbl (cur_round + 1) max_rounds oneline
+             then iterateDepth fin_tbl max_rounds ktn kti
+                  nmlen imlen upd_cmd_strs oneline
              -- don't go deeper, but return the better solution
-             else return fin_tbl
+             else return (fin_tbl, upd_cmd_strs)
          else
-             return ini_tbl)
+             return (ini_tbl, cmd_strs))
 
 -- | Options list and functions
 options :: [OptDescr (Options -> Options)]
@@ -108,9 +105,10 @@ options =
      , Option ['m']     ["master"]
       (ReqArg (\ m opts -> opts { optMaster = m }) "ADDRESS")
       "collect data via RAPI at the given ADDRESS"
-     , Option ['r']     ["max-rounds"]
-      (ReqArg (\ i opts -> opts { optMaxRounds =  (read i)::Int }) "N")
-      "do not run for more than R rounds(useful for very unbalanced clusters)"
+     , Option ['l']     ["max-length"]
+      (ReqArg (\ i opts -> opts { optMaxLength =  (read i)::Int }) "N")
+      "cap the solution at this many moves (useful for very unbalanced \
+      \clusters)"
      ]
 
 -- | Command line parser, using the 'options' structure.
@@ -167,22 +165,28 @@ main = do
          ini_cv (Cluster.printStats nl)
 
   unless oneline $ putStrLn "Trying to minimize the CV..."
-  fin_tbl <- iterateDepth ini_tbl 1 (optMaxRounds opts) oneline
+  let mlen_fn = maximum . (map length) . snd . unzip
+      imlen = mlen_fn kti
+      nmlen = mlen_fn ktn
+
+  (fin_tbl, cmd_strs) <- iterateDepth ini_tbl (optMaxLength opts)
+                         ktn kti nmlen imlen [] oneline
   let (Cluster.Table fin_nl _ fin_cv fin_plc) = fin_tbl
       ord_plc = reverse fin_plc
-  unless oneline $ printf "Final coefficients:   overall %.8f, %s\n"
-         fin_cv
-         (Cluster.printStats fin_nl)
+  unless oneline $ do
+         (if null fin_plc
+          then printf "No solution found\n"
+          else printf "Final coefficients:   overall %.8f, %s\n"
+               fin_cv (Cluster.printStats fin_nl))
 
   unless oneline $ printf "Solution length=%d\n" (length ord_plc)
 
-  let (sol_strs, cmd_strs) = Cluster.printSolution il ktn kti ord_plc
-  unless oneline $ putStr $ unlines $ sol_strs
   when (optShowCmds opts) $
        do
          putStrLn ""
          putStrLn "Commands to run to reach the above solution:"
-         putStr $ unlines $ map ("  echo gnt-instance " ++) $ concat cmd_strs
+         putStr $ unlines $ map ("  echo gnt-instance " ++)
+                    $ concat $ reverse cmd_strs
   when (optShowNodes opts) $
        do
          let (orig_mem, orig_disk) = Cluster.totalResources nl
-- 
GitLab