laziness, impatience, and hubris PerlMonks

### Re: Re: Competition fuels obsession over Perl

by Roger (Parson)
 on Feb 19, 2004 at 07:34 UTC ( #330163=note: print w/replies, xml ) Need Help??

in reply to Re: Competition fuels obsession over Perl
in thread Competition fuels obsession over Perl

Let me give round one a try... There must be a better way of doing this...
use strict; use warnings; use Algorithm::Loops qw/ NestedLoops /; use Data::Dumper; my @patterns = ( [ 0, 1, 2 ], [ 0, 3, 6 ], [ 0, 4, 8 ], [ 1, 4, 7 ], [ 2, 5, 8 ], [ 2, 4, 6 ], [ 3, 4, 5 ], [ 6, 7, 8 ], ); while (<DATA>) { chomp(my @input = split /\s+/, \$_); my @combinations = (); NestedLoops([ [@input], ( sub { my %used; @used{@_}= (1) x @_; return [ grep !\$used{\$_}, @input ]; } ) x (2), ], sub { push @combinations, [ @_ ]; return 1; }); my @output = map { Validate(\@input, \$_) ? \$_ : () } @combinations +; print "@input:\n", @output ? Dumper(\@output) : "Not possible", "\ +n\n"; } sub Validate { my (\$input, \$c) = @_; my %p = map { \$_ => 1 } @\$c; my @diff = map { \$p{\$_} ? () : \$_ } @\$input; foreach (@diff) { return 0 if !Canfit(\$c, \$_); } return 1 } sub Canfit { my (\$c, \$e) = @_; my @l = map { split //, \$_ } @\$c; foreach (@patterns) { my \$text = join '', @l[ @\$_ ]; return 1 if \$text eq \$e || \$text eq reverse \$e; } return 0; } __DATA__ tan are nan tom men ora tan are soo and hen oar tom soo san sop hen ora

Output:
tan are nan tom men ora: \$VAR1 = [ [ 'tan', 'ora', 'men' ], [ 'tom', 'are', 'nan' ] ]; tan are soo and hen oar: Not possible tom soo san sop hen ora: Not possible

Create A New User
Node Status?
node history
Node Type: note [id://330163]
help
Chatterbox?
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others pondering the Monastery: (16)
As of 2017-07-26 13:40 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
I came, I saw, I ...

Results (395 votes). Check out past polls.