Revision 4a340313
b/Ganeti/HTools/Cluster.hs | ||
---|---|---|
33 | 33 |
, checkMove |
34 | 34 |
, compCV |
35 | 35 |
, printStats |
36 |
-- * IAllocator functions |
|
37 |
, allocateOn |
|
36 | 38 |
) where |
37 | 39 |
|
38 | 40 |
import Data.List |
... | ... | |
407 | 409 |
Container.addTwo old_sdx new_p old_pdx int_p nl |
408 | 410 |
in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx) |
409 | 411 |
|
412 |
allocateOn nl inst new_pdx new_sdx = |
|
413 |
let |
|
414 |
tgt_p = Container.find new_pdx nl |
|
415 |
tgt_s = Container.find new_sdx nl |
|
416 |
new_nl = do -- Maybe monad |
|
417 |
new_p <- Node.addPri tgt_p inst |
|
418 |
new_s <- Node.addSec tgt_s inst new_pdx |
|
419 |
return $ Container.addTwo new_pdx new_p new_sdx new_s nl |
|
420 |
in (new_nl, Instance.setBoth inst new_pdx new_sdx) |
|
421 |
|
|
410 | 422 |
checkSingleStep :: Table -- ^ The original table |
411 | 423 |
-> Instance.Instance -- ^ The instance to move |
412 | 424 |
-> Table -- ^ The current best table |
b/hail.hs | ||
---|---|---|
119 | 119 |
-> Instance.Instance |
120 | 120 |
-> Int |
121 | 121 |
-> Result (String, [Node.Node]) |
122 |
tryAlloc nl il xi _ = Bad "alloc not implemented" |
|
122 |
tryAlloc nl il inst 2 = |
|
123 |
let all_nodes = Container.elems nl |
|
124 |
all_nidx = map Node.idx all_nodes |
|
125 |
all_pairs = liftM2 (,) all_nodes all_nodes |
|
126 |
ok_pairs = filter (\(x, y) -> Node.idx x /= Node.idx y) all_pairs |
|
127 |
sols1 = map (\(p, s) -> let pdx = Node.idx p |
|
128 |
sdx = Node.idx s |
|
129 |
(mnl, _) = Cluster.allocateOn nl |
|
130 |
inst pdx sdx |
|
131 |
in (mnl, (p, s)) |
|
132 |
) ok_pairs |
|
133 |
sols2 = filter (isJust . fst) sols1 |
|
134 |
in if null sols1 then |
|
135 |
Bad "No pairs onto which to allocate at all" |
|
136 |
else if null sols2 then |
|
137 |
Bad "No valid allocation solutions" |
|
138 |
else |
|
139 |
let sols3 = map (\(x, (y, z)) -> |
|
140 |
(Cluster.compCV $ fromJust x, |
|
141 |
(fromJust x, y, z))) |
|
142 |
sols2 |
|
143 |
sols4 = sortBy (compare `on` fst) sols3 |
|
144 |
(best, (final_nl, w1, w2)) = head sols4 |
|
145 |
(worst, (_, l1, l2)) = last sols4 |
|
146 |
info = printf "Valid results: %d, best score: %.8f \ |
|
147 |
\(nodes %s/%s), worst score: %.8f (nodes \ |
|
148 |
\%s/%s)" |
|
149 |
(length sols3) |
|
150 |
best (Node.name w1) (Node.name w2) |
|
151 |
worst (Node.name l1) (Node.name w2) |
|
152 |
in Ok (info, [w1, w2]) |
|
153 |
|
|
154 |
|
|
155 |
tryAlloc _ _ _ reqn = Bad $ "Unsupported number of alllocation \ |
|
156 |
\destinations required (" ++ (show reqn) ++ |
|
157 |
"), only two supported" |
|
123 | 158 |
|
124 | 159 |
-- | Try to allocate an instance on the cluster |
125 | 160 |
tryReloc :: NodeList |
Also available in: Unified diff