1use Graph; 2use Graph::Directed; 3use Graph::Undirected; 4use Time::HiRes qw(time); 5use Getopt::Long; 6 7my %OPT = (seed => 42, test => 'apsp', fill => 0.50, V => 20, directed => 1); 8 9my @TEST = qw(apsp mstp mstk sptd sptb cc bcc scc); 10my %TEST; @TEST{@TEST} = (); 11 12my @WTEST = qw(apsp mstp mstk sptd sptb bcc); 13my %WTEST; @WTEST{@WTEST} = (); 14 15my @UTEST = qw(mstk mstp cc); 16my %UTEST; @UTEST{@UTEST} = (); 17 18my @DTEST = qw(scc); 19my %DTEST; @DTEST{@DTEST} = (); 20 21sub usage { 22 warn <<__EOF__; 23$0: Usage: $0 [--seed=n] 24 [--test=@{[join('|', @TEST)]}] 25 [--directed=d] [--fill=f] [V] 26Default values: 27__EOF__ 28 for my $o (sort keys %OPT) { 29 warn <<__EOF__; 30$o = $OPT{$o} 31__EOF__ 32 } 33 exit(1); 34} 35 36usage() 37 unless 38 GetOptions( 39 'seed=n' => \$OPT{seed}, 40 'test=s' => \$OPT{test}, 41 'directed=n' => \$OPT{directed}, 42 'fill=f' => \$OPT{fill}, 43 ); 44$OPT{V} = shift if @ARGV; 45usage() if @ARGV; 46usage() unless exists $TEST{$OPT{test}}; 47 48print "Running $OPT{test}...\n"; 49 50srand($OPT{seed}); 51 52if (exists $UTEST{$OPT{test}} && $OPT{directed}) { 53 $OPT{directed} = 0; 54 print "($OPT{test} needs undirected, fixed)\n"; 55} elsif (exists $DTEST{$OPT{test}} && !$OPT{directed}) { 56 $OPT{directed} = 1; 57 print "($OPT{test} needs directed, fixed)\n"; 58} 59 60if ($OPT{fill} < 0.0 || $OPT{fill} > 1.0) { 61 $OPT{fill} = 0.5; 62 print "($OPT{fill} must be between 0.0 and 1.0, fixed to be 0.5)\n"; 63} 64 65# Thanks to Devel::DProf and List::Util breakage. 66# my $g = Graph->random_graph(vertices => $OPT{V}, 67# directed => $OPT{directed}, 68# edges_fill => $OPT{fill}); 69my $E = int(($OPT{V} * ($OPT{V} - 1) * $OPT{fill}) / ($OPT{directed} ? 1 : 2)); 70my $g = $OPT{directed} ? Graph::Directed->new() : Graph::Undirected->new(); 71my $e = $E; 72while (1) { 73 my $u = int(rand($OPT{V})); 74 my $v = int(rand($OPT{V})); 75 if ($u ne $v && !$g->has_edge($u, $v)) { 76 $g->add_edge($u, $v); 77 last unless --$e; 78 } 79} 80print "($OPT{V} vertices, $E edges)\n"; 81 82if (exists $WTEST{$OPT{test}}) { 83 for my $e ($g->edges) { 84 my ($u, $v) = @$e; 85 $g->set_edge_weight($u, $v, rand()); 86 } 87} 88 89my $t0 = time(); 90my ($u0, $s0) = times(); 91 92if ($OPT{test} eq 'apsp') { 93 my $apsp = $g->APSP_Floyd_Warshall; 94} elsif ($OPT{test} eq 'mstk') { 95 my $mst = $g->MST_Kruskal; 96} elsif ($OPT{test} eq 'mstp') { 97 my $mst = $g->MST_Prim; 98} elsif ($OPT{test} eq 'sptd') { 99 my $mst = $g->SPT_Dijkstra; 100} elsif ($OPT{test} eq 'sptb') { 101 my $mst = $g->SPT_Bellman_Ford; 102} elsif ($OPT{test} eq 'cc') { 103 my @cc = $g->connected_components; 104} elsif ($OPT{test} eq 'bcc') { 105 my @bcc = $g->biconnected_components; 106} elsif ($OPT{test} eq 'scc') { 107 my @scc = $g->strongly_connected_components; 108} else { 109 die "$0: Unknown test '$OPT{test}'"; 110} 111 112my $t1 = time(); 113my ($u1, $s1) = times(); 114 115my $u = $u1 - $u0; 116my $s = $s1 - $s0; 117my $c = $u + $s; 118 119printf "real %.2f user %.2f system %.2f cpu %.2f\n", $t1 - $t0, $u, $s, $c; 120 121exit(0); 122