tiered allocation: try canonical search path first

In tiered allocation, instances are put on the cluster, while they
fit---and once no more instances of the given size can be fit, smaller
instances are tried next. There is obviously some heuristics involved
in how to shrink the instance to get a smaller one of suitable
size. The standard heuristics is to shrink on the resource that
prevents to most placements. This, however, can lead into missing out
possible smaller instances, as noted in issue 483. The way to avoid
this trap was to consider all shrinkings of a single resource to see
if this leads to new solutions. This patch now changes the order of
the search: use this single resource look-ahead only if the standard
heuristics does not yield any progress. While this does not change the
complexity of the underlying algorithm, it improves search time
significantly for those cases where the standard heuristics works,
which should cover a good part of the practically relevant cases.
Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Helga Velroyen <helgav@google.com>

src/Ganeti/HTools/Cluster.hs

@@ -1349,14 +1349,20 @@ tieredAlloc nl il limit newinst allocnodes ixes cstats =
                                           . flip (tryAlloc nl' il') allocnodes)
                        newinst
           bigSteps = filter isJust . map suffShrink . reverse $ sortedErrs
+          progress (Ok (_, _, _, newil', _)) (Ok (_, _, _, newil, _)) =
+            length newil' > length newil
+          progress _ _ = False
       in if stop then newsol else
-          case bigSteps of
-            Just newinst':_ -> tieredAlloc nl' il' newlimit
-                               newinst' allocnodes ixes' cstats'
-            _ -> case Instance.shrinkByType newinst . last $ sortedErrs of
-                   Bad _ -> newsol
-                   Ok newinst' -> tieredAlloc nl' il' newlimit
-                                  newinst' allocnodes ixes' cstats'
+           let newsol' = case Instance.shrinkByType newinst . last
+                                $ sortedErrs of
+                 Bad _ -> newsol
+                 Ok newinst' -> tieredAlloc nl' il' newlimit
+                                newinst' allocnodes ixes' cstats'
+           in if progress newsol' newsol then newsol' else
+                case bigSteps of
+                  Just newinst':_ -> tieredAlloc nl' il' newlimit
+                                     newinst' allocnodes ixes' cstats'
+                  _ -> newsol
 
 -- * Formatting functions