in reply to (Golf) The Perl Boggles
I didn't bother using the prepare_boggle_search() function. Also, I wasn't sure if creating extra functions was allowed, so I used iteration rather than recursion (which would have been more natural). This solution also is able to use the same letter more than once, but not consecutively (which was expressly forbidden). I hope that's okay. And for bonus points, it should work for any Boggle board of size NxN.sub test_boggle_word { ($w,$n,@b)=@_;for(@b){push@{$h{$_}},$x++}@c=split'',$w;for(@c){return +0if!$h{$_}}@l=map{$h{$_}}@c;$c=-1;$i=-1;my@t;I:while(1){$j=$i+1;$t[$j +]=@t>$j?$t[$j]+1:0;while($t[$j]<@{$l[$j]}){$t=$l[$j][$t[$j]];$a=$t;$b +=$c;($a,$b)=($b,$a)if($a>$b);if($a==-1||($b-$a==1&&$b%$n>0)||($b-$a== +$n-1&&$a%$n>0)||$b-$a==$n||($b-$a==$n+1&&$b%$n>0)){return 1if$i==@l-2 +;++$i;$c=$t;next I}++$t[$j]}--$i;pop@t;lastif$i<-1;$c=$i==-1?-1:$l[$i +][$t[$i]]} }
It's extremely hard to read all smushed up like that, so here's a little bit nicer version:
Any thoughts?sub test_boggle_word { ($w,$n,@b)=@_; for(@b){push@{$h{$_}},$x++} @c=split'',$w; for(@c){return 0 if!$h{$_}} @l=map{$h{$_}}@c; $c=-1; $i=-1; my@t; I:while(1){ $j=$i+1; $t[$j]=@t>$j?$t[$j]+1:0; while($t[$j]<@{$l[$j]}){ $t=$l[$j][$t[$j]]; $a=$t; $b=$c; ($a,$b)=($b,$a)if($a>$b); if($a==-1||($b-$a==1&&$b%$n>0)||($b-$a==$n-1&&$a%$n>0)|| $b-$a==$n||($b-$a==$n+1&&$b%$n>0)){ return 1 if$i==@l-2; ++$i; $c=$t; next I } ++$t[$j] } --$i; pop@t; last if$i<-1; $c=$i==-1?-1:$l[$i][$t[$i]] } }
|
|---|