Keep It Simple, Stupid PerlMonks

### Re: perl array matrix

by choroba (Cardinal)
 on Apr 13, 2015 at 12:56 UTC Need Help??

in reply to perl array matrix

One possible solution:
1. Start at the first number from the input list.
2. Create two lists: list of visited numbers, and list of the matrix positions to visit.
3. Mark the current number as visited at the current position. If you visited all the input numbers, return true.
4. Check all the neighbouring positions, non-visited ones present in the input list should go to the list of positions to visit.
5. Visit the first position from the list, go to #3.
6. If the list is empty, try starting with the next input number (this is needed, as numbers could be repeated, e.g. 2 in your sample). Go to #2.
7. You tried all the input numbers, but you can't reach all the rest from any of them. Return false.

Which translates easily to Perl:

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

my @matrix = ( [ 1,  2,  3,  4],
[ 5,  6,  7,  8],
[ 9, 10, 11, 12],
[13, 14,  3, 16],
[ 2, 18, 19, 20],
);

sub nearby {
my @input = @_;
my %numbers;
undef @numbers{@input};

for my \$y (0 .. \$#matrix) {
for my \$x (0 .. \$#{ \$matrix[\$y] }) {
next unless exists \$numbers{ \$matrix[\$y][\$x] };

my @next = ([\$x, \$y]);
my %visited;
while (@next) {
my (\$r, \$s) = @{ shift @next };
undef \$visited{ \$matrix[\$s][\$r] }{"\$r \$s"};
return 1 if keys %visited == keys %numbers;

push @next, grep \$_->[0] >= 0 && \$_->[1] >= 0
&& \$_->[0] <= \$#{ \$matrix[\$s] } && \$_->[1]
+ <= \$#matrix
&& exists \$numbers{ \$matrix[ \$_->[1] ][ \$_
+->[0] ] }
&& ! exists \$visited{ \$matrix[ \$_->[1] ][
+\$_->[0] ] }{"@\$_"},
[\$r - 1, \$s - 1],
[\$r,     \$s - 1],
[\$r + 1, \$s - 1],
[\$r + 1, \$s    ],
[\$r + 1, \$s + 1],
[\$r,     \$s + 1],
[\$r - 1, \$s + 1],
[\$r - 1, \$s    ];
# warn map "<@\$_>", @next;
}
}
}
return
}

use Test::More;

ok(nearby(2, 7, 12, 16));
ok(nearby(2, 4, 7, 12));
ok(! nearby(1, 6, 8, 12));
ok(! nearby(1, 5, 14, 15));

# Unspecified?
ok(nearby(2, 13, 9, 5, 7));
ok(! nearby(2, 13, 7));
ok(nearby(6, 3, 8, 12, 18));

@matrix = ( [ 1,  1,  1,  1, 2],
[ 1,  0,  0,  0, 0],
[ 1,  0,  1,  1, 3],
[ 1,  0,  1,  0, 0],
[ 1,  0,  1,  1, 1],
[ 1,  0,  0,  0, 1],
[ 1,  1,  1,  1, 1],
);
ok(nearby(1, 2, 3));

done_testing();

Update: It's unclear how to handle duplicate numbers. The code returns true for the last case, but did you really want to use 1 several times? Please, clarify your specification.

Update 2: added positions to visited numbers.

لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ

Replies are listed 'Best First'.
Re^2: perl array matrix
by perlhelp (Initiate) on Apr 15, 2015 at 03:41 UTC
How to avoid the duplicated numbers. I run into trouble if so many position x,y return from the sub. it there any way to check the closerx,y. in order to filter out ? Thanks
Re^2: perl array matrix
by perlhelp (Initiate) on Apr 15, 2015 at 12:43 UTC
How to convert the following concept into the code:

1. Create a mapping from numbers to start positions: Hash of Number to Array of Position.

2. Create a neighbor mapping for all positions: Hash of Position to (Hash of Number to Array of Position) -- or just Hash of Number to Position if you can only have one neighbor with that number.

3. For each search string: initialize position possibilities to the array returned by the start mapping.

Iterate through remaining numbers, getting next position set from the neighbor mapping for the possibilities.

If you have no position possibilities left, it's not a match.

I'm sorry I don't understand. Could you please reword, give some examples, draw pictures?
لսႽ† ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ
Re^2: perl array matrix
by perlhelp (Initiate) on Apr 13, 2015 at 15:01 UTC
Wow wow wow, Nice code + explanation. Thanks choroba THE PERL EXPERT.

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1123267]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others making s'mores by the fire in the courtyard of the Monastery: (3)
As of 2024-07-22 11:35 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?

No recent polls found

Notices?
 • erzuuli ‥ 🛈The London Perl and Raku Workshop takes place on 26th Oct 2024. If your company depends on Perl, please consider sponsoring and/or attending.