### AllocElement: extend with the cluster score

```

AllocElement, a type used as a result of allocations, holds the status
of the nodes after the allocation. In most cases, we'll compare this
allocation result with others, to see which allocation decision makes
the most sense. This comparison is done via the cluster score.

However, if we later need to redo this computation, as part of other
comparisons, we'd need to evaluate it again, etc. So it's easier to just
compute the score at the place where we compute the node list in the
initial step.
Signed-off-by: Iustin Pop <iustin@google.com>
Reviewed-by: Balazs Lecz <leczb@google.com>```
parent 06fb841e
 ... ... @@ -387,9 +387,10 @@ allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node allocateOnSingle nl inst p = let new_pdx = Node.idx p new_inst = Instance.setBoth inst new_pdx Node.noSecondary new_nl = Node.addPri p inst >>= \new_p -> return (Container.add new_pdx new_p nl, new_inst, [new_p]) in new_nl in Node.addPri p inst >>= \new_p -> do let new_nl = Container.add new_pdx new_p nl new_score = compCV nl return (new_nl, new_inst, [new_p], new_score) -- | Tries to allocate an instance on a given pair of nodes. allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node ... ... @@ -397,13 +398,12 @@ allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node allocateOnPair nl inst tgt_p tgt_s = let new_pdx = Node.idx tgt_p new_sdx = Node.idx tgt_s new_nl = do -- Maybe monad new_p <- Node.addPri tgt_p inst new_s <- Node.addSec tgt_s inst new_pdx let new_inst = Instance.setBoth inst new_pdx new_sdx return (Container.addTwo new_pdx new_p new_sdx new_s nl, new_inst, [new_p, new_s]) in new_nl in do new_p <- Node.addPri tgt_p inst new_s <- Node.addSec tgt_s inst new_pdx let new_inst = Instance.setBoth inst new_pdx new_sdx new_nl = Container.addTwo new_pdx new_p new_sdx new_s nl return (new_nl, new_inst, [new_p, new_s], compCV new_nl) -- | Tries to perform an instance move and returns the best table -- between the original one and the new one. ... ... @@ -535,9 +535,8 @@ collapseFailures flst = concatAllocs :: AllocSolution -> OpResult Node.AllocElement -> AllocSolution concatAllocs (flst, cntok, sols) (OpFail reason) = (reason:flst, cntok, sols) concatAllocs (flst, cntok, osols) (OpGood ns@(nl, _, _)) = let nscore = compCV nl -- Choose the old or new solution, based on the cluster score concatAllocs (flst, cntok, osols) (OpGood ns@(_, _, _, nscore)) = let -- Choose the old or new solution, based on the cluster score nsols = case osols of [] -> [(nscore, ns)] (oscore, _):[] -> ... ... @@ -601,7 +600,8 @@ tryReloc nl il xid 1 ex_idx = let em = do (mnl, i, _, _) <- applyMove nl inst (ReplaceSecondary x) return (mnl, i, [Container.find x mnl]) return (mnl, i, [Container.find x mnl], compCV mnl) in concatAllocs cstate em ) ([], 0, []) valid_idxes in return sols1 ... ... @@ -624,7 +624,7 @@ tryEvac nl il ex_ndx = -- FIXME: hardcoded one node here (fm, cs, aes) <- tryReloc nl' il idx 1 ex_ndx case aes of csol@(_, (nl'', _, _)):_ -> csol@(_, (nl'', _, _, _)):_ -> return (nl'', (fm, cs, csol:rsols)) _ -> fail \$ "Can't evacuate instance " ++ Instance.name (Container.find idx il) ... ... @@ -649,7 +649,7 @@ iterateAlloc nl il newinst nreq ixes = Ok (errs, _, sols3) -> case sols3 of [] -> Ok (collapseFailures errs, nl, il, ixes) (_, (xnl, xi, _)):[] -> (_, (xnl, xi, _, _)):[] -> iterateAlloc xnl (Container.add newidx xi il) newinst nreq \$! (xi:ixes) _ -> Bad "Internal error: multiple solutions for single\ ... ...
 ... ... @@ -4,7 +4,7 @@ {- Copyright (C) 2009 Google Inc. Copyright (C) 2009, 2010 Google Inc. This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by ... ... @@ -147,13 +147,13 @@ formatRVal :: RqType -> [Node.AllocElement] -> JSValue formatRVal _ [] = JSArray [] formatRVal (Evacuate _) elems = let sols = map (\(_, inst, nl) -> Instance.name inst : map Node.name nl) let sols = map (\(_, inst, nl, _) -> Instance.name inst : map Node.name nl) elems jsols = map (JSArray . map (JSString . toJSString)) sols in JSArray jsols formatRVal _ elems = let (_, _, nodes) = head elems let (_, _, nodes, _) = head elems nodes' = map Node.name nodes in JSArray \$ map (JSString . toJSString) nodes' ... ...
 ... ... @@ -139,7 +139,7 @@ type List = Container.Container Node -- | A simple name for an allocation element (here just for logistic -- reasons) type AllocElement = (List, Instance.Instance, [Node]) type AllocElement = (List, Instance.Instance, [Node], T.Score) -- | Constant node index for a non-moveable instance. noSecondary :: T.Ndx ... ...
 ... ... @@ -676,9 +676,8 @@ prop_ClusterAlloc_sane node inst = Types.Ok (_, _, sols3) -> case sols3 of [] -> False (_, (xnl, xi, _)):[] -> let cv = Cluster.compCV xnl il' = Container.add (Instance.idx xi) xi il (_, (xnl, xi, _, cv)):[] -> let il' = Container.add (Instance.idx xi) xi il tbl = Cluster.Table xnl il' cv [] in not (canBalance tbl True False) _ -> False ... ... @@ -717,7 +716,7 @@ prop_ClusterAllocEvac node inst = Types.Ok (_, _, sols3) -> case sols3 of [] -> False (_, (xnl, xi, _)):[] -> (_, (xnl, xi, _, _)):[] -> let sdx = Instance.sNode xi il' = Container.add (Instance.idx xi) xi il in case Cluster.tryEvac xnl il' [sdx] of ... ...
 ... ... @@ -59,7 +59,7 @@ processResults (Evacuate _) as@(fstats, successes, sols) = processResults _ as@(fstats, successes, sols) = case sols of (best, (_, _, w)):[] -> (best, (_, _, w, _)):[] -> let tfails = length fstats info = printf "successes %d, failures %d,\ \ best score: %.8f for node(s) %s" ... ...
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!