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