+ my %results;
+ foreach my $name (@names) {
+ $results{$name} = timethis ($n, $alt -> {$name}, $name, $style);
+ }
+
+ return \%results;
+}
+
+
+$_Usage{cmpthese} = <<'USAGE';
+usage: cmpthese($count, { Name1 => 'code1', ... }); or
+ cmpthese($count, { Name1 => sub { code1 }, ... }); or
+ cmpthese($result, $style);
+USAGE
+
+sub cmpthese{
+ my ($results, $style);
+
+ # $count can be a blessed object.
+ if ( ref $_[0] eq 'HASH' ) {
+ ($results, $style) = @_;
+ }
+ else {
+ my($count, $code) = @_[0,1];
+ $style = $_[2] if defined $_[2];
+
+ die usage unless ref $code eq 'HASH';
+
+ $results = timethese($count, $code, ($style || "none"));
+ }
+
+ $style = "" unless defined $style;
+
+ # Flatten in to an array of arrays with the name as the first field
+ my @vals = map{ [ $_, @{$results->{$_}} ] } keys %$results;
+
+ for (@vals) {
+ # recreate the pre-flattened Benchmark object
+ my $tmp_bm = bless [ @{$_}[1..$#$_] ];
+ my $elapsed = $tmp_bm->elapsed($style);
+ # The epsilon fudge here is to prevent div by 0. Since clock
+ # resolutions are much larger, it's below the noise floor.
+ my $rate = $_->[6]/(($elapsed)+0.000000000000001);
+ $_->[7] = $rate;
+ }
+
+ # Sort by rate
+ @vals = sort { $a->[7] <=> $b->[7] } @vals;
+
+ # If more than half of the rates are greater than one...
+ my $display_as_rate = @vals ? ($vals[$#vals>>1]->[7] > 1) : 0;
+
+ my @rows;
+ my @col_widths;
+
+ my @top_row = (
+ '',
+ $display_as_rate ? 'Rate' : 's/iter',
+ map { $_->[0] } @vals
+ );
+
+ push @rows, \@top_row;
+ @col_widths = map { length( $_ ) } @top_row;
+
+ # Build the data rows
+ # We leave the last column in even though it never has any data. Perhaps
+ # it should go away. Also, perhaps a style for a single column of
+ # percentages might be nice.
+ for my $row_val ( @vals ) {
+ my @row;
+
+ # Column 0 = test name
+ push @row, $row_val->[0];
+ $col_widths[0] = length( $row_val->[0] )
+ if length( $row_val->[0] ) > $col_widths[0];
+
+ # Column 1 = performance
+ my $row_rate = $row_val->[7];
+
+ # We assume that we'll never get a 0 rate.
+ my $rate = $display_as_rate ? $row_rate : 1 / $row_rate;
+
+ # Only give a few decimal places before switching to sci. notation,
+ # since the results aren't usually that accurate anyway.
+ my $format =
+ $rate >= 100 ?
+ "%0.0f" :
+ $rate >= 10 ?
+ "%0.1f" :
+ $rate >= 1 ?
+ "%0.2f" :
+ $rate >= 0.1 ?
+ "%0.3f" :
+ "%0.2e";
+
+ $format .= "/s"
+ if $display_as_rate;
+
+ my $formatted_rate = sprintf( $format, $rate );
+ push @row, $formatted_rate;
+ $col_widths[1] = length( $formatted_rate )
+ if length( $formatted_rate ) > $col_widths[1];
+
+ # Columns 2..N = performance ratios
+ my $skip_rest = 0;
+ for ( my $col_num = 0 ; $col_num < @vals ; ++$col_num ) {
+ my $col_val = $vals[$col_num];
+ my $out;
+ if ( $skip_rest ) {
+ $out = '';
+ }
+ elsif ( $col_val->[0] eq $row_val->[0] ) {
+ $out = "--";
+ # $skip_rest = 1;
+ }
+ else {
+ my $col_rate = $col_val->[7];
+ $out = sprintf( "%.0f%%", 100*$row_rate/$col_rate - 100 );
+ }
+ push @row, $out;
+ $col_widths[$col_num+2] = length( $out )
+ if length( $out ) > $col_widths[$col_num+2];
+
+ # A little weirdness to set the first column width properly
+ $col_widths[$col_num+2] = length( $col_val->[0] )
+ if length( $col_val->[0] ) > $col_widths[$col_num+2];
+ }
+ push @rows, \@row;
+ }
+
+ return \@rows if $style eq "none";
+
+ # Equalize column widths in the chart as much as possible without
+ # exceeding 80 characters. This does not use or affect cols 0 or 1.
+ my @sorted_width_refs =
+ sort { $$a <=> $$b } map { \$_ } @col_widths[2..$#col_widths];
+ my $max_width = ${$sorted_width_refs[-1]};
+
+ my $total = @col_widths - 1 ;
+ for ( @col_widths ) { $total += $_ }
+
+ STRETCHER:
+ while ( $total < 80 ) {
+ my $min_width = ${$sorted_width_refs[0]};
+ last
+ if $min_width == $max_width;
+ for ( @sorted_width_refs ) {
+ last
+ if $$_ > $min_width;
+ ++$$_;
+ ++$total;
+ last STRETCHER
+ if $total >= 80;
+ }
+ }
+
+ # Dump the output
+ my $format = join( ' ', map { "%${_}s" } @col_widths ) . "\n";
+ substr( $format, 1, 0 ) = '-';
+ for ( @rows ) {
+ printf $format, @$_;
+ }
+
+ return \@rows ;