In tiered allocation, cut non-promising shrinking tries

The heuristics for tiered allocation has been improved in that it
chooses to shrink such a resource next where by shrinking only this
resource a valid allocation can be made, if such a resource exists.
In order to decide whether such a resource exists, all potential
sizes of this resource are verified. We can improve performance by
cutting, as soon a potential allocation of an instance is no longer
blocked on this resource.

Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>

diff --git a/src/Ganeti/HTools/Cluster.hs b/src/Ganeti/HTools/Cluster.hs
index e598d0d..efed5fa 100644 (file)
--- a/src/Ganeti/HTools/Cluster.hs
+++ b/src/Ganeti/HTools/Cluster.hs
@@ -76,6 +76,7 @@ module Ganeti.HTools.Cluster
   , splitCluster
   ) where
 
+import Control.Applicative (liftA2)
 import qualified Data.IntSet as IntSet
 import Data.List
 import Data.Maybe (fromJust, fromMaybe, isJust, isNothing)
@@ -1283,8 +1284,12 @@ iterateAlloc nl il limit newinst allocnodes ixes cstats =
 -- allocation.
 sufficesShrinking :: (Instance.Instance -> AllocSolution) -> Instance.Instance
                      -> FailMode  -> Bool
-sufficesShrinking allocFn inst fm = any isJust . map (asSolution . allocFn) $
-                                    iterateOk (`Instance.shrinkByType` fm) inst
+sufficesShrinking allocFn inst fm =
+  any isJust 
+  . map asSolution 
+  . takeWhile (liftA2 (||) (elem fm . asFailures) (isJust . asSolution))
+  . map allocFn $
+  iterateOk (`Instance.shrinkByType` fm) inst
 
 -- | Tiered allocation method.
 --