Re: [SPOILER] Perl Quiz of the Week #23

I have two that work -- one that is perhaps the hardest way to do it and 
one that is more interesting.  Both were sped up some by halving the 
problem. The first is the answer to "what's the biggest hammer I can use on 
this nail" I originally just went through all the permutations, but that 
was too slow -- since a mirror is always balanced and the last permutation 
needed is know, it was possible to speed it up a bit:

#!/usr/local/bin/perl -w

use Algorithm::Permute;
use strict;
my $count=shift; $count++;
my ($i,$p,@a,@perm,%seen,$conq);

exit if $count <= 1;
if ($count == 2) { print "()\n"; exit; }

sub unbalanced {
         my $c = shift;
         while ($c =~ s/\(\)//og) {};
         return 1 if $c;
}

sub left {
         my $s=shift; my $l=shift;
         return substr($s,0,$l);
}

sub right {
         my $s=shift; my $l=shift;
         return substr($s,length($s)-1-$l,$l);
}

sub mirror {
   my $c = shift;
   my $new = join( "", reverse split(//, $c) ) ;
   $new =~ tr/)(/()/;
   return $new;
}    # sub mirror

sub layer {
    my $buffer = shift;
    my $levels = shift;
    my $count = $levels-$buffer;
    my $start = "("x$buffer;
    my $stop  = ")"x$buffer;
    @a=();
    push @a, ("(") x ($count-1);  push @a, (")") x ($count-1);
    my $goal= "("x$count . ")" x $count;
    if (! @a) { return; }

    $p = new Algorithm::Permute(\@a);
    @perm = $p->next;

    while (1) {
         my $set = "$start" . join("", @perm) . "$stop";
         if (! $seen{$set}) {
           my $mirror = mirror($set);
           $seen{$set} = 1;
           $seen{$mirror} = 1;
           if (! unbalanced($set)) {
                    print "$set\n";
                    print "$mirror\n" unless $set eq $mirror;
                    my $left=left($set,$buffer+1);
                    my $right=right($set,$buffer+1);
                    if (($left eq $start . "(") &&
                        ($right eq ")" . $stop)) { return; }
                   #   exit if $set eq $goal;
           }
         }
           @perm = $p->next;
    }
}

for (my $l=1; $l<=$count-3; $l++) {
         layer($l,$count);
}

___END___



The second is much faster and is similar to other "01" solutions. I broke 
the set up into halves to speed it up some. It's roughly 40% faster than 
the first go at it without splitting the string up:

#!/usr/local/bin/perl -w

use strict;
my $count=shift;
if ($count == 1) { print "()\n"; exit; }

sub unbalanced {
         my $c = shift;
         while ($c =~ s/\(\)//og) {};
         return 1 if $c;
}

sub padit {
         my $c = shift;
         my $len = shift;
         my $padstring = "%0" . "$len" . "b";
         my $out = sprintf("$padstring", $c);
         $out =~ tr/01/()/;
         return $out;
}

my $can = 2**$count-1;
my $leftlim = eval(substr('0b' . '01'x$count,0,$count+2));

while ($can > 0) {
    my $j;
    for ($j=0; $j<=$leftlim; $j++) {

         my $set = padit($j,$count) . padit($can,$count);
         if (!unbalanced($set)) {
                 print "$set\n";
         }
     }
     $can -= 2;
}

___END___




--  DCP