Statistics
| Branch: | Tag: | Revision:

root / Ganeti / HTools / Cluster.hs @ 608efcce

History | View | Annotate | Download (25.4 kB)

1 e4f08c46 Iustin Pop
{-| Implementation of cluster-wide logic.
2 e4f08c46 Iustin Pop
3 e4f08c46 Iustin Pop
This module holds all pure cluster-logic; I\/O related functionality
4 7ae514ba Iustin Pop
goes into the "Main" module for the individual binaries.
5 e4f08c46 Iustin Pop
6 e4f08c46 Iustin Pop
-}
7 e4f08c46 Iustin Pop
8 669d7e3d Iustin Pop
module Ganeti.HTools.Cluster
9 e4f08c46 Iustin Pop
    (
10 e4f08c46 Iustin Pop
     -- * Types
11 262a08a2 Iustin Pop
     NameList
12 e4f08c46 Iustin Pop
    , Placement
13 e4f08c46 Iustin Pop
    , Solution(..)
14 e4f08c46 Iustin Pop
    , Table(..)
15 e4f08c46 Iustin Pop
    , Removal
16 b0517d61 Iustin Pop
    , Score
17 58709f92 Iustin Pop
    , IMove(..)
18 e4f08c46 Iustin Pop
    -- * Generic functions
19 e4f08c46 Iustin Pop
    , totalResources
20 e4f08c46 Iustin Pop
    -- * First phase functions
21 e4f08c46 Iustin Pop
    , computeBadItems
22 e4f08c46 Iustin Pop
    -- * Second phase functions
23 e4f08c46 Iustin Pop
    , computeSolution
24 e4f08c46 Iustin Pop
    , applySolution
25 e4f08c46 Iustin Pop
    , printSolution
26 7dfaafb1 Iustin Pop
    , printSolutionLine
27 142538ff Iustin Pop
    , formatCmds
28 e4f08c46 Iustin Pop
    , printNodes
29 e4f08c46 Iustin Pop
    -- * Balacing functions
30 58709f92 Iustin Pop
    , applyMove
31 e4f08c46 Iustin Pop
    , checkMove
32 e4f08c46 Iustin Pop
    , compCV
33 e4f08c46 Iustin Pop
    , printStats
34 4a340313 Iustin Pop
    -- * IAllocator functions
35 5e15f460 Iustin Pop
    , allocateOnSingle
36 5e15f460 Iustin Pop
    , allocateOnPair
37 e4f08c46 Iustin Pop
    ) where
38 e4f08c46 Iustin Pop
39 e4f08c46 Iustin Pop
import Data.List
40 e4f08c46 Iustin Pop
import Data.Maybe (isNothing, fromJust)
41 e4f08c46 Iustin Pop
import Text.Printf (printf)
42 e4f08c46 Iustin Pop
import Data.Function
43 9d3fada5 Iustin Pop
import Control.Monad
44 e4f08c46 Iustin Pop
45 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Container as Container
46 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Instance as Instance
47 669d7e3d Iustin Pop
import qualified Ganeti.HTools.Node as Node
48 e4c5beaf Iustin Pop
import Ganeti.HTools.Types
49 669d7e3d Iustin Pop
import Ganeti.HTools.Utils
50 e4f08c46 Iustin Pop
51 7ae514ba Iustin Pop
-- | A separate name for the cluster score type
52 e4f08c46 Iustin Pop
type Score = Double
53 e4f08c46 Iustin Pop
54 e4f08c46 Iustin Pop
-- | The description of an instance placement.
55 608efcce Iustin Pop
type Placement = (Idx, Ndx, Ndx, Score)
56 e4f08c46 Iustin Pop
57 e4f08c46 Iustin Pop
{- | A cluster solution described as the solution delta and the list
58 e4f08c46 Iustin Pop
of placements.
59 e4f08c46 Iustin Pop
60 e4f08c46 Iustin Pop
-}
61 e4f08c46 Iustin Pop
data Solution = Solution Int [Placement]
62 e4f08c46 Iustin Pop
                deriving (Eq, Ord, Show)
63 e4f08c46 Iustin Pop
64 e4f08c46 Iustin Pop
-- | Returns the delta of a solution or -1 for Nothing
65 e4f08c46 Iustin Pop
solutionDelta :: Maybe Solution -> Int
66 e4f08c46 Iustin Pop
solutionDelta sol = case sol of
67 e4f08c46 Iustin Pop
                      Just (Solution d _) -> d
68 e4f08c46 Iustin Pop
                      _ -> -1
69 e4f08c46 Iustin Pop
70 e4f08c46 Iustin Pop
-- | A removal set.
71 262a08a2 Iustin Pop
data Removal = Removal Node.List [Instance.Instance]
72 e4f08c46 Iustin Pop
73 e4f08c46 Iustin Pop
-- | An instance move definition
74 00b51a14 Iustin Pop
data IMove = Failover                -- ^ Failover the instance (f)
75 608efcce Iustin Pop
           | ReplacePrimary Ndx      -- ^ Replace primary (f, r:np, f)
76 608efcce Iustin Pop
           | ReplaceSecondary Ndx    -- ^ Replace secondary (r:ns)
77 608efcce Iustin Pop
           | ReplaceAndFailover Ndx  -- ^ Replace secondary, failover (r:np, f)
78 608efcce Iustin Pop
           | FailoverAndReplace Ndx  -- ^ Failover, replace secondary (f, r:ns)
79 e4f08c46 Iustin Pop
             deriving (Show)
80 e4f08c46 Iustin Pop
81 e4f08c46 Iustin Pop
-- | The complete state for the balancing solution
82 262a08a2 Iustin Pop
data Table = Table Node.List Instance.List Score [Placement]
83 e4f08c46 Iustin Pop
             deriving (Show)
84 e4f08c46 Iustin Pop
85 e4f08c46 Iustin Pop
-- General functions
86 e4f08c46 Iustin Pop
87 e4f08c46 Iustin Pop
-- | Cap the removal list if needed.
88 e4f08c46 Iustin Pop
capRemovals :: [a] -> Int -> [a]
89 e4f08c46 Iustin Pop
capRemovals removals max_removals =
90 e4f08c46 Iustin Pop
    if max_removals > 0 then
91 e4f08c46 Iustin Pop
        take max_removals removals
92 e4f08c46 Iustin Pop
    else
93 e4f08c46 Iustin Pop
        removals
94 e4f08c46 Iustin Pop
95 e4f08c46 Iustin Pop
-- | Check if the given node list fails the N+1 check.
96 e4f08c46 Iustin Pop
verifyN1Check :: [Node.Node] -> Bool
97 e4f08c46 Iustin Pop
verifyN1Check nl = any Node.failN1 nl
98 e4f08c46 Iustin Pop
99 e4f08c46 Iustin Pop
-- | Verifies the N+1 status and return the affected nodes.
100 e4f08c46 Iustin Pop
verifyN1 :: [Node.Node] -> [Node.Node]
101 e4f08c46 Iustin Pop
verifyN1 nl = filter Node.failN1 nl
102 e4f08c46 Iustin Pop
103 e4f08c46 Iustin Pop
{-| Add an instance and return the new node and instance maps. -}
104 262a08a2 Iustin Pop
addInstance :: Node.List -> Instance.Instance ->
105 262a08a2 Iustin Pop
               Node.Node -> Node.Node -> Maybe Node.List
106 e4f08c46 Iustin Pop
addInstance nl idata pri sec =
107 e4f08c46 Iustin Pop
  let pdx = Node.idx pri
108 e4f08c46 Iustin Pop
      sdx = Node.idx sec
109 e4f08c46 Iustin Pop
  in do
110 e4f08c46 Iustin Pop
      pnode <- Node.addPri pri idata
111 e4f08c46 Iustin Pop
      snode <- Node.addSec sec idata pdx
112 e4f08c46 Iustin Pop
      new_nl <- return $ Container.addTwo sdx snode
113 e4f08c46 Iustin Pop
                         pdx pnode nl
114 e4f08c46 Iustin Pop
      return new_nl
115 e4f08c46 Iustin Pop
116 e4f08c46 Iustin Pop
-- | Remove an instance and return the new node and instance maps.
117 262a08a2 Iustin Pop
removeInstance :: Node.List -> Instance.Instance -> Node.List
118 e4f08c46 Iustin Pop
removeInstance nl idata =
119 e4f08c46 Iustin Pop
  let pnode = Instance.pnode idata
120 e4f08c46 Iustin Pop
      snode = Instance.snode idata
121 e4f08c46 Iustin Pop
      pn = Container.find pnode nl
122 e4f08c46 Iustin Pop
      sn = Container.find snode nl
123 e4f08c46 Iustin Pop
      new_nl = Container.addTwo
124 e4f08c46 Iustin Pop
               pnode (Node.removePri pn idata)
125 e4f08c46 Iustin Pop
               snode (Node.removeSec sn idata) nl in
126 e4f08c46 Iustin Pop
  new_nl
127 e4f08c46 Iustin Pop
128 e4f08c46 Iustin Pop
-- | Remove an instance and return the new node map.
129 262a08a2 Iustin Pop
removeInstances :: Node.List -> [Instance.Instance] -> Node.List
130 e4f08c46 Iustin Pop
removeInstances = foldl' removeInstance
131 e4f08c46 Iustin Pop
132 e4f08c46 Iustin Pop
-- | Compute the total free disk and memory in the cluster.
133 e4f08c46 Iustin Pop
totalResources :: Container.Container Node.Node -> (Int, Int)
134 e4f08c46 Iustin Pop
totalResources nl =
135 e4f08c46 Iustin Pop
    foldl'
136 962367fe Iustin Pop
    (\ (mem, dsk) node -> (mem + (Node.f_mem node),
137 962367fe Iustin Pop
                           dsk + (Node.f_dsk node)))
138 e4f08c46 Iustin Pop
    (0, 0) (Container.elems nl)
139 e4f08c46 Iustin Pop
140 e4f08c46 Iustin Pop
{- | Compute a new version of a cluster given a solution.
141 e4f08c46 Iustin Pop
142 e4f08c46 Iustin Pop
This is not used for computing the solutions, but for applying a
143 e4f08c46 Iustin Pop
(known-good) solution to the original cluster for final display.
144 e4f08c46 Iustin Pop
145 e4f08c46 Iustin Pop
It first removes the relocated instances after which it places them on
146 e4f08c46 Iustin Pop
their new nodes.
147 e4f08c46 Iustin Pop
148 e4f08c46 Iustin Pop
 -}
149 262a08a2 Iustin Pop
applySolution :: Node.List -> Instance.List -> [Placement] -> Node.List
150 e4f08c46 Iustin Pop
applySolution nl il sol =
151 c5c295bc Iustin Pop
    let odxes = map (\ (a, b, c, _) -> (Container.find a il,
152 c5c295bc Iustin Pop
                                        Node.idx (Container.find b nl),
153 c5c295bc Iustin Pop
                                        Node.idx (Container.find c nl))
154 e4f08c46 Iustin Pop
                    ) sol
155 e4f08c46 Iustin Pop
        idxes = (\ (x, _, _) -> x) (unzip3 odxes)
156 e4f08c46 Iustin Pop
        nc = removeInstances nl idxes
157 e4f08c46 Iustin Pop
    in
158 e4f08c46 Iustin Pop
      foldl' (\ nz (a, b, c) ->
159 e4f08c46 Iustin Pop
                 let new_p = Container.find b nz
160 e4f08c46 Iustin Pop
                     new_s = Container.find c nz in
161 e4f08c46 Iustin Pop
                 fromJust (addInstance nz a new_p new_s)
162 e4f08c46 Iustin Pop
           ) nc odxes
163 e4f08c46 Iustin Pop
164 e4f08c46 Iustin Pop
165 e4f08c46 Iustin Pop
-- First phase functions
166 e4f08c46 Iustin Pop
167 e4f08c46 Iustin Pop
{- | Given a list 1,2,3..n build a list of pairs [(1, [2..n]), (2,
168 e4f08c46 Iustin Pop
    [3..n]), ...]
169 e4f08c46 Iustin Pop
170 e4f08c46 Iustin Pop
-}
171 e4f08c46 Iustin Pop
genParts :: [a] -> Int -> [(a, [a])]
172 e4f08c46 Iustin Pop
genParts l count =
173 e4f08c46 Iustin Pop
    case l of
174 e4f08c46 Iustin Pop
      [] -> []
175 e4f08c46 Iustin Pop
      x:xs ->
176 e4f08c46 Iustin Pop
          if length l < count then
177 e4f08c46 Iustin Pop
              []
178 e4f08c46 Iustin Pop
          else
179 e4f08c46 Iustin Pop
              (x, xs) : (genParts xs count)
180 e4f08c46 Iustin Pop
181 e4f08c46 Iustin Pop
-- | Generates combinations of count items from the names list.
182 e4f08c46 Iustin Pop
genNames :: Int -> [b] -> [[b]]
183 e4f08c46 Iustin Pop
genNames count1 names1 =
184 e4f08c46 Iustin Pop
  let aux_fn count names current =
185 e4f08c46 Iustin Pop
          case count of
186 e4f08c46 Iustin Pop
            0 -> [current]
187 e4f08c46 Iustin Pop
            _ ->
188 e4f08c46 Iustin Pop
                concatMap
189 e4f08c46 Iustin Pop
                (\ (x, xs) -> aux_fn (count - 1) xs (x:current))
190 e4f08c46 Iustin Pop
                (genParts names count)
191 e4f08c46 Iustin Pop
  in
192 e4f08c46 Iustin Pop
    aux_fn count1 names1 []
193 e4f08c46 Iustin Pop
194 e4f08c46 Iustin Pop
{- | Computes the pair of bad nodes and instances.
195 e4f08c46 Iustin Pop
196 e4f08c46 Iustin Pop
The bad node list is computed via a simple 'verifyN1' check, and the
197 e4f08c46 Iustin Pop
bad instance list is the list of primary and secondary instances of
198 e4f08c46 Iustin Pop
those nodes.
199 e4f08c46 Iustin Pop
200 e4f08c46 Iustin Pop
-}
201 262a08a2 Iustin Pop
computeBadItems :: Node.List -> Instance.List ->
202 e4f08c46 Iustin Pop
                   ([Node.Node], [Instance.Instance])
203 e4f08c46 Iustin Pop
computeBadItems nl il =
204 234d8af0 Iustin Pop
  let bad_nodes = verifyN1 $ filter (not . Node.offline) $ Container.elems nl
205 e4f08c46 Iustin Pop
      bad_instances = map (\idx -> Container.find idx il) $
206 e4f08c46 Iustin Pop
                      sort $ nub $ concat $
207 e4f08c46 Iustin Pop
                      map (\ n -> (Node.slist n) ++ (Node.plist n)) bad_nodes
208 e4f08c46 Iustin Pop
  in
209 e4f08c46 Iustin Pop
    (bad_nodes, bad_instances)
210 e4f08c46 Iustin Pop
211 e4f08c46 Iustin Pop
212 e4f08c46 Iustin Pop
{- | Checks if removal of instances results in N+1 pass.
213 e4f08c46 Iustin Pop
214 e4f08c46 Iustin Pop
Note: the check removal cannot optimize by scanning only the affected
215 e4f08c46 Iustin Pop
nodes, since the cluster is known to be not healthy; only the check
216 e4f08c46 Iustin Pop
placement can make this shortcut.
217 e4f08c46 Iustin Pop
218 e4f08c46 Iustin Pop
-}
219 262a08a2 Iustin Pop
checkRemoval :: Node.List -> [Instance.Instance] -> Maybe Removal
220 e4f08c46 Iustin Pop
checkRemoval nl victims =
221 e4f08c46 Iustin Pop
  let nx = removeInstances nl victims
222 e4f08c46 Iustin Pop
      failN1 = verifyN1Check (Container.elems nx)
223 e4f08c46 Iustin Pop
  in
224 e4f08c46 Iustin Pop
    if failN1 then
225 e4f08c46 Iustin Pop
      Nothing
226 e4f08c46 Iustin Pop
    else
227 e4f08c46 Iustin Pop
      Just $ Removal nx victims
228 e4f08c46 Iustin Pop
229 e4f08c46 Iustin Pop
230 e4f08c46 Iustin Pop
-- | Computes the removals list for a given depth
231 262a08a2 Iustin Pop
computeRemovals :: Node.List
232 e4f08c46 Iustin Pop
                 -> [Instance.Instance]
233 e4f08c46 Iustin Pop
                 -> Int
234 669d7e3d Iustin Pop
                 -> [Maybe Removal]
235 e4f08c46 Iustin Pop
computeRemovals nl bad_instances depth =
236 e4f08c46 Iustin Pop
    map (checkRemoval nl) $ genNames depth bad_instances
237 e4f08c46 Iustin Pop
238 e4f08c46 Iustin Pop
-- Second phase functions
239 e4f08c46 Iustin Pop
240 e4f08c46 Iustin Pop
-- | Single-node relocation cost
241 608efcce Iustin Pop
nodeDelta :: Ndx -> Ndx -> Ndx -> Int
242 e4f08c46 Iustin Pop
nodeDelta i p s =
243 e4f08c46 Iustin Pop
    if i == p || i == s then
244 e4f08c46 Iustin Pop
        0
245 e4f08c46 Iustin Pop
    else
246 e4f08c46 Iustin Pop
        1
247 e4f08c46 Iustin Pop
248 e4f08c46 Iustin Pop
{-| Compute best solution.
249 e4f08c46 Iustin Pop
250 e4f08c46 Iustin Pop
    This function compares two solutions, choosing the minimum valid
251 e4f08c46 Iustin Pop
    solution.
252 e4f08c46 Iustin Pop
-}
253 e4f08c46 Iustin Pop
compareSolutions :: Maybe Solution -> Maybe Solution -> Maybe Solution
254 e4f08c46 Iustin Pop
compareSolutions a b = case (a, b) of
255 e4f08c46 Iustin Pop
  (Nothing, x) -> x
256 e4f08c46 Iustin Pop
  (x, Nothing) -> x
257 e4f08c46 Iustin Pop
  (x, y) -> min x y
258 e4f08c46 Iustin Pop
259 e4f08c46 Iustin Pop
-- | Compute best table. Note that the ordering of the arguments is important.
260 e4f08c46 Iustin Pop
compareTables :: Table -> Table -> Table
261 e4f08c46 Iustin Pop
compareTables a@(Table _ _ a_cv _) b@(Table _ _ b_cv _ ) =
262 e4f08c46 Iustin Pop
    if a_cv > b_cv then b else a
263 e4f08c46 Iustin Pop
264 e4f08c46 Iustin Pop
-- | Check if a given delta is worse then an existing solution.
265 e4f08c46 Iustin Pop
tooHighDelta :: Maybe Solution -> Int -> Int -> Bool
266 e4f08c46 Iustin Pop
tooHighDelta sol new_delta max_delta =
267 e4f08c46 Iustin Pop
    if new_delta > max_delta && max_delta >=0 then
268 e4f08c46 Iustin Pop
        True
269 e4f08c46 Iustin Pop
    else
270 e4f08c46 Iustin Pop
        case sol of
271 e4f08c46 Iustin Pop
          Nothing -> False
272 e4f08c46 Iustin Pop
          Just (Solution old_delta _) -> old_delta <= new_delta
273 e4f08c46 Iustin Pop
274 e4f08c46 Iustin Pop
{-| Check if placement of instances still keeps the cluster N+1 compliant.
275 e4f08c46 Iustin Pop
276 e4f08c46 Iustin Pop
    This is the workhorse of the allocation algorithm: given the
277 e4f08c46 Iustin Pop
    current node and instance maps, the list of instances to be
278 e4f08c46 Iustin Pop
    placed, and the current solution, this will return all possible
279 e4f08c46 Iustin Pop
    solution by recursing until all target instances are placed.
280 e4f08c46 Iustin Pop
281 e4f08c46 Iustin Pop
-}
282 262a08a2 Iustin Pop
checkPlacement :: Node.List            -- ^ The current node list
283 e4f08c46 Iustin Pop
               -> [Instance.Instance] -- ^ List of instances still to place
284 e4f08c46 Iustin Pop
               -> [Placement]         -- ^ Partial solution until now
285 e4f08c46 Iustin Pop
               -> Int                 -- ^ The delta of the partial solution
286 e4f08c46 Iustin Pop
               -> Maybe Solution      -- ^ The previous solution
287 e4f08c46 Iustin Pop
               -> Int                 -- ^ Abort if the we go above this delta
288 e4f08c46 Iustin Pop
               -> Maybe Solution      -- ^ The new solution
289 e4f08c46 Iustin Pop
checkPlacement nl victims current current_delta prev_sol max_delta =
290 e4f08c46 Iustin Pop
  let target = head victims
291 e4f08c46 Iustin Pop
      opdx = Instance.pnode target
292 e4f08c46 Iustin Pop
      osdx = Instance.snode target
293 e4f08c46 Iustin Pop
      vtail = tail victims
294 e4f08c46 Iustin Pop
      have_tail = (length vtail) > 0
295 e4f08c46 Iustin Pop
      nodes = Container.elems nl
296 c5c295bc Iustin Pop
      iidx = Instance.idx target
297 e4f08c46 Iustin Pop
  in
298 e4f08c46 Iustin Pop
    foldl'
299 e4f08c46 Iustin Pop
    (\ accu_p pri ->
300 e4f08c46 Iustin Pop
         let
301 e4f08c46 Iustin Pop
             pri_idx = Node.idx pri
302 e4f08c46 Iustin Pop
             upri_delta = current_delta + nodeDelta pri_idx opdx osdx
303 e4f08c46 Iustin Pop
             new_pri = Node.addPri pri target
304 e4f08c46 Iustin Pop
             fail_delta1 = tooHighDelta accu_p upri_delta max_delta
305 e4f08c46 Iustin Pop
         in
306 e4f08c46 Iustin Pop
           if fail_delta1 || isNothing(new_pri) then accu_p
307 e4f08c46 Iustin Pop
           else let pri_nl = Container.add pri_idx (fromJust new_pri) nl in
308 e4f08c46 Iustin Pop
                foldl'
309 e4f08c46 Iustin Pop
                (\ accu sec ->
310 e4f08c46 Iustin Pop
                     let
311 e4f08c46 Iustin Pop
                         sec_idx = Node.idx sec
312 e4f08c46 Iustin Pop
                         upd_delta = upri_delta +
313 e4f08c46 Iustin Pop
                                     nodeDelta sec_idx opdx osdx
314 e4f08c46 Iustin Pop
                         fail_delta2 = tooHighDelta accu upd_delta max_delta
315 e4f08c46 Iustin Pop
                         new_sec = Node.addSec sec target pri_idx
316 e4f08c46 Iustin Pop
                     in
317 e4f08c46 Iustin Pop
                       if sec_idx == pri_idx || fail_delta2 ||
318 e4f08c46 Iustin Pop
                          isNothing new_sec then accu
319 e4f08c46 Iustin Pop
                       else let
320 e4f08c46 Iustin Pop
                           nx = Container.add sec_idx (fromJust new_sec) pri_nl
321 c5c295bc Iustin Pop
                           upd_cv = compCV nx
322 c5c295bc Iustin Pop
                           plc = (iidx, pri_idx, sec_idx, upd_cv)
323 e4f08c46 Iustin Pop
                           c2 = plc:current
324 e4f08c46 Iustin Pop
                           result =
325 e4f08c46 Iustin Pop
                               if have_tail then
326 e4f08c46 Iustin Pop
                                   checkPlacement nx vtail c2 upd_delta
327 e4f08c46 Iustin Pop
                                                  accu max_delta
328 e4f08c46 Iustin Pop
                               else
329 e4f08c46 Iustin Pop
                                   Just (Solution upd_delta c2)
330 e4f08c46 Iustin Pop
                      in compareSolutions accu result
331 e4f08c46 Iustin Pop
                ) accu_p nodes
332 e4f08c46 Iustin Pop
    ) prev_sol nodes
333 e4f08c46 Iustin Pop
334 e4f08c46 Iustin Pop
-- | Apply a move
335 262a08a2 Iustin Pop
applyMove :: Node.List -> Instance.Instance
336 608efcce Iustin Pop
          -> IMove -> (Maybe Node.List, Instance.Instance, Ndx, Ndx)
337 00b51a14 Iustin Pop
-- Failover (f)
338 e4f08c46 Iustin Pop
applyMove nl inst Failover =
339 e4f08c46 Iustin Pop
    let old_pdx = Instance.pnode inst
340 e4f08c46 Iustin Pop
        old_sdx = Instance.snode inst
341 e4f08c46 Iustin Pop
        old_p = Container.find old_pdx nl
342 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
343 e4f08c46 Iustin Pop
        int_p = Node.removePri old_p inst
344 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
345 b161386d Iustin Pop
        new_nl = do -- Maybe monad
346 b161386d Iustin Pop
          new_p <- Node.addPri int_s inst
347 b161386d Iustin Pop
          new_s <- Node.addSec int_p inst old_sdx
348 b161386d Iustin Pop
          return $ Container.addTwo old_pdx new_s old_sdx new_p nl
349 e4f08c46 Iustin Pop
    in (new_nl, Instance.setBoth inst old_sdx old_pdx, old_sdx, old_pdx)
350 e4f08c46 Iustin Pop
351 00b51a14 Iustin Pop
-- Replace the primary (f:, r:np, f)
352 e4f08c46 Iustin Pop
applyMove nl inst (ReplacePrimary new_pdx) =
353 e4f08c46 Iustin Pop
    let old_pdx = Instance.pnode inst
354 e4f08c46 Iustin Pop
        old_sdx = Instance.snode inst
355 e4f08c46 Iustin Pop
        old_p = Container.find old_pdx nl
356 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
357 e4f08c46 Iustin Pop
        tgt_n = Container.find new_pdx nl
358 e4f08c46 Iustin Pop
        int_p = Node.removePri old_p inst
359 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
360 b161386d Iustin Pop
        new_nl = do -- Maybe monad
361 b161386d Iustin Pop
          new_p <- Node.addPri tgt_n inst
362 b161386d Iustin Pop
          new_s <- Node.addSec int_s inst new_pdx
363 b161386d Iustin Pop
          return $ Container.add new_pdx new_p $
364 b161386d Iustin Pop
                 Container.addTwo old_pdx int_p old_sdx new_s nl
365 e4f08c46 Iustin Pop
    in (new_nl, Instance.setPri inst new_pdx, new_pdx, old_sdx)
366 e4f08c46 Iustin Pop
367 00b51a14 Iustin Pop
-- Replace the secondary (r:ns)
368 e4f08c46 Iustin Pop
applyMove nl inst (ReplaceSecondary new_sdx) =
369 e4f08c46 Iustin Pop
    let old_pdx = Instance.pnode inst
370 e4f08c46 Iustin Pop
        old_sdx = Instance.snode inst
371 e4f08c46 Iustin Pop
        old_s = Container.find old_sdx nl
372 e4f08c46 Iustin Pop
        tgt_n = Container.find new_sdx nl
373 e4f08c46 Iustin Pop
        int_s = Node.removeSec old_s inst
374 b161386d Iustin Pop
        new_nl = Node.addSec tgt_n inst old_pdx >>=
375 b161386d Iustin Pop
                 \new_s -> return $ Container.addTwo new_sdx
376 b161386d Iustin Pop
                           new_s old_sdx int_s nl
377 e4f08c46 Iustin Pop
    in (new_nl, Instance.setSec inst new_sdx, old_pdx, new_sdx)
378 e4f08c46 Iustin Pop
379 00b51a14 Iustin Pop
-- Replace the secondary and failover (r:np, f)
380 79ac6b6f Iustin Pop
applyMove nl inst (ReplaceAndFailover new_pdx) =
381 79ac6b6f Iustin Pop
    let old_pdx = Instance.pnode inst
382 79ac6b6f Iustin Pop
        old_sdx = Instance.snode inst
383 79ac6b6f Iustin Pop
        old_p = Container.find old_pdx nl
384 79ac6b6f Iustin Pop
        old_s = Container.find old_sdx nl
385 79ac6b6f Iustin Pop
        tgt_n = Container.find new_pdx nl
386 79ac6b6f Iustin Pop
        int_p = Node.removePri old_p inst
387 79ac6b6f Iustin Pop
        int_s = Node.removeSec old_s inst
388 b161386d Iustin Pop
        new_nl = do -- Maybe monad
389 b161386d Iustin Pop
          new_p <- Node.addPri tgt_n inst
390 b161386d Iustin Pop
          new_s <- Node.addSec int_p inst new_pdx
391 b161386d Iustin Pop
          return $ Container.add new_pdx new_p $
392 b161386d Iustin Pop
                 Container.addTwo old_pdx new_s old_sdx int_s nl
393 79ac6b6f Iustin Pop
    in (new_nl, Instance.setBoth inst new_pdx old_pdx, new_pdx, old_pdx)
394 79ac6b6f Iustin Pop
395 19493d33 Iustin Pop
-- Failver and replace the secondary (f, r:ns)
396 19493d33 Iustin Pop
applyMove nl inst (FailoverAndReplace new_sdx) =
397 19493d33 Iustin Pop
    let old_pdx = Instance.pnode inst
398 19493d33 Iustin Pop
        old_sdx = Instance.snode inst
399 19493d33 Iustin Pop
        old_p = Container.find old_pdx nl
400 19493d33 Iustin Pop
        old_s = Container.find old_sdx nl
401 19493d33 Iustin Pop
        tgt_n = Container.find new_sdx nl
402 19493d33 Iustin Pop
        int_p = Node.removePri old_p inst
403 19493d33 Iustin Pop
        int_s = Node.removeSec old_s inst
404 b161386d Iustin Pop
        new_nl = do -- Maybe monad
405 b161386d Iustin Pop
          new_p <- Node.addPri int_s inst
406 b161386d Iustin Pop
          new_s <- Node.addSec tgt_n inst old_sdx
407 b161386d Iustin Pop
          return $ Container.add new_sdx new_s $
408 b161386d Iustin Pop
                 Container.addTwo old_sdx new_p old_pdx int_p nl
409 19493d33 Iustin Pop
    in (new_nl, Instance.setBoth inst old_sdx new_sdx, old_sdx, new_sdx)
410 19493d33 Iustin Pop
411 262a08a2 Iustin Pop
allocateOnSingle :: Node.List -> Instance.Instance -> Node.Node
412 262a08a2 Iustin Pop
                 -> (Maybe Node.List, Instance.Instance)
413 5e15f460 Iustin Pop
allocateOnSingle nl inst p =
414 5e15f460 Iustin Pop
    let new_pdx = Node.idx p
415 5e15f460 Iustin Pop
        new_nl = Node.addPri p inst >>= \new_p ->
416 5e15f460 Iustin Pop
                 return $ Container.add new_pdx new_p nl
417 5e15f460 Iustin Pop
    in (new_nl, Instance.setBoth inst new_pdx Node.noSecondary)
418 5e15f460 Iustin Pop
419 262a08a2 Iustin Pop
allocateOnPair :: Node.List -> Instance.Instance -> Node.Node -> Node.Node
420 262a08a2 Iustin Pop
               -> (Maybe Node.List, Instance.Instance)
421 5e15f460 Iustin Pop
allocateOnPair nl inst tgt_p tgt_s =
422 5e15f460 Iustin Pop
    let new_pdx = Node.idx tgt_p
423 5e15f460 Iustin Pop
        new_sdx = Node.idx tgt_s
424 4a340313 Iustin Pop
        new_nl = do -- Maybe monad
425 4a340313 Iustin Pop
          new_p <- Node.addPri tgt_p inst
426 4a340313 Iustin Pop
          new_s <- Node.addSec tgt_s inst new_pdx
427 4a340313 Iustin Pop
          return $ Container.addTwo new_pdx new_p new_sdx new_s nl
428 4a340313 Iustin Pop
    in (new_nl, Instance.setBoth inst new_pdx new_sdx)
429 4a340313 Iustin Pop
430 e4f08c46 Iustin Pop
checkSingleStep :: Table -- ^ The original table
431 e4f08c46 Iustin Pop
                -> Instance.Instance -- ^ The instance to move
432 e4f08c46 Iustin Pop
                -> Table -- ^ The current best table
433 e4f08c46 Iustin Pop
                -> IMove -- ^ The move to apply
434 e4f08c46 Iustin Pop
                -> Table -- ^ The final best table
435 e4f08c46 Iustin Pop
checkSingleStep ini_tbl target cur_tbl move =
436 e4f08c46 Iustin Pop
    let
437 e4f08c46 Iustin Pop
        Table ini_nl ini_il _ ini_plc = ini_tbl
438 0a0f2533 Iustin Pop
        (tmp_nl, new_inst, pri_idx, sec_idx) = applyMove ini_nl target move
439 e4f08c46 Iustin Pop
    in
440 e4f08c46 Iustin Pop
      if isNothing tmp_nl then cur_tbl
441 e4f08c46 Iustin Pop
      else
442 e4f08c46 Iustin Pop
          let tgt_idx = Instance.idx target
443 e4f08c46 Iustin Pop
              upd_nl = fromJust tmp_nl
444 e4f08c46 Iustin Pop
              upd_cvar = compCV upd_nl
445 e4f08c46 Iustin Pop
              upd_il = Container.add tgt_idx new_inst ini_il
446 0a0f2533 Iustin Pop
              upd_plc = (tgt_idx, pri_idx, sec_idx, upd_cvar):ini_plc
447 e4f08c46 Iustin Pop
              upd_tbl = Table upd_nl upd_il upd_cvar upd_plc
448 e4f08c46 Iustin Pop
          in
449 e4f08c46 Iustin Pop
            compareTables cur_tbl upd_tbl
450 e4f08c46 Iustin Pop
451 40d4eba0 Iustin Pop
-- | Given the status of the current secondary as a valid new node
452 40d4eba0 Iustin Pop
-- and the current candidate target node,
453 40d4eba0 Iustin Pop
-- generate the possible moves for a instance.
454 608efcce Iustin Pop
possibleMoves :: Bool -> Ndx -> [IMove]
455 40d4eba0 Iustin Pop
possibleMoves True tdx =
456 40d4eba0 Iustin Pop
    [ReplaceSecondary tdx,
457 40d4eba0 Iustin Pop
     ReplaceAndFailover tdx,
458 40d4eba0 Iustin Pop
     ReplacePrimary tdx,
459 40d4eba0 Iustin Pop
     FailoverAndReplace tdx]
460 40d4eba0 Iustin Pop
461 40d4eba0 Iustin Pop
possibleMoves False tdx =
462 40d4eba0 Iustin Pop
    [ReplaceSecondary tdx,
463 40d4eba0 Iustin Pop
     ReplaceAndFailover tdx]
464 40d4eba0 Iustin Pop
465 40d4eba0 Iustin Pop
-- | Compute the best move for a given instance.
466 608efcce Iustin Pop
checkInstanceMove :: [Ndx]             -- Allowed target node indices
467 256810de Iustin Pop
                  -> Table             -- Original table
468 256810de Iustin Pop
                  -> Instance.Instance -- Instance to move
469 256810de Iustin Pop
                  -> Table             -- Best new table for this instance
470 256810de Iustin Pop
checkInstanceMove nodes_idx ini_tbl target =
471 4e25d1c2 Iustin Pop
    let
472 4e25d1c2 Iustin Pop
        opdx = Instance.pnode target
473 4e25d1c2 Iustin Pop
        osdx = Instance.snode target
474 9dc6023f Iustin Pop
        nodes = filter (\idx -> idx /= opdx && idx /= osdx) nodes_idx
475 40d4eba0 Iustin Pop
        use_secondary = elem osdx nodes_idx
476 40d4eba0 Iustin Pop
        aft_failover = if use_secondary -- if allowed to failover
477 40d4eba0 Iustin Pop
                       then checkSingleStep ini_tbl target ini_tbl Failover
478 40d4eba0 Iustin Pop
                       else ini_tbl
479 40d4eba0 Iustin Pop
        all_moves = concatMap (possibleMoves use_secondary) nodes
480 4e25d1c2 Iustin Pop
    in
481 4e25d1c2 Iustin Pop
      -- iterate over the possible nodes for this instance
482 9dc6023f Iustin Pop
      foldl' (checkSingleStep ini_tbl target) aft_failover all_moves
483 4e25d1c2 Iustin Pop
484 e4f08c46 Iustin Pop
-- | Compute the best next move.
485 608efcce Iustin Pop
checkMove :: [Ndx]               -- ^ Allowed target node indices
486 256810de Iustin Pop
          -> Table               -- ^ The current solution
487 e4f08c46 Iustin Pop
          -> [Instance.Instance] -- ^ List of instances still to move
488 256810de Iustin Pop
          -> Table               -- ^ The new solution
489 256810de Iustin Pop
checkMove nodes_idx ini_tbl victims =
490 4e25d1c2 Iustin Pop
    let Table _ _ _ ini_plc = ini_tbl
491 4e25d1c2 Iustin Pop
        -- iterate over all instances, computing the best move
492 256810de Iustin Pop
        best_tbl =
493 256810de Iustin Pop
            foldl'
494 7e7f6ca2 Iustin Pop
            (\ step_tbl elem ->
495 040afc35 Iustin Pop
                 if Instance.snode elem == Node.noSecondary then step_tbl
496 7e7f6ca2 Iustin Pop
                    else compareTables step_tbl $
497 7e7f6ca2 Iustin Pop
                         checkInstanceMove nodes_idx ini_tbl elem)
498 256810de Iustin Pop
            ini_tbl victims
499 aaaa0e43 Iustin Pop
        Table _ _ _ best_plc = best_tbl
500 0a0f2533 Iustin Pop
    in
501 0a0f2533 Iustin Pop
      if length best_plc == length ini_plc then -- no advancement
502 0a0f2533 Iustin Pop
          ini_tbl
503 0a0f2533 Iustin Pop
      else
504 7dfaafb1 Iustin Pop
          best_tbl
505 e4f08c46 Iustin Pop
506 e4f08c46 Iustin Pop
{- | Auxiliary function for solution computation.
507 e4f08c46 Iustin Pop
508 e4f08c46 Iustin Pop
We write this in an explicit recursive fashion in order to control
509 e4f08c46 Iustin Pop
early-abort in case we have met the min delta. We can't use foldr
510 e4f08c46 Iustin Pop
instead of explicit recursion since we need the accumulator for the
511 e4f08c46 Iustin Pop
abort decision.
512 e4f08c46 Iustin Pop
513 e4f08c46 Iustin Pop
-}
514 e4f08c46 Iustin Pop
advanceSolution :: [Maybe Removal] -- ^ The removal to process
515 e4f08c46 Iustin Pop
                -> Int             -- ^ Minimum delta parameter
516 e4f08c46 Iustin Pop
                -> Int             -- ^ Maximum delta parameter
517 e4f08c46 Iustin Pop
                -> Maybe Solution  -- ^ Current best solution
518 e4f08c46 Iustin Pop
                -> Maybe Solution  -- ^ New best solution
519 e4f08c46 Iustin Pop
advanceSolution [] _ _ sol = sol
520 e4f08c46 Iustin Pop
advanceSolution (Nothing:xs) m n sol = advanceSolution xs m n sol
521 e4f08c46 Iustin Pop
advanceSolution ((Just (Removal nx removed)):xs) min_d max_d prev_sol =
522 e4f08c46 Iustin Pop
    let new_sol = checkPlacement nx removed [] 0 prev_sol max_d
523 e4f08c46 Iustin Pop
        new_delta = solutionDelta $! new_sol
524 e4f08c46 Iustin Pop
    in
525 e4f08c46 Iustin Pop
      if new_delta >= 0 && new_delta <= min_d then
526 e4f08c46 Iustin Pop
          new_sol
527 e4f08c46 Iustin Pop
      else
528 e4f08c46 Iustin Pop
          advanceSolution xs min_d max_d new_sol
529 e4f08c46 Iustin Pop
530 e4f08c46 Iustin Pop
-- | Computes the placement solution.
531 e4f08c46 Iustin Pop
solutionFromRemovals :: [Maybe Removal] -- ^ The list of (possible) removals
532 e4f08c46 Iustin Pop
                     -> Int             -- ^ Minimum delta parameter
533 e4f08c46 Iustin Pop
                     -> Int             -- ^ Maximum delta parameter
534 e4f08c46 Iustin Pop
                     -> Maybe Solution  -- ^ The best solution found
535 e4f08c46 Iustin Pop
solutionFromRemovals removals min_delta max_delta =
536 e4f08c46 Iustin Pop
    advanceSolution removals min_delta max_delta Nothing
537 e4f08c46 Iustin Pop
538 e4f08c46 Iustin Pop
{- | Computes the solution at the given depth.
539 e4f08c46 Iustin Pop
540 e4f08c46 Iustin Pop
This is a wrapper over both computeRemovals and
541 e4f08c46 Iustin Pop
solutionFromRemovals. In case we have no solution, we return Nothing.
542 e4f08c46 Iustin Pop
543 e4f08c46 Iustin Pop
-}
544 262a08a2 Iustin Pop
computeSolution :: Node.List        -- ^ The original node data
545 e4f08c46 Iustin Pop
                -> [Instance.Instance] -- ^ The list of /bad/ instances
546 e4f08c46 Iustin Pop
                -> Int             -- ^ The /depth/ of removals
547 e4f08c46 Iustin Pop
                -> Int             -- ^ Maximum number of removals to process
548 e4f08c46 Iustin Pop
                -> Int             -- ^ Minimum delta parameter
549 e4f08c46 Iustin Pop
                -> Int             -- ^ Maximum delta parameter
550 e4f08c46 Iustin Pop
                -> Maybe Solution  -- ^ The best solution found (or Nothing)
551 e4f08c46 Iustin Pop
computeSolution nl bad_instances depth max_removals min_delta max_delta =
552 e4f08c46 Iustin Pop
  let
553 e4f08c46 Iustin Pop
      removals = computeRemovals nl bad_instances depth
554 e4f08c46 Iustin Pop
      removals' = capRemovals removals max_removals
555 e4f08c46 Iustin Pop
  in
556 e4f08c46 Iustin Pop
    solutionFromRemovals removals' min_delta max_delta
557 e4f08c46 Iustin Pop
558 e4f08c46 Iustin Pop
-- Solution display functions (pure)
559 e4f08c46 Iustin Pop
560 e4f08c46 Iustin Pop
-- | Given the original and final nodes, computes the relocation description.
561 e4f08c46 Iustin Pop
computeMoves :: String -- ^ The instance name
562 e4f08c46 Iustin Pop
             -> String -- ^ Original primary
563 e4f08c46 Iustin Pop
             -> String -- ^ Original secondary
564 e4f08c46 Iustin Pop
             -> String -- ^ New primary
565 e4f08c46 Iustin Pop
             -> String -- ^ New secondary
566 e4f08c46 Iustin Pop
             -> (String, [String])
567 e4f08c46 Iustin Pop
                -- ^ Tuple of moves and commands list; moves is containing
568 e4f08c46 Iustin Pop
                -- either @/f/@ for failover or @/r:name/@ for replace
569 e4f08c46 Iustin Pop
                -- secondary, while the command list holds gnt-instance
570 e4f08c46 Iustin Pop
                -- commands (without that prefix), e.g \"@failover instance1@\"
571 e4f08c46 Iustin Pop
computeMoves i a b c d =
572 e4f08c46 Iustin Pop
    if c == a then {- Same primary -}
573 e4f08c46 Iustin Pop
        if d == b then {- Same sec??! -}
574 e4f08c46 Iustin Pop
            ("-", [])
575 e4f08c46 Iustin Pop
        else {- Change of secondary -}
576 e4f08c46 Iustin Pop
            (printf "r:%s" d,
577 e4f08c46 Iustin Pop
             [printf "replace-disks -n %s %s" d i])
578 e4f08c46 Iustin Pop
    else
579 e4f08c46 Iustin Pop
        if c == b then {- Failover and ... -}
580 e4f08c46 Iustin Pop
            if d == a then {- that's all -}
581 e0eb63f0 Iustin Pop
                ("f", [printf "migrate -f %s" i])
582 e4f08c46 Iustin Pop
            else
583 e4f08c46 Iustin Pop
                (printf "f r:%s" d,
584 e0eb63f0 Iustin Pop
                 [printf "migrate -f %s" i,
585 e4f08c46 Iustin Pop
                  printf "replace-disks -n %s %s" d i])
586 e4f08c46 Iustin Pop
        else
587 e4f08c46 Iustin Pop
            if d == a then {- ... and keep primary as secondary -}
588 e4f08c46 Iustin Pop
                (printf "r:%s f" c,
589 e4f08c46 Iustin Pop
                 [printf "replace-disks -n %s %s" c i,
590 e0eb63f0 Iustin Pop
                  printf "migrate -f %s" i])
591 e4f08c46 Iustin Pop
            else
592 e4f08c46 Iustin Pop
                if d == b then {- ... keep same secondary -}
593 e4f08c46 Iustin Pop
                    (printf "f r:%s f" c,
594 e0eb63f0 Iustin Pop
                     [printf "migrate -f %s" i,
595 e4f08c46 Iustin Pop
                      printf "replace-disks -n %s %s" c i,
596 e0eb63f0 Iustin Pop
                      printf "migrate -f %s" i])
597 e4f08c46 Iustin Pop
598 e4f08c46 Iustin Pop
                else {- Nothing in common -}
599 e4f08c46 Iustin Pop
                    (printf "r:%s f r:%s" c d,
600 e4f08c46 Iustin Pop
                     [printf "replace-disks -n %s %s" c i,
601 e0eb63f0 Iustin Pop
                      printf "migrate -f %s" i,
602 e4f08c46 Iustin Pop
                      printf "replace-disks -n %s %s" d i])
603 e4f08c46 Iustin Pop
604 ca8258d9 Iustin Pop
{-| Converts a placement to string format -}
605 262a08a2 Iustin Pop
printSolutionLine :: Node.List
606 262a08a2 Iustin Pop
                  -> Instance.List
607 db1bcfe8 Iustin Pop
                  -> Int
608 db1bcfe8 Iustin Pop
                  -> Int
609 db1bcfe8 Iustin Pop
                  -> Placement
610 db1bcfe8 Iustin Pop
                  -> Int
611 db1bcfe8 Iustin Pop
                  -> (String, [String])
612 db1bcfe8 Iustin Pop
printSolutionLine nl il nmlen imlen plc pos =
613 ca8258d9 Iustin Pop
    let
614 ca8258d9 Iustin Pop
        pmlen = (2*nmlen + 1)
615 ca8258d9 Iustin Pop
        (i, p, s, c) = plc
616 ca8258d9 Iustin Pop
        inst = Container.find i il
617 dbd6700b Iustin Pop
        inam = Instance.name inst
618 262a08a2 Iustin Pop
        npri = Container.nameOf nl p
619 262a08a2 Iustin Pop
        nsec = Container.nameOf nl s
620 262a08a2 Iustin Pop
        opri = Container.nameOf nl $ Instance.pnode inst
621 262a08a2 Iustin Pop
        osec = Container.nameOf nl $ Instance.snode inst
622 ca8258d9 Iustin Pop
        (moves, cmds) =  computeMoves inam opri osec npri nsec
623 ca8258d9 Iustin Pop
        ostr = (printf "%s:%s" opri osec)::String
624 ca8258d9 Iustin Pop
        nstr = (printf "%s:%s" npri nsec)::String
625 ca8258d9 Iustin Pop
    in
626 ab271fc1 Iustin Pop
      (printf "  %3d. %-*s %-*s => %-*s %.8f a=%s"
627 ab271fc1 Iustin Pop
       pos imlen inam pmlen ostr
628 ca8258d9 Iustin Pop
       pmlen nstr c moves,
629 ca8258d9 Iustin Pop
       cmds)
630 ca8258d9 Iustin Pop
631 142538ff Iustin Pop
formatCmds :: [[String]] -> String
632 142538ff Iustin Pop
formatCmds cmd_strs =
633 e0eb63f0 Iustin Pop
    unlines $
634 142538ff Iustin Pop
    concat $ map (\(a, b) ->
635 e0eb63f0 Iustin Pop
        (printf "echo step %d" (a::Int)):
636 e0eb63f0 Iustin Pop
        (printf "check"):
637 e0eb63f0 Iustin Pop
        (map ("gnt-instance " ++) b)) $
638 142538ff Iustin Pop
        zip [1..] cmd_strs
639 142538ff Iustin Pop
640 e4f08c46 Iustin Pop
{-| Converts a solution to string format -}
641 262a08a2 Iustin Pop
printSolution :: Node.List
642 262a08a2 Iustin Pop
              -> Instance.List
643 e4f08c46 Iustin Pop
              -> [Placement]
644 e4f08c46 Iustin Pop
              -> ([String], [[String]])
645 db1bcfe8 Iustin Pop
printSolution nl il sol =
646 671b85b9 Iustin Pop
    let
647 262a08a2 Iustin Pop
        nmlen = Container.maxNameLen nl
648 262a08a2 Iustin Pop
        imlen = Container.maxNameLen il
649 671b85b9 Iustin Pop
    in
650 db1bcfe8 Iustin Pop
      unzip $ map (uncurry $ printSolutionLine nl il nmlen imlen) $
651 ab271fc1 Iustin Pop
            zip sol [1..]
652 e4f08c46 Iustin Pop
653 e4f08c46 Iustin Pop
-- | Print the node list.
654 262a08a2 Iustin Pop
printNodes :: Node.List -> String
655 dbd6700b Iustin Pop
printNodes nl =
656 e4f08c46 Iustin Pop
    let snl = sortBy (compare `on` Node.idx) (Container.elems nl)
657 dbd6700b Iustin Pop
        m_name = maximum . map (length . Node.name) $ snl
658 af53a5c4 Iustin Pop
        helper = Node.list m_name
659 a1c6212e Iustin Pop
        header = printf
660 a1c6212e Iustin Pop
                 "%2s %-*s %5s %5s %5s %5s %5s %5s %5s %5s %3s %3s %7s %7s"
661 a1c6212e Iustin Pop
                 " F" m_name "Name"
662 a1c6212e Iustin Pop
                 "t_mem" "n_mem" "i_mem" "x_mem" "f_mem" "r_mem"
663 ced859f3 Iustin Pop
                 "t_dsk" "f_dsk"
664 ced859f3 Iustin Pop
                 "pri" "sec" "p_fmem" "p_fdsk"
665 dbd6700b Iustin Pop
    in unlines $ (header:map helper snl)
666 e4f08c46 Iustin Pop
667 e4f08c46 Iustin Pop
-- | Compute the mem and disk covariance.
668 262a08a2 Iustin Pop
compDetailedCV :: Node.List -> (Double, Double, Double, Double, Double)
669 e4f08c46 Iustin Pop
compDetailedCV nl =
670 0335fe4a Iustin Pop
    let
671 19777638 Iustin Pop
        all_nodes = Container.elems nl
672 19777638 Iustin Pop
        (offline, nodes) = partition Node.offline all_nodes
673 0335fe4a Iustin Pop
        mem_l = map Node.p_mem nodes
674 0335fe4a Iustin Pop
        dsk_l = map Node.p_dsk nodes
675 e4f08c46 Iustin Pop
        mem_cv = varianceCoeff mem_l
676 e4f08c46 Iustin Pop
        dsk_cv = varianceCoeff dsk_l
677 34a6e127 Iustin Pop
        n1_l = length $ filter Node.failN1 nodes
678 34a6e127 Iustin Pop
        n1_score = (fromIntegral n1_l) / (fromIntegral $ length nodes)
679 d6be0775 Iustin Pop
        res_l = map Node.p_rem nodes
680 d6be0775 Iustin Pop
        res_cv = varianceCoeff res_l
681 19777638 Iustin Pop
        offline_inst = sum . map (\n -> (length . Node.plist $ n) +
682 19777638 Iustin Pop
                                        (length . Node.slist $ n)) $ offline
683 19777638 Iustin Pop
        online_inst = sum . map (\n -> (length . Node.plist $ n) +
684 19777638 Iustin Pop
                                       (length . Node.slist $ n)) $ nodes
685 19777638 Iustin Pop
        off_score = (fromIntegral offline_inst) /
686 19777638 Iustin Pop
                    (fromIntegral $ online_inst + offline_inst)
687 19777638 Iustin Pop
    in (mem_cv, dsk_cv, n1_score, res_cv, off_score)
688 e4f08c46 Iustin Pop
689 e4f08c46 Iustin Pop
-- | Compute the 'total' variance.
690 262a08a2 Iustin Pop
compCV :: Node.List -> Double
691 e4f08c46 Iustin Pop
compCV nl =
692 19777638 Iustin Pop
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
693 19777638 Iustin Pop
    in mem_cv + dsk_cv + n1_score + res_cv + off_score
694 e4f08c46 Iustin Pop
695 262a08a2 Iustin Pop
printStats :: Node.List -> String
696 e4f08c46 Iustin Pop
printStats nl =
697 19777638 Iustin Pop
    let (mem_cv, dsk_cv, n1_score, res_cv, off_score) = compDetailedCV nl
698 19777638 Iustin Pop
    in printf "f_mem=%.8f, r_mem=%.8f, f_dsk=%.8f, n1=%.3f, uf=%.3f"
699 19777638 Iustin Pop
       mem_cv res_cv dsk_cv n1_score off_score