User:TotoBaggins/find words.pl


 * 1) !/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/ } ; $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 () {   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