Logo AND Algorithmique Numérique Distribuée

Public GIT Repository
convenient scripts to generate platforms
[simgrid.git] / tools / platform_generation / graph_tbx.pm
1 #!/usr/bin/perl -w
2 use strict;
3
4 # Un graphe c'est un hachage nodes et un hachage edges avec trucs dedans
5 # nodes{nom}{type}, nodes{nom}{X}, nodes{nom}{Y}, nodes{nom}{in}, nodes{nom}{out} par exemple
6 # edges{nom}{src}, edges{nom}{dst}, edges{nom}{type}, edges{nom}{delay}, edges{nom}{bw}
7
8
9 sub G_new_graph {
10     my(%nodes,%edges); # a new graph...
11     return(\%nodes,\%edges);
12 }
13
14 sub G_new_node {
15     my($nodes,$edges,$name) = @_;
16     $$nodes{$name}{name}=$name;
17     $$nodes{$name}{type}=2;
18 }
19
20 sub G_connect {
21     my($nodes,$edges,$src,$dst) = @_;
22     my($edge_count)=scalar(keys(%{$edges}));
23     $$edges{$edge_count}{src}=$src;
24     $$edges{$edge_count}{dst}=$dst;
25 #    $$edges{$edge_count}{delay} = $delay;
26 #    $$edges{$edge_count}{bw} = $bw;
27 #    $$edges{$edge_count}{type} = $type;
28 #    $$edges{$edge_count}{using_path} = [];
29     $$nodes{$src}{out}{$dst} = $edge_count;
30     $$nodes{$dst}{in}{$src} = $edge_count;
31     $$nodes{$dst}{out}{$src} = $edge_count;
32     $$nodes{$src}{in}{$dst} = $edge_count;
33     return($edge_count);
34 }
35
36 sub GO_connect {
37     my($nodes,$edges,$src,$dst) = @_;
38     my($edge_count)=scalar(keys(%{$edges}));
39     $$edges{$edge_count}{src}=$src;
40     $$edges{$edge_count}{dst}=$dst;
41 #    $$edges{$edge_count}{delay} = $delay;
42 #    $$edges{$edge_count}{bw} = $bw;
43 #    $$edges{$edge_count}{type} = $type;
44 #    $$edges{$edge_count}{using_path} = [];
45     $$nodes{$src}{out}{$dst} = $edge_count;
46     $$nodes{$dst}{in}{$src} = $edge_count;
47     return($edge_count);
48 }
49
50 sub G_simgrid_export {
51     my($nodes,$edges,$filename) = @_;
52     my($u,$v,$w,$e);
53     my(@host_list)=();
54     
55     open MSG_OUTPUT, "> $filename";
56
57     print MSG_OUTPUT "HOSTS\n";
58     foreach $u (keys %{$nodes}) {
59         if (!((defined($$nodes{$u}{host}))&&($$nodes{$u}{host}==1))) { next; }
60         if (!((defined($$nodes{$u}{Mflops}))&&($$nodes{$u}{host}==1))) { 
61             die "Lacking Mflops for $u\n"; 
62         }
63         print MSG_OUTPUT "$u $$nodes{$u}{Mflops}\n";
64         push @host_list,$u;
65     }
66     print MSG_OUTPUT "LINKS\n";
67     foreach $e (keys %{$edges}) {
68         (defined($$edges{$e}{bw})) or die "Lacking bw for $u\n"; 
69         (defined($$edges{$e}{delay})) or die "Lacking bw for $u\n"; 
70         print MSG_OUTPUT "$e $$edges{$e}{bw} $$edges{$e}{delay}\n";
71     }
72     print MSG_OUTPUT "ROUTES\n";
73     foreach $u (@host_list){
74         foreach $v (@host_list){
75             if($u ne $v) {
76                 my(@path)=();
77                 $w = $u;
78                 while ($w ne $v) {
79                     my($next) = $$nodes{$w}{shortest_route}{$v};
80                     $e = $$nodes{$w}{out}{$next};
81                     push(@path,$e);
82                     $w = $next;
83                 }
84                 print MSG_OUTPUT "$u $v (@path)\n";
85             }
86         }
87     }
88     close(MSG_OUTPUT);
89 }
90
91 sub G_surfxml_export {
92     my($nodes,$edges,$filename) = @_;
93     my($u,$v,$w,$e);
94     my(@host_list)=();
95     
96     open MSG_OUTPUT, "> $filename";
97
98     print MSG_OUTPUT "<?xml version='1.0'?>\n";
99     print MSG_OUTPUT "<!DOCTYPE platform_description SYSTEM \"surfxml.dtd\">\n";
100     print MSG_OUTPUT "<platform_description>\n";
101
102     foreach $u (keys %{$nodes}) {
103         if (!((defined($$nodes{$u}{host}))&&($$nodes{$u}{host}==1))) { next; }
104         if (!((defined($$nodes{$u}{Mflops}))&&($$nodes{$u}{host}==1))) { 
105             die "Lacking Mflops for $u\n"; 
106         }
107         print MSG_OUTPUT "  <cpu name=\"$$nodes{$u}{name}\" power=\"$$nodes{$u}{Mflops}\"/>\n";
108         push @host_list,$u;
109     }
110     foreach $e (keys %{$edges}) {
111         (defined($$edges{$e}{bw})) or die "Lacking bw for $u\n"; 
112         (defined($$edges{$e}{delay})) or die "Lacking bw for $u\n"; 
113         my($lat);
114         $lat = $$edges{$e}{delay} / 1000;
115         print MSG_OUTPUT "  <network_link name=\"$e\" bandwidth=\"$$edges{$e}{bw}\" latency=\"$lat\"/>\n";
116     }
117     foreach $u (@host_list){
118         foreach $v (@host_list){
119             if($u ne $v) {
120                 my(@path)=();
121                 $w = $u;
122                 while ($w ne $v) {
123                     my($next) = $$nodes{$w}{shortest_route}{$v};
124                     $e = $$nodes{$w}{out}{$next};
125                     push(@path,$e);
126                     $w = $next;
127                 }
128                 print MSG_OUTPUT "  <route src=\"$$nodes{$u}{name}\" dst=\"$$nodes{$v}{name}\">";
129                 foreach $w (@path) {
130                     print MSG_OUTPUT "<route_element name=\"$w\"/>";
131                 }
132                 print MSG_OUTPUT "  </route>\n";
133             }
134         }
135     }
136     print MSG_OUTPUT "</platform_description>\n";
137     close(MSG_OUTPUT);
138 }
139
140 ##############################
141 ###    GRAPH ALGORITHMS    ###
142 ##############################
143
144 sub shortest_paths{
145     my($nodes,$edges) = @_;
146
147     my(%connexion);
148     my(%distance);
149     my(%shortest);
150
151     my(@node_list) = sort (keys %$nodes);
152     my($n) =  scalar(@node_list);
153
154     my($u,$v,$w,$step,$e);
155
156     foreach $u (@node_list){
157         foreach $v (@node_list){
158             $connexion{$u}{$v} = 0;
159             $distance{$u}{$v} = 0;
160             $shortest{$u}{$v} = -1;
161         }
162     }
163
164     foreach $e (sort (keys %$edges)){
165         my($x1)=$$edges{$e}{src};
166         my($x2)=$$edges{$e}{dst};
167         $connexion{$x1}{$x2} = $connexion{$x2}{$x1} = 1;
168         $distance{$x1}{$x2} = $distance{$x2}{$x1} = 1;
169         $shortest{$x1}{$x2} = $x2;
170         $shortest{$x2}{$x1} = $x1;
171     }
172
173 #    print_matrix(\%connexion);
174 #    matrix2viz(\%connexion);
175
176     foreach $step (0..$n-1){
177         my($modif) = 0;
178         foreach $u (@node_list){
179             foreach $v (@node_list){
180                 foreach $w (@node_list){
181                     if(($connexion{$u}{$w} != 0)
182                         && ($distance{$w}{$v}!=0)
183                         && (($distance{$u}{$v} >
184                              $distance{$u}{$w} + $distance{$w}{$v}) || ($distance{$u}{$v}==0))
185                        ){
186                         $distance{$u}{$v} =
187                             $distance{$u}{$w} + $distance{$w}{$v};
188                         $shortest{$u}{$v} = $w;
189                         $modif = 1;
190                     }
191                 }
192             }
193         }
194         if($modif == 0) {last;}
195     }
196
197     foreach $u (@node_list){
198         foreach $v (@node_list){
199             if($u eq $v) {
200                 $$nodes{$u}{shortest_route}{$v} = $u;
201                 $$nodes{$u}{number_hops}{$v} = 0;
202             } else {
203                 $$nodes{$u}{shortest_route}{$v} = $shortest{$u}{$v};
204                 $$nodes{$u}{number_hops}{$v} = $distance{$u}{$v};
205             }
206         }
207     }
208 }
209
210 sub build_interferences{
211     my($nodes,$edges,$host_list) = @_;
212
213     my($u,$v,$w,$e);
214     my(%interference);
215
216     foreach $u (@$host_list){
217         foreach $v (@$host_list){
218             if($u ne $v) {
219                 $w = $u;
220                 push(@{ $$nodes{$u}{using_path}},[$u,$v]);
221                 while ($w ne $v) {
222                     my($next) = $$nodes{$w}{shortest_route}{$v};
223                     $e = $$nodes{$w}{out}{$next};
224                     push(@{ $$edges{$e}{using_path}},[$u,$v]);
225                     push(@{ $$nodes{$next}{using_path}},[$u,$v]);
226                     $w = $next;
227                 }
228             }
229         }
230     }
231 #     foreach $e (keys %$edges){
232 #       my($e1,$e2);
233 #       foreach $e1 (@{$$edges{$e}{using_path}}) {
234 #           my($p1,$q1) = @$e1;
235 #           foreach $e2 (@{$$edges{$e}{using_path}}) {
236 #               my($p2,$q2) = @$e2;
237 #               $interference{$p1}{$p2}{$q1}{$q2} = 1;
238 #           }
239 #       }       
240 #     }
241     my($p1,$p2,$q1,$q2);
242
243     foreach $p1 (@$host_list) {
244         foreach $p2 (@$host_list) {
245             foreach $q1 (@$host_list) {
246                 foreach $q2 (@$host_list) {
247                     $interference{$p1}{$p2}{$q1}{$q2}=0;
248                 }
249             }
250         }
251     }
252
253     foreach $e (keys %$nodes){
254         my($e1,$e2);
255         foreach $e1 (@{$$nodes{$e}{using_path}}) {
256             my($p1,$q1) = @$e1;
257             foreach $e2 (@{$$nodes{$e}{using_path}}) {
258                 my($p2,$q2) = @$e2;
259                 $interference{$p1}{$p2}{$q1}{$q2} = 1;
260             }
261         }       
262     }
263
264     foreach $e (keys %$nodes){
265         undef(@{$$nodes{$e}{using_path}});
266     }
267
268     foreach $e (keys %$edges){
269         undef(@{$$edges{$e}{using_path}});
270     }
271
272 #    foreach $u (@host_list){
273 #        foreach $v (@host_list){
274 #           if((defined($interference[$u]))&&(defined($interference[$u][$v]))) {
275 #               print_matrix($interference[$u][$v]);
276 #           }
277 #       }
278 #    }
279     return(\%interference);
280 }
281
282 sub __visit_pp {
283     my($nodes,$edges,$u,$time,$direction,$stamp) = @_;
284     my($v);
285     $$nodes{$u}{"Couleur_$stamp"}=1;
286     $$time++;
287     $$nodes{$u}{"Debut_$stamp"}=$$time;
288     foreach $v (keys (%{$$nodes{$u}{$direction}})) {
289         if ($$nodes{$v}{"Couleur_$stamp"} == 0) {
290             $$nodes{$v}{"PI_$stamp"} = $u;
291             __visit_pp($nodes,$edges,$v,$time,$direction,$stamp);
292         }
293     }
294     $$nodes{$u}{"Couleur_$stamp"}=2;
295     $$time++;
296     $$nodes{$u}{"Fin_$stamp"}=$$time;
297 }
298
299 sub __PP {
300     my($nodes,$edges,$direction,$stamp,$stampSorter) = @_;
301
302     my(@node_list) = (keys %$nodes);
303     if(defined($stampSorter)) {
304         @node_list = sort {
305             $$nodes{$b}{$stampSorter}
306                        <=>
307             $$nodes{$a}{$stampSorter}
308         } @node_list;
309     }
310
311     my($u,$time);
312
313     foreach $u (@node_list) {
314         $$nodes{$u}{"Couleur_$stamp"} = 0;
315     }
316     $time = 0;
317     foreach $u (@node_list) {
318         if($$nodes{$u}{"Couleur_$stamp"} == 0) {
319             __visit_pp($nodes,$edges,$u,\$time,$direction,$stamp);
320         }
321     }
322     return $time;
323 }
324
325
326 sub GO_SCC_Topological_Sort{
327     my($nodes,$edges) = @_;
328
329     my(@node_list) = (keys %$nodes);
330
331     ### Strongly Connected Components building
332     __PP($nodes,$edges,"out","1");
333     __PP($nodes,$edges,"in","2","Fin_1");
334
335     @node_list = sort 
336     {
337         if ($$nodes{$a}{"Fin_2"}<$$nodes{$b}{"Debut_2"}) {
338             return -1;
339         } elsif ($$nodes{$a}{"Debut_2"}<$$nodes{$b}{"Debut_2"}) {
340             return -1;
341         } 
342         return 1;
343     }
344     @node_list;
345
346     my($u,$v);
347     my($scc)=$node_list[0];
348     my(%SCC);
349     foreach $u (@node_list) {
350         if($$nodes{$u}{Fin_2} > $$nodes{$scc}{Fin_2}) {
351             $scc = $u;
352         }
353         push @{$SCC{$scc}},$u;
354         $$nodes{$u}{SCC_leader}=$scc;
355     }
356
357     ### Topological Sort
358     my($n_SCC,$e_SCC)=G_new_graph();
359     foreach $scc (keys %SCC) {
360         G_new_node($n_SCC,$e_SCC,$$nodes{$scc}{SCC_leader});
361         foreach $u (@{$SCC{$scc}}) {
362             foreach $v (keys (%{$$nodes{$u}{out}})) {
363                 if(!defined($$n_SCC{$$nodes{$u}{SCC_leader}}{out}{$$nodes{$v}{SCC_leader}})) {
364                     GO_connect($n_SCC,$e_SCC,$$nodes{$u}{SCC_leader},$$nodes{$v}{SCC_leader});
365                 }
366             }
367         }
368     }
369
370     __PP($n_SCC,$e_SCC,"out","TS");
371     my(@SCC_list) = keys %SCC;
372     @SCC_list = sort {$$n_SCC{$b}{Fin_TS} <=> $$n_SCC{$a}{Fin_TS}} @SCC_list;
373     my(@ordering)=();
374     foreach $scc (@SCC_list) {
375         push @ordering, $SCC{$scc};
376     }
377
378     return \@ordering;
379 }
380
381
382 1;