So I'm working on a crossword puzzle, and I have two partial words that intersect and I have no idea what they are. Perl to the rescue! give it two regular expressions, the lengths of the two words and on what char of each word they intersect and it gives you a set of results out of your local dictionary file. 
#!/usr/bin/perl
$|++;
open IN, "joshWordList.txt";
@words = <IN>;
close IN;
my $re = qr($ARGV[0]);
my $re2 = qr($ARGV[2]);
my $len = $ARGV[1];
my $len2 = $ARGV[3];
my @intersect = split /,/,$ARGV[4];
print "look for $ARGV[0] with length $len\nCROSS $ARGV[2] with length 
+$len2\nAT $ARGV[4]\n";
for (@words) {
    chomp;
    if (/$re/ && length($_) == $len) {
        push @word1,$_;
        print "FOUND WORD 1: $_\n";
    }
    if (/$re2/ && length($_) == $len2) {
        push @word2,$_;
        print "FOUND WORD 2: $_\n";
    }
}
for (@word1,@word2) { print "$_\n" }

for $w1 (@word1) {
    @w = split //,$w1;
    $l1 = $w[$intersect[0]-1];
    for $w2 (@word2) {
        @w2 = split //,$w2;
        $l2 = $w2[$intersect[1]-1];
        print "$w1 and $w2\n" if $l2 eq $l1;
    }
}

[download]

Replies are listed 'Best First'.
Re: Crossword puzzles
by Aristotle (Chancellor) on Dec 21, 2004 at 09:41 UTC

    Slurping seems unnecessary here.

    Your conditionals would be more efficient if you tested for the length first and applied the regex second.

    Your letter extraction is awkward. First of all you don't need the temporary arrays:

    $l1 = ( split //, $w1 )[ $intersect[ 0 ] - 1 ];

    [download]

    But what you really want to do is use the right tool for the job.

    $l1 = substr $w1, $intersect[ 0 ] - 1, 1;

    [download]

    You could save a fair deal of effort by extracting the intersection letter in the first loop and sticking the word in a hash of arrays instead of just pushing it into a list.

    #!/usr/bin/perl
use strict;
use warnings;

my $re1   = qr($ARGV[0]);
my $len1  = $ARGV[1];
my $re2   = qr($ARGV[2]);
my $len2  = $ARGV[3];
my $offs1 = $ARGV[4] - 1;
my $offs2 = $ARGV[5] - 1;

my( %word1, %word2 );

open my $fh, '<', 'joshWordList.txt';

while( <$fh> ) {
    chomp;
    $_ = lc $_;
    if( length( $_ ) == $len1 and /$re1/ ) {
        my $letter = substr $_, $offs1, 1;
        push @{ $word1{ $letter } }, $_;
    }
    if( length( $_ ) == $len2 and /$re2/ ) {
        my $letter = substr $_, $offsr2, 1;
        push @{ $word2{ $letter } }, $_;
    }
}

close $fh;

for my $letter ( keys %word1 ) {
    next if not exists $word2{ $letter };
    print "Any of\n", map "\t$_\n", @{ $word1{ $letter } };
    print "combined with any of\n", map "\t$_\n", @{ $word2{ $letter }
+ };
}

    [download]

    The command line interface could still be more convenient, but I don't have any good ideas on that right now.

    Makeshifts last the longest.

[reply]
[d/l]
[select]

Back to Cool Uses for Perl