http://qs321.pair.com?node_id=417237

Hello fellow monks!
After a long ( and now semi permanent ) exile from computing I present a subroutine which will populate an array with all possible case permutations of a word which is supplied to it. I consider it an elegant solution to something which originally was a recursive broken monstrosity.

Recursion is evil.

sub casify
{
my @arr = ();
my $word =lc $_[0];
my $maxcombos = 2**(length $word) - 1;

foreach $n ( 0..$maxcombos )
{
# convert number from being stringified, to being a u_short, and then 
+into binary
   $_ = unpack( 'b*', pack('s',$n) );

   tr/1/_/;            # uppercase ones
   tr/0/\377/;        # leave zeros alone
   $result = "$word" & $_; # string AND
   push( @arr, $result ) ;
}

return @arr;
}

#--------------------------------------------------
# fast casify(), first arg word ref, second arg arr ref

sub casify_fast
{

foreach $n ( 0..(2**(length ${$_[0]}) - 1) )
{
# convert number from being stringified, to being a u_short, and then 
+into binary
   
   $_ = unpack( 'b*', pack('s',$n) );

   tr/10/_\377/;

   push( @{$_[1]}, ("${$_[0]}" & $_) ) ;    # string AND them, ones up
+percase the letters, zeros don't
}
return;
}

[download]

Replies are listed 'Best First'.
Re: upper-lower case combinatorics
by Aristotle (Chancellor) on Dec 24, 2004 at 02:56 UTC

    Neat trick, though it won't handle very long strings. (What's with the indentation btw?)

    Here's a non-tricky solution:

    use Set::CrossProduct;

sub casify {
    my @letters = map [ uc $_, lc $_ ], split //, $_[ 0 ];
    return(
        map join( '', @$_ ),
        Set::CrossProduct->new( \@letters )->combinations;
    );
}

    [download]

    :-) Of course, it runs much slower, in case that really is a concern…

    Makeshifts last the longest.

[reply]
[d/l]
Re: upper-lower case combinatorics
by bl0rf (Pilgrim) on Dec 24, 2004 at 21:33 UTC
    You're definitely right, I completely forgot that it won't handle anything longer than a u_short. I was using this code on a dictionary where words are not that long, but there are many words longer than 16 chars - therefore it didn't do what I intended it to do in "production"....
    As for the unprettyness of the code - I ripped it out of a program, those "eureka" moments sure make me forget about style :-)

    Humble site of mine
[reply]

Back to Cool Uses for Perl