in reply to Combinatorics in Perl

Well, you can get all fancy with recursive solutions, but if I were your teacher, I'd give the most credit to a solution that merely counts from 0 to 7 and uses the bit pattern to decide which things to include and which things to leave out. That's an algorithm you could probably get someone else to understand and maintain.

Replies are listed 'Best First'.
Re^2: Combinatorics in Perl
by tkil (Monk) on May 01, 2004 at 09:02 UTC
    I find your lack of faith (in recursion) ...disturbing.

    With a bit more documentation, recursion or regular expressions are perfectly maintainable. I'll plead guilty to under-documenting my original response; one of the reasons I tucked it into a /x construct was to be able to add comments later.

    I'll note that you didn't post any code, though. I'd be curious to see your solution. Here are various of mine; which do you yourself think is most maintainable?

    #!/usr/bin/perl use strict; use warnings; sub int_1 ( $ ) { my $template = shift; # split template on the characters to switch in and out my @chunks = split /(\s*\S+)_DEL/, $template; # make sure the odd elements are the switched chars. unshift @chunks, '' if $template =~ /^\S+_DEL\b/; # check for boundary conditions my $n_toggles = int( @chunks / 2 ); if ( !$n_toggles ) { return $template; } elsif ( $n_toggles > 10 ) { die "max of 10 toggles (found $n_toggles) in '$template'"; } my @rv; my $n_bits = ( 1 << $n_toggles ) - 1; foreach my $bits ( 0 .. $n_bits ) { my $s = ''; for ( my $i = 0; $i < @chunks; $i += 2 ) { $s .= $chunks[$i]; $s .= $chunks[$i+1] if $bits & 1; $bits >>= 1; } push @rv, $s; } return @rv; } my $MAX_BIT = 0x10000; my $ALL_BITS = $MAX_BIT - 1; sub int_2 ( $ ) { my $template = shift; # split template on the phonemes to switch in and out my @chunks = split /(\s*\S+_DEL)/, $template; # mark which are toggles my @toggles; my $next_bit = 1; foreach ( @chunks ) { if ( s/_DEL$// ) { push @toggles, $next_bit; $next_bit <<= 1; die "too many toggles!" if $next_bit > $MAX_BIT; } else { push @toggles, $ALL_BITS; } } # anything to do? return $template if $next_bit == 1; my @rv; foreach my $bits ( 1 .. $next_bit ) { my $s = ''; for my $i ( 0 .. $#chunks ) { $s .= $chunks[$i] if $bits & $toggles[$i]; } push @rv, $s; } return @rv; } sub int_3 ( $ ) { my $template = shift; # split template on the phonemes to switch in and out my @chunks = split /(\s*\S+_DEL)/, $template; # mark which are toggles my $next_bit = 1; foreach ( @chunks ) { if ( s/_DEL$// ) { $_ = [ $next_bit, $_ ]; $next_bit <<= 1; die "too many toggles!" if $next_bit > $MAX_BIT; } else { $_ = [ $ALL_BITS, $_ ]; } } # anything to do? return $template if $next_bit == 1; my @rv; foreach my $bits ( 1 .. $next_bit ) { push @rv, join '', map { $_->[0] & $bits ? $_->[1] : '' } @chu +nks; } return @rv; } sub re_1 ( $ ) { my @templates = @_; # yet another variant on the repeat-and-double-until-done while # loop. while (1) { my @new_templates; foreach ( @templates ) { if ( m/(.*?)(\s*\S)_DEL(.*)/ ) { push @new_templates, $1.$2.$3, $1.$3; } } return @templates unless @new_templates; @templates = @new_templates; } } sub re_2 ( $ ) { my $template = shift; # make sure it ends with exactly one newline $template =~ s/\s*$/\n/; # make all the breaks unique: { my $i = 0; $template =~ s/(_DEL\b)/$1 . ++$i/ge; } # for each break, replace template with two copies of itself, one # with the replacement, one without: while ( $template =~ /((\s*\S+)_DEL(\d+)\b)/ ) { my ( $break, $rep ) = ( $1, $2 ); my ( $with, $without ) = ( $template ) x 2; $with =~ s/\Q$break/$rep/g; $without =~ s/\Q$break//g; $template = $with . $without; } # break back into individual chunks. (trailing \n should be # handled gracefully.) return split /\n/, $template; } sub re_3 ( $ ) { my $template = shift; # basic idea is to find every line with a blah_DEL in it, then # replace that line with two lines: one with "blah" inserted, one # without. Since there can be multiple _DEL directives per line, # we need to iterate until they're all gone. do {} while $template =~ s{ ^ (.*?) (\s* \S+)_DEL\b (.*) $ } {$1$3\n$1$2$3}xmg; # break back into individual chunks. (trailing \n should be # handled gracefully.) return split /\n/, $template; } while ( my $template = <DATA> ) { $template =~ s/\s+$//; print "=== template:\n$template\n"; print "--- int_1:\n", map "$_\n", int_1 $template; print "--- int_2:\n", map "$_\n", int_2 $template; print "--- int_3:\n", map "$_\n", int_3 $template; print "--- re_1:\n", map "$_\n", re_1 $template; print "--- re_2:\n", map "$_\n", re_2 $template; print "--- re_3:\n", map "$_\n", re_3 $template; } exit 0; __DATA__ ch i_DEL ts a k u_DEL s i_DEL #