Revision 9dcec001 hspace.hs
| b/hspace.hs | ||
|---|---|---|
| 132 | 132 |
"show help" |
| 133 | 133 |
] |
| 134 | 134 |
|
| 135 |
filterFails :: (Monad m) => [(Maybe Node.List, [Node.Node])] |
|
| 136 |
-> m [(Node.List, [Node.Node])] |
|
| 135 |
filterFails :: (Monad m) => [(Maybe Node.List, Instance.Instance, [Node.Node])]
|
|
| 136 |
-> m [(Node.List, Instance.Instance, [Node.Node])]
|
|
| 137 | 137 |
filterFails sols = |
| 138 | 138 |
if null sols then fail "No nodes onto which to allocate at all" |
| 139 |
else let sols' = filter (isJust . fst) sols |
|
| 139 |
else let sols' = filter (isJust . fst3) sols
|
|
| 140 | 140 |
in if null sols' then |
| 141 | 141 |
fail "No valid allocation solutions" |
| 142 | 142 |
else |
| 143 |
return $ map (\(x, y) -> (fromJust x, y)) sols'
|
|
| 143 |
return $ map (\(x, y, z) -> (fromJust x, y, z)) sols'
|
|
| 144 | 144 |
|
| 145 |
processResults :: (Monad m) => [(Node.List, [Node.Node])] |
|
| 146 |
-> m (Node.List, [Node.Node]) |
|
| 145 |
processResults :: (Monad m) => [(Node.List, Instance.Instance, [Node.Node])]
|
|
| 146 |
-> m (Node.List, Instance.Instance, [Node.Node])
|
|
| 147 | 147 |
processResults sols = |
| 148 |
let sols' = map (\(nl', ns) -> (Cluster.compCV nl', (nl', ns))) sols
|
|
| 148 |
let sols' = map (\e@(nl', _, _) -> (Cluster.compCV nl', e)) sols
|
|
| 149 | 149 |
sols'' = sortBy (compare `on` fst) sols' |
| 150 | 150 |
in return $ snd $ head sols'' |
| 151 | 151 |
|
| ... | ... | |
| 153 | 153 |
-> Instance.List |
| 154 | 154 |
-> Instance.Instance |
| 155 | 155 |
-> Int |
| 156 |
-> Int |
|
| 157 |
-> (Node.List, Int) |
|
| 158 |
iterateDepth nl il newinst nreq depth = |
|
| 159 |
let newname = printf "new-%d" depth |
|
| 156 |
-> [Instance.Instance] |
|
| 157 |
-> (Node.List, [Instance.Instance]) |
|
| 158 |
iterateDepth nl il newinst nreq ixes = |
|
| 159 |
let depth = length ixes |
|
| 160 |
newname = printf "new-%d" depth |
|
| 160 | 161 |
newidx = (length $ Container.elems il) + depth |
| 161 | 162 |
newi2 = Instance.setIdx (Instance.setName newinst newname) newidx |
| 162 | 163 |
sols = Cluster.tryAlloc nl il newi2 nreq |
| 163 |
orig = (nl, depth)
|
|
| 164 |
orig = (nl, ixes)
|
|
| 164 | 165 |
in |
| 165 | 166 |
if isNothing sols then orig |
| 166 | 167 |
else let sols' = fromJust sols |
| 167 | 168 |
sols'' = filterFails sols' |
| 168 | 169 |
in if isNothing sols'' then orig |
| 169 |
else let (xnl, _) = fromJust $ processResults $ fromJust sols'' |
|
| 170 |
in iterateDepth xnl il newinst nreq (depth+1) |
|
| 170 |
else let (xnl, xi, _) = fromJust $ processResults $ |
|
| 171 |
fromJust sols'' |
|
| 172 |
in iterateDepth xnl il newinst nreq (xi:ixes) |
|
| 171 | 173 |
|
| 172 | 174 |
|
| 173 | 175 |
-- | Main function. |
| ... | ... | |
| 183 | 185 |
let verbose = optVerbose opts |
| 184 | 186 |
|
| 185 | 187 |
(fixed_nl, il, csf) <- CLI.loadExternalData opts |
| 188 |
let num_instances = length $ Container.elems il |
|
| 186 | 189 |
|
| 187 | 190 |
let offline_names = optOffline opts |
| 188 | 191 |
all_nodes = Container.elems fixed_nl |
| ... | ... | |
| 193 | 196 |
all_nodes |
| 194 | 197 |
|
| 195 | 198 |
when (length offline_wrong > 0) $ do |
| 196 |
printf "Wrong node name(s) set as offline: %s\n" |
|
| 199 |
printf "Error: Wrong node name(s) set as offline: %s\n"
|
|
| 197 | 200 |
(commaJoin offline_wrong) |
| 198 | 201 |
exitWith $ ExitFailure 1 |
| 199 | 202 |
|
| ... | ... | |
| 206 | 209 |
|
| 207 | 210 |
let bad_nodes = fst $ Cluster.computeBadItems nl il |
| 208 | 211 |
when (length bad_nodes > 0) $ do |
| 209 |
putStrLn "Cluster not N+1, no space to allocate." |
|
| 212 |
putStrLn "Error: Cluster not N+1, no space to allocate."
|
|
| 210 | 213 |
exitWith $ ExitFailure 1 |
| 211 | 214 |
|
| 212 | 215 |
when (optShowNodes opts) $ |
| ... | ... | |
| 215 | 218 |
putStrLn $ Cluster.printNodes nl |
| 216 | 219 |
|
| 217 | 220 |
let ini_cv = Cluster.compCV nl |
| 221 |
(orig_mem, orig_disk) = Cluster.totalResources nl |
|
| 218 | 222 |
|
| 219 | 223 |
(if verbose > 2 then |
| 220 | 224 |
printf "Initial coefficients: overall %.8f, %s\n" |
| 221 | 225 |
ini_cv (Cluster.printStats nl) |
| 222 | 226 |
else |
| 223 | 227 |
printf "Initial score: %.8f\n" ini_cv) |
| 228 |
printf "Initial instances: %d\n" num_instances |
|
| 229 |
printf "Initial free RAM: %d\n" orig_mem |
|
| 230 |
printf "Initial free disk: %d\n" orig_disk |
|
| 224 | 231 |
|
| 225 |
let imlen = Container.maxNameLen il |
|
| 226 |
nmlen = Container.maxNameLen nl |
|
| 232 |
let nmlen = Container.maxNameLen nl |
|
| 227 | 233 |
newinst = Instance.create "new" (optIMem opts) (optIDsk opts) |
| 228 | 234 |
"ADMIN_down" (-1) (-1) |
| 229 | 235 |
|
| 230 |
let (fin_nl, fin_depth) = iterateDepth nl il newinst (optINodes opts) 0 |
|
| 231 |
|
|
| 232 |
unless (verbose == 0) $ |
|
| 233 |
printf "Solution length=%d\n" fin_depth |
|
| 236 |
let (fin_nl, ixes) = |
|
| 237 |
iterateDepth nl il newinst (optINodes opts) [] |
|
| 238 |
allocs = length ixes |
|
| 239 |
fin_instances = num_instances + allocs |
|
| 240 |
fin_ixes = reverse ixes |
|
| 241 |
ix_namelen = maximum . map (length . Instance.name) $ fin_ixes |
|
| 242 |
(final_mem, final_disk) = Cluster.totalResources fin_nl |
|
| 243 |
|
|
| 244 |
printf "Final score: %.8f\n" (Cluster.compCV fin_nl) |
|
| 245 |
printf "Final instances: %d\n" (num_instances + allocs) |
|
| 246 |
printf "Final free RAM: %d\n" final_mem |
|
| 247 |
printf "Final free disk: %d\n" final_disk |
|
| 248 |
printf "Usage: %.2f\n" (((fromIntegral num_instances)::Double) / |
|
| 249 |
(fromIntegral fin_instances)) |
|
| 250 |
printf "Allocations: %d\n" allocs |
|
| 251 |
when (verbose > 1) $ do |
|
| 252 |
putStr . unlines . map (\i -> printf "Inst: %*s %-*s %-*s" |
|
| 253 |
ix_namelen (Instance.name i) |
|
| 254 |
nmlen (Container.nameOf fin_nl $ Instance.pnode i) |
|
| 255 |
nmlen (Container.nameOf fin_nl $ Instance.snode i)) |
|
| 256 |
$ fin_ixes |
|
| 234 | 257 |
|
| 235 | 258 |
when (optShowNodes opts) $ |
| 236 | 259 |
do |
Also available in: Unified diff