Commit 7d3f4253 authored by Iustin Pop's avatar Iustin Pop
Browse files

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: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarBalazs 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!
Please register or to comment