comment on

Good catch. My test framework had a couple of bugs that let me miss that. I've corrected the framework errors, corrected my logical vs bitwise xor error and added the two contributions by anon monks to the tests. It changed the rankings - snowhare4 moved from about 9th to 2nd behind anonmonk1 after fixing. However, anonmonk1 got 3 test case failures, so snowhare4 is now the fastest of the correct solutions. It's nice that the solution that is to me the most elegant is also the fastest correct solution.

#!/usr/bin/perl

use strict;
use Benchmark;
use Data::Dumper;
use List::Util      qw (sum);
use List::MoreUtils qw (true);

my $Test_Results = {};
my @Test_Cases = (
    [qw (0 0 2 1 002)], [qw (0 2 1 0 021)],
    [qw (0 0 0 0 000)], [qw (0 0 1 1 001)],
    [qw (0 1 0 1 010)], [qw (0 1 1 0 011)],
    [qw (1 0 0 1 100)], [qw (1 0 1 0 101)],
    [qw (1 1 0 0 110)], [qw (1 1 1 0 111)],
);

my $test_result_timings = timethese(500000, { 
    'a_null_sub'   => sub { test_framework('a_null_sub',  \&a_null_sub
+);   },
    'snowhare1'    => sub { test_framework('snowhare1',   \&snowhare1)
+;    },
    'snowhare2'    => sub { test_framework('snowhare2',   \&snowhare2)
+;    },
    'snowhare3'    => sub { test_framework('snowhare3',   \&snowhare3)
+;    },
    'snowhare4'    => sub { test_framework('snowhare4',   \&snowhare4)
+;    },
    'snowhare5'    => sub { test_framework('snowhare5',   \&snowhare5)
+;    },
    'snowhare6'    => sub { test_framework('snowhare6',   \&snowhare6)
+;    },
    'saintmike1'   => sub { test_framework('saintmike1',  \&saintmike1
+);   },
    'saintmike2'   => sub { test_framework('saintmike2',  \&saintmike2
+);   },
    'tye1'         => sub { test_framework('tye1',        \&tye1);    
+     },
    'tye2'         => sub { test_framework('tye2',        \&tye2);    
+     },
    'ph713_1'      => sub { test_framework('ph713_1',     \&ph713_1); 
+     },
    'tanktalus1'   => sub { test_framework('tanktalus1',  \&tanktalus1
+);   },
    'davido1'      => sub { test_framework('davido1',     \&davido1); 
+     },
    'ikegami1'     => sub { test_framework('ikegami1',    \&ikegami1);
+     },
    'strat1'       => sub { test_framework('strat1',      \&strat1);  
+     },
    'strat2'       => sub { test_framework('strat2',      \&strat2);  
+     },
    'jamesnc1'     => sub { test_framework('jamesnc1',    \&jamesnc1);
+     },
    'anonmonk1'    => sub { test_framework('anonmonk1',   \&anonmonk1)
+;    },
    'knom1'        => sub { test_framework('knom1',       \&knom1);   
+     },
        }
);

my $tare_timing = $test_result_timings->{'a_null_sub'};
my @result_ids  = sort keys %$test_result_timings;
my $compensated_results = {};
my $fastest;
my %error_results = ();
foreach my $result_label (@result_ids) {
    next if ($result_label eq 'a_null_sub');
    my $result_timing    = $test_result_timings->{$result_label};
    my $compensated_time = timediff($result_timing, $tare_timing);
    my $cpu_secs         = $compensated_time->[1];
    $compensated_results->{$result_label} = $cpu_secs;
    if (defined $fastest) {
        if ($cpu_secs < $compensated_results->{$fastest}) {
            $fastest = $result_label;
        }
    } else {
        $fastest = $result_label;
    }
    foreach my $test_case (@Test_Cases) {
       my $test_pattern = $test_case->[4];
       $error_results{$result_label} += $Test_Results->{$result_label}
+->{$test_pattern};
    }
}

my $fastest_result = $compensated_results->{$fastest};
my @sorted_result_ids = sort { $compensated_results->{$a} <=> $compens
+ated_results->{$b} } keys %$compensated_results;
foreach my $final_result_id (@sorted_result_ids) {
    my $cpu_secs = $compensated_results->{$final_result_id};
    printf "%20s : %5.2f secs %5.0f\% (%s errors)\n", $final_result_id
+, $cpu_secs, (100 * $cpu_secs / $fastest_result), $error_results{$fin
+al_result_id};
}
exit;

###

sub test_framework {
   my ($test_id, $test_sub) = @_;
   foreach my $test_case (@Test_Cases) {
       my $result = &$test_sub($test_case->[0],$test_case->[1],$test_c
+ase->[2]) ? 1 : 0;
       my $error  = ($result xor $test_case->[3]) ? 1 : 0;
       $Test_Results->{$test_id}->{$test_case->[4]} = $error;
   }
}

###

sub a_null_sub {
    return 0;
}

sub anonmonk1 {
    return $_[0] && !$_[1] && !$_[2] or !$_[0] && ($_[1] xor $_[2]);
}

sub knom1 {
    my $count;
    foreach (@_) { $count++ if($_); }
    return 1 == $count;
}

sub snowhare1 {
    return 1 == ($_[0] ? 1 : 0) + ($_[1] ? 1 : 0) + ($_[2] ? 1 :0);
}

sub snowhare2 {
    return 2 == (! $_[0]) + (! $_[1]) + (! $_[2]);
}

sub snowhare3 {
    return ($_[0] || $_[1] || $_[2]) && (! ($_[0] && $_[1])) && (! ($_
+[1] && $_[2])) && (! ($_[2] && $_[0]));
}

sub snowhare4 {
    return  (! ($_[0] && $_[1] && $_[2])) && ($_[0] xor $_[1] xor $_[2
+]);
}

sub snowhare5 {
    use integer;
    return 1 == ($_[0] ? 1 : 0) + ($_[1] ? 1 : 0) + ($_[2] ? 1 :0);
}
sub snowhare6 {
    use integer;
    return 2 == (! $_[0]) + (! $_[1]) + (! $_[2]);
}
sub saintmike2 {
    return  1 == (grep {$_} $_[0],$_[1],$_[2]);
}

sub saintmike1 {
    my $count = 0;
    $_[0] && $count++;
    $_[1] && $count++;
    $_[2] && $count++;
    return 1 == $count;
}

sub tye1 {
    return  1 == grep $_, $_[0], $_[1], $_[2];
}

sub tye2 {
    return  1 == !!$_[0] + !!$_[1] + !!$_[2];
}

sub ph713_1 {
    return 1 == sum( map { !!$_ } @_);
}

sub tanktalus1 {
    return 1 == sum( map { $_ ? 1 : 0 } @_ );
}

sub davido1 {
   return 1 == true { $_ } @_; 
}

sub ikegami1 {
   my $count = 0;
   $_ && $count++ foreach @_;
   return $count == 1;
}

sub strat1 {
    my $count = 0;
    $_ and $count++ for (@_);
    return 1 == $count;
}

sub strat2 {
    1 == do {my $cnt=0; $_ and $cnt++ for (@_); $cnt }
}

sub jamesnc1 {
    my $t = 1; 
    for (@_) { $t = $t<<1 if $_; }
    return 2 == $t;
}
[download]

           anonmonk1 :  3.26 secs   100% (3 errors)
           snowhare4 :  4.50 secs   138% (0 errors)
           snowhare6 :  4.66 secs   143% (0 errors)
           snowhare2 :  4.99 secs   153% (0 errors)
                tye2 :  5.13 secs   157% (0 errors)
           snowhare5 :  5.17 secs   159% (0 errors)
           snowhare3 :  5.17 secs   159% (0 errors)
           snowhare1 :  5.30 secs   163% (0 errors)
          saintmike1 :  6.36 secs   195% (0 errors)
                tye1 :  7.21 secs   221% (0 errors)
          saintmike2 :  7.54 secs   231% (0 errors)
               knom1 : 13.41 secs   411% (0 errors)
              strat1 : 13.41 secs   411% (0 errors)
            ikegami1 : 13.50 secs   414% (0 errors)
            jamesnc1 : 14.86 secs   456% (0 errors)
              strat2 : 15.05 secs   462% (0 errors)
          tanktalus1 : 15.49 secs   475% (0 errors)
             ph713_1 : 20.21 secs   620% (0 errors)
             davido1 : 21.96 secs   674% (0 errors)
[download]

In reply to Re^3: One out of three ain't bad by snowhare
in thread One out of three ain't bad by saintmike

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Come for the quick hacks, stay for the epiphanies.
	PerlMonks