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