dash2 has asked for the wisdom of the Perl Monks concerning the following question:
Here's one I came up against on the weekend.
I have an object representing part of a space of N dimensions. This object has neighbours (e.g. if N is 1, it has 8 neighbours:
NNN
N*N
NNN
Now I need to get the co-ordinates of all my neighbours, assuming I have my own co-ordinates.
This seems to require setting up N nested for loops, each of them going for(-1,0,1){}. I couldn't think of an elegant way to do this, perhaps because I don't have a formal CS background.
In the end I produced a hack. NB, to understand this, you must realise that I only wanted my neighbours nearer the origin. Otherwise the hack would not have worked.
my $possibilities = 2 ** $N; # $N is number of dimensions
# @mypos is my coordinates.
for (1 .. $possibilities) { # using 0 would return my own position
my $binary = sprintf '%b', $_;
my $pad= '0' x ($N - length $binary);
$binary = $pad.$binary;
my @shift = split //, $binary;
my @pos = map {$mypos[$_] - $shift[$_]} 0 .. $#mypos;
push @neighbours, \@pos;
}
This is neat but fundamentally evil, and I wondered if someone had a better solution. (Recursion?)
dave hj~
(tye)Re: getting my neighbours in an N-dimensional space
by tye (Sage) on Jan 21, 2002 at 20:42 UTC
|
This version creates a closure that counts in base 3 using "digits" -1, 0, and 1, returning the next neighbor each time it is called. It returns "us" as one of our neighbors.
#!/usr/bin/perl -w
use strict;
use mapcar;
sub neighbors {
my @coords= @_;
my @offset= (-1) x @coords;
return sub {
my $i= 0;
return if ! @coords;
my @return= mapcar { $_[0] + $_[1] } \@coords, \@offset;
while( 1 < ++$offset[$i] ) {
$offset[$i]= -1;
if( $#offset < ++$i ) {
@offset= @coords= ();
last;
}
}
return @return;
};
}
my $next= neighbors( 6, 2, -4 );
my @coords;
while( @coords= $next->() ) {
print "( @coords )\n";
}
produces:
( 5 1 -5 )
( 6 1 -5 )
( 7 1 -5 )
( 5 2 -5 )
( 6 2 -5 )
( 7 2 -5 )
( 5 3 -5 )
( 6 3 -5 )
( 7 3 -5 )
( 5 1 -4 )
( 6 1 -4 )
( 7 1 -4 )
( 5 2 -4 )
( 6 2 -4 )
( 7 2 -4 )
( 5 3 -4 )
( 6 3 -4 )
( 7 3 -4 )
( 5 1 -3 )
( 6 1 -3 )
( 7 1 -3 )
( 5 2 -3 )
( 6 2 -3 )
( 7 2 -3 )
( 5 3 -3 )
( 6 3 -3 )
( 7 3 -3 )
This was based on (tye)Re: Finding all Combinations and requires mapcar.
-
tye
(but my friends call me "Tye") | [reply] [Watch: Dir/Any] [d/l] [select] |
|
Oh well done! This is exactly what I was waffling on about. Except that as it stands, your code returns the point of origin, and the origin can't be a neighbour of itself.
--g r i n d e r
print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u';
| [reply] [Watch: Dir/Any] |
|
#!/usr/bin/perl -w
use strict;
use mapcar;
sub neighbors {
my @coords= @_;
my @digits= ( 0, -1, 1 );
my @offset= (0) x @coords;
return sub {
my $i= 0;
while( 2 < ++$offset[$i] ) {
$offset[$i]= 0;
return if $#offset < ++$i;
}
return mapcar { $_[0] + $digits[$_[1]] }
\@coords, \@offset;
};
}
my $next= neighbors( 6, 2, -4 );
my @coords;
while( @coords= $next->() ) {
print "( @coords )\n";
}
-
tye
(but my friends call me "Tye") | [reply] [Watch: Dir/Any] [d/l] |
Re: getting my neighbours in an N-dimensional space
by Masem (Monsignor) on Jan 21, 2002 at 21:04 UTC
|
Hmmm, tye's solution provides insight to another:
# You might already have this type of function available.
# If not, it's needed for the next part:
sub same_coord
{
my ($aref, $bref) = @_;
my @acoord = @$aref;
my @bcoord = @$bref;
return 0 if ( scalar @acoord != scalar @bcoord );
foreach my $i ( 0..$#accord ) {
return 0 if ( $acoord[$i] != $bcoord[$i] );
}
return 1;
}
sub get_neighbors {
my @coord = @_;
my @n = ( [] );
foreach my $i ( 0..$#coord ) {
@n = map { @left = @$_;
map { [ @left, $_ ] } ( $coord[$i]-1..$coord[$i]+1)
} @n;
}
@n = grep { !same_coord( \@coord, $_ ) } @n;
return @n;
}
-----------------------------------------------------
Dr. Michael K. Neylon - mneylon-pm@masemware.com
||
"You've left the lens cap of your mind on again, Pinky" - The Brain
"I can see my house from here!"
It's not what you know, but knowing how to find it if you don't know that's important
| [reply] [Watch: Dir/Any] [d/l] |
|
| [reply] [Watch: Dir/Any] |
|
| [reply] [Watch: Dir/Any] |
|
As one of your later posts implies you wanted points strictly closer to the origin, here's a quick function that helps to do that:
sub closer_to_origin {
my ( $start, $test ) = @_;
my $sd = 0; $sd += $_*$_ foreach (@$start);
my $td = 0; $td += $_*$_ foreach (@$test);
return ( $td < $sd );
}
Thus, in my original code block, where I have the grep, you can simply do:
my @closer_ns = grep { closer_to_origin( \@point, $_ ) } @n;
to get the closer neighbors. That routine basically calculates the distance from the point in question to the origin via the general distance formula, though without the final, expensive, square root as it's not necessary for magnitude comparison. This also blocks the original point from showing up (strictly closer, not same-or-closer distance) I'm sure that you can also modify tye's closure routine to include this check such that farther points don't pop up from each iteration loop.
-----------------------------------------------------
Dr. Michael K. Neylon - mneylon-pm@masemware.com
||
"You've left the lens cap of your mind on again, Pinky" - The Brain
"I can see my house from here!"
It's not what you know, but knowing how to find it if you don't know that's important
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re: getting my neighbours in an N-dimensional space
by grinder (Bishop) on Jan 21, 2002 at 20:55 UTC
|
I've had a quick browse through CPAN to see whether there's a module that will save me from having to write the code, but I can't find anything suitable. Maybe from my description someone will be able to point you to something.
Your problem boils down to enumerating all the different combination of (-1, 0, 1) for each dimension, except that you need to omit (0, 0, 0, 0).
That is, for 4 dimensions, you want to iterate from (-1, -1, -1, -1), (-1, -1, -1, 0), (-1, -1, -1, 1), (-1, -1, 0, -1) ... all the way to (1, 1, 1, 1).
Dominus is covering this sort of stuff in a book he is writing on advanced techniques in Perl. He describes a (relatively) simple method of doing this using closures, rather than using recursion. I can't point you directly to the web page, but if you consult his home node you'll find out how to get there.
Thinking about this, and refreshing my mind about what Dominus wrote concerning iterators, the following code does the trick (without using mapcar :). Although skipping over the origin is a bit of an ugly hack. Improvements welcomed.
#! /usr/bin/perl -w
use strict;
sub neighbourhood {
my $dim = shift;
my @current = (-1) x $dim;
my $done = 0;
return sub {
return if $done;
my @res = @current;
my $i;
ITER: for ($i = 0; $i < scalar @current; ++$i) {
if (++$current[$i] > 1 ) {
$current[$i] = -1;
} else {
my $not_origin = 0;
($current[$_] != 0 and $not_origin = 1)
for @current;
redo ITER unless $not_origin;
last;
}
}
$done = 1 if $i >= scalar @current;
return @res;
}
}
my $iter = neighbourhood( shift || 3 );
while( my @iter = $iter->() ) {
print "@iter\n";
}
Hmm, since everyone else appears to be returning values based on the origin, I guess I should do so too. It is a simple enough matter (and will be more so in Perl 6, when @res ^+= @origin is legal).
#! /usr/bin/perl -w
use strict;
sub neighbourhood {
my @origin = @_;
my $dim = scalar @origin;
my @current = (-1) x $dim;
my $done = 0;
return sub {
return if $done;
my @res = @current;
my $i;
for ($i = 0; $i < scalar @current; ++$i) {
$res[$i] += $origin[$i];
}
ITER: for ($i = 0; $i < scalar @current; ++$i) {
if (++$current[$i] > 1 ) {
$current[$i] = -1;
} else {
my $not_origin = 0;
($current[$_] != 0 and $not_origin = 1)
for @current;
redo ITER unless $not_origin;
last;
}
}
$done = 1 if $i >= scalar @current;
return @res;
}
}
@ARGV = (6, 2, -4) unless @ARGV;
my $iter = neighbourhood( @ARGV );
while( my @iter = $iter->() ) {
print "@iter\n";
}
--g r i n d e r
print@_{sort keys %_},$/if%_=split//,'= & *a?b:e\f/h^h!j+n,o@o;r$s-t%t#u';
| [reply] [Watch: Dir/Any] [d/l] [select] |
Re (tilly) 1: getting my neighbours in an N-dimensional space
by tilly (Archbishop) on Jan 21, 2002 at 21:52 UTC
|
The basic closure solutions have already been given, so I
will use a bad glob trick. Prior to 5.6 this is OS
specific.
sub neighbours {
my $str = join ":", map {"{".($_-1).",$_,".($_+1)."}"}@_;
my $not_wanted = join ":", @_;
grep {$not_wanted ne $_} glob($str);
}
print map "$_\n", neighbours(2,3,4);
| [reply] [Watch: Dir/Any] [d/l] |
Re: getting my neighbours in an N-dimensional space
by toma (Vicar) on Jan 22, 2002 at 07:32 UTC
|
You mention that you need all the neighbors. If
you really need the nearest neighbors, this answer
might be interesting.
Finding nearest neighbors is a classic problem in
the field of
computational geometry.
There are algorithms to create a data structure
that enables the nearest neighbors to be found
very quickly.
A simple example is to find the closest pair of points
in a plane. The slow way is to measure the distance
between each of the points and find which is smallest.
This requires (N*N-N)/2 distance comparisons, where
N is the number of points. The fast way is to compute
a particular type of triangular mesh to join the points.
The closest pair will be linked by one of the edges of
the triangles.
While there is some extra computing for creating the mesh,
this algorithm is still a big win.
If you need this type of fast algorithm, look at
the home page for Qhull.
In particular, you need
the Voronoi object.
The Qhull page says that it has been used for at least
eight dimensional analysis.
It should work perfectly the first time! - toma
msg me if this is not clear or if you would like
more information on this topic. | [reply] [Watch: Dir/Any] |
(cLive ;-) Re: getting my neighbours in an N-dimensional space
by cLive ;-) (Prior) on Jan 22, 2002 at 12:44 UTC
|
Just because it fits, doesn't mean it's true:
my $possibilities = 2 ** $N; # $N is number of dimensions
Nope! yes, it's true for $N=1. But look at your example. When $N=2, neighbors = 8. But, your equation says 3 dimensions has 8 neighbors - and Zero dimensions would have 1!
my $possibilities = (3 ** $N) - 1;
Think of the 3D example - 3 x 3 x 3 (- one in the middle)
.02
cLive ;-)
Or I could just be completely wrong coz I'm too tired to read through the other replies :) | [reply] [Watch: Dir/Any] [d/l] [select] |
|
Not quite. Remember, I was only looking for neighbours nearer the origin:
0
NN
N*
So it is 2, not 3, because you only have (0,-1) not (1,0,-1).
That's why the "binary number" hack would work. And the was taken care of by doing for (1 .. not for (0 ...
dave hj~ | [reply] [Watch: Dir/Any] [d/l] [select] |
|
- 2 neighbors
- 8 neighbors
- 26 neighbors
- 80 neighbors
That's for all neighbors. As for neighbors near the origin ... that's a completely different set of numbers. And, in 3-D, it's not (2**N - 1). It's some weirder formula.
------ We are the carpenters and bricklayers of the Information Age. Don't go borrowing trouble. For programmers, this means Worry only about what you need to implement.
| [reply] [Watch: Dir/Any] |
Re: getting my neighbours in an N-dimensional space
by Anonymous Monk on Jan 22, 2002 at 15:18 UTC
|
The solutions already given are very compact and it seems to me that this is cluttering and obscuring a nice solution. As a matter of fact, I don't really understand the solutions given. (So that's my problem you say.)
So I come up with an other solution, which to my is much clearer. This is it:
#! /usr/local/bin/perl
@coord = ( 6, 2, -4 );
$dim = scalar ( @coord );
@trans = map { $_ - 1 } @coord;
for ( $i = 0; $i < 3**$dim; $i++ ) {
@vector = vector ( $i );
@add = add_vector ( \@trans, \@vector );
print "[@add]\n" unless center ( @vector );
}
sub vector {
my $i = shift @_;
my @vector;
for ( my $j=0; $j < $dim; $j++ ) {
push ( @vector, $i % 3 );
$i = int $i/3;
}
return @vector;
}
sub add_vector {
my $ar_ref1 = shift @_;
my $ar_ref2 = shift @_;
my @vector;
for ( my $j=0; $j < $dim; $j++ ) {
push ( @vector, $$ar_ref1[$j] + $$ar_ref2[$j] );
}
return @vector;
}
sub center {
my @vector = @_;
my $bool = 1;
my $i = 0;
while ( $bool and $i < $dim ) {
$bool = ( $vector[$i++] == 1 );
}
return $bool;
}
with the given coordinates it produces the following output
[5 1 -5]
[6 1 -5]
[7 1 -5]
[5 2 -5]
[6 2 -5]
[7 2 -5]
[5 3 -5]
[6 3 -5]
[7 3 -5]
[5 1 -4]
[6 1 -4]
[7 1 -4]
[5 2 -4]
[7 2 -4]
[5 3 -4]
[6 3 -4]
[7 3 -4]
[5 1 -3]
[6 1 -3]
[7 1 -3]
[5 2 -3]
[6 2 -3]
[7 2 -3]
[5 3 -3]
[6 3 -3]
[7 3 -3]
I am not going to explain my code and the idea's I used to create it. (It would be rather lengthy). The variables and subroutines I use suggest the underlying mechanisme.
But if my code is as obscure to you as the others solutions are to my, please comment on the reply and I will try to explain it!
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
|