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;