User:TotoBaggins/find words.pl

#!/usr/bin/perl -w

use Data::Dumper;
use strict;

our @GRID;
our $NUM_COLS;
our $NUM_ROWS;
our $BOTTOM_ROW;
our $RIGHT_COLUMN;

sub four_connected_line
{
    my ($row, $col, $row_step, $col_step) = @_;

    my $word = '';
    while (   $row >= 0 && $row <= $BOTTOM_ROW
           && $col >= 0 && $col <= $RIGHT_COLUMN)
    {
        $word .= $GRID[$row]->[$col];
        $row += $row_step;
        $col += $col_step;
    }
    return $word;
}

sub get_lines
{
    my %steps = (
        WE => [  0, 1  ],
        SE => [  1, 1  ],
        NE => [ -1, 1  ],
        NS => [  1, 0  ],
        SE => [  1, 1  ],
        SW => [  1, -1 ],
    );
    my @lines;
    foreach my $dir (qw(WE SE NE))
    {
        foreach my $row (0 .. $BOTTOM_ROW)
        {
            next if $row == 0           && $dir eq 'NE';
            next if $row == $BOTTOM_ROW && $dir eq 'SE';
            push @lines, four_connected_line($row, 0, @{$steps{$dir}});
        }
    }
    foreach my $dir (qw(NS SE))
    {
        foreach my $col (0 .. $RIGHT_COLUMN)
        {
            next if ($col == 0 || $col == $RIGHT_COLUMN) && $dir eq 'SE';
            push @lines, four_connected_line(0, $col, @{$steps{$dir}});
        }
    }
    foreach my $dir (qw(SW))
    {
        foreach my $row (1 .. $BOTTOM_ROW - 1)
        {
            push @lines, four_connected_line($row, $RIGHT_COLUMN, @{$steps{$dir}});
        }
    }
    return @lines;
}

sub get_length_perms
{
    my $word = shift;
    my @words;
    my $length = length $word;
    foreach my $start (0 .. $length - 1)
    {
        foreach my $seglen (1 .. $length - $start)
        {
            push @words, substr $word, $start, $seglen;
        }
    }
    return @words;
}

sub get_perms
{
    my $word = shift;
    my @len_perms = get_length_perms($word);
    my @reverse_perms = map { scalar reverse } grep { length > 1 } @len_perms;
    return @len_perms, @reverse_perms;
}

@GRID = map { [ split ] } map { split /\n/ } <DATA>;
$NUM_COLS = @{$GRID[0]};
$NUM_ROWS = $NUM_COLS;
$BOTTOM_ROW = $NUM_ROWS - 1;
$RIGHT_COLUMN = $NUM_COLS - 1;

my %dict;
die "pipe in your dictionary\n" if -t;
while (<STDIN>)
{
    chomp;
    $dict{lc $_}++;
}


my %printed;
foreach my $line (get_lines())
{
    foreach my $perm (get_perms($line))
    {
        print "$perm\n" if $dict{$perm} && ! $printed{$perm}++;
    }
}

__DATA__
    h e r e
    e d r h
    i a o x
    p n a g