Willard B. Trophy has asked for the wisdom of the Perl Monks concerning the following question:
Despite what I said in 341327, I find myself prototyping in Perl. Fortran's still too weird (again).
I've got a grid of values, a tiny trivial example being:
P P B R B
P R B B B
B R R R B
B R R R B
B G G B B
(For the interested, these are terrain "clutter" (roughness) maps from satellite survey, as managed by Golden Software's Surfer mapping package.)
Unfortunately, the industry standard package WaSP doesn't accept grid input, but needs the locations of the boundaries where terrain types change, something like (with values):
P P|B|R|B
+-+ +-+
P|R|B B B
-+ +---+
B|R R R|B
| |
B|R R R|B
+---+-+
B|G G|B B
or maybe clearer without the cell values, just showing boundaries:
| | |
+-+ +-+
| |
-+ +---+
| |
| |
| |
+---+-+
| |
This looks to me like a multicolour version of Moore Neighbourhood Tracing. I've bounced some ideas around the office, but implementing them has proved problematic.
I probably haven't defined the problem very well, but ... how would you go about designing a routine to solve this?
UPDATE: Many thanks to all who responded. I should maybe have been a little less figurative with the ASCII art; it was the actual roughness contour lines I was after, though I'm sure I could write an ASCII to vector converter.
-- bowling trophy thieves, die!
Re: Map grid to boundary conversion algorithm
by kvale (Monsignor) on Apr 16, 2004 at 16:04 UTC
|
Here is a solution to the problem:
# read in matrix
while (<DATA>) {
next if /^\s*$/;
push @r, [split];
}
# find the boundaries
for my $r (0..@r-1) {
for my $c (0..@{$r[0]}-2) {
$vert[$r][$c] = $r[$r][$c] ne $r[$r][$c+1] ? 1 : 0;
}
}
for my $r (0..@r-2) {
for my $c (0..@{$r[0]}-1) {
$horz[$r][$c] = $r[$r][$c] ne $r[$r+1][$c] ? 1 : 0;
}
}
for my $r (0..@r-2) {
for my $c (0..@{$r[0]}-2) {
$cross[$r][$c] = $vert[$r][$c] + $vert[$r+1][$c]
+ $horz[$r][$c] + $horz[$r][$c+1] > 1 ? 1 : 0;
}
}
# Print it out
for my $r (0..@r-1) {
for my $c (0..@{$r[0]}-1) {
print $r[$r][$c];
print $vert[$r][$c] ? '|' : ' ' if $c < @{$r[0]}-1;
}
print "\n";
next unless $r < @r-1;
for my $c (0..@{$r[0]}-1) {
print $horz[$r][$c] ? '-' : ' ' ;
print $cross[$r][$c] ? '+' : ' ' if $c < @{$r[0]}-1;
}
print "\n";
}
__DATA__
P P B R B
P R B B B
B R R R B
B R R R B
B G G B B
I have simplified the printing to just put a cross at all intersections, you can easily generalize to vertical and horizontal connections, etc. I'll leave the conversion to Fortran 1-based matrices to you :-)
Update: If efficiency is a concern, the three passes to find the boundary can be combined into one with a little extra logic. For large matrices, this change may blow the cache fewer times.
| [reply] [d/l] |
|
#!/usr/bin/perl;
use strict;
use warnings;
my @grid = (
[qw(P P B R B)],
[qw(P R B B B)],
[qw(B R R R B)],
[qw(B R R R B)],
[qw(B G G B B)],
);
$" = '';
my @new;
# pass 1
for my $row(0..$#grid) {
my $last = $grid[$row][0];
push @{$new[$row*2]}, $grid[$row][0];
for my $pt(0..$#{$grid[$row]}) {
next if $pt == 0;
if ( $grid[$row][$pt] eq $last ) {
push @{$new[$row*2]}, (' ', $grid[$row][$pt]);
}
else {
push @{$new[$row*2]}, ('|', $grid[$row][$pt]);
$last = $grid[$row][$pt];
}
last if $pt == $#{$grid[$row]};
}
last if $row == $#grid;
my $width = $#{$grid[$row]};
$new[$row*2+1] = [(' ') x ($width * 2 + 1)];
}
# pass 2
for ( my $row=2; $row < @new; $row+=2 ) {
for ( my $pt=0; $pt < @{$new[$row]}; $pt +=2 ) {
if ( $new[$row][$pt] eq $new[$row-2][$pt] ) {
$new[$row-1][$pt] = ' ';
}
else {
$new[$row-1][$pt] = '-';
}
}
}
# find the corners
for ( my $row=1; $row < @new; $row+=2 ) {
for ( my $pt=1; $pt < @{$new[$row]}; $pt +=2 ) {
# do we have corners ?
if ( $new[$row][$pt-1].$new[$row-1][$pt] eq '-|' or
$new[$row][$pt-1].$new[$row+1][$pt] eq '-|' or
$new[$row][$pt+1].$new[$row-1][$pt] eq '-|' or
$new[$row][$pt+1].$new[$row+1][$pt] eq '-|' )
{
$new[$row][$pt] = '+';
}
}
}
# final pass to complete now we have corners
for ( my $row=1; $row < @new; $row+=2 ) {
for ( my $pt=1; $pt < @{$new[$row]}; $pt +=2 ) {
if ( $new[$row][$pt-1].$new[$row][$pt].$new[$row][$pt+1] eq '-
+ -' ) {
$new[$row][$pt] = '-';
}
elsif ( $new[$row-1][$pt].$new[$row][$pt].$new[$row+1][$pt] e
+q '| |' ) {
$new[$row][$pt] = '|';
}
}
}
print 'Wanted:
P P|B|R|B
+-+ +-+
P|R|B B B
-+ +---+
B|R R R|B
| |
B|R R R|B
+---+-+
B|G G|B B
Got:
';
print "@$_\n" for @new;
| [reply] [d/l] |
Re: Map grid to boundary conversion algorithm
by simonm (Vicar) on Apr 16, 2004 at 16:16 UTC
|
Assuming there's no performance pressure, I think a straightforward search would be sufficient.
Here's an untested code outline:
use strict;
# Build grid array
my @grid;
foreach ( <DATA> ) {
s/^\s*\b// or next;
push @grid, [ split ' ', $_ ],
}
# Assign arbitrary regions
my @region;
foreach my $x ( 0 .. $#grid ) {
foreach my $y ( 0 .. $#{ $grid[0] } ) {
$region[$x][$y] = "$x.$y";
}
}
# Merge neighboring regions
foreach my $x ( 0 .. $#grid ) {
foreach my $y ( 0 .. $#{ $grid[0] } ) {
my @neighbors = ( [ $x-1, $y ], [$x, $y-1] );
foreach my $coord ( @neighbors ) {
my ( $nx, $ny ) = @$coord;
next if ( $nx < 0 or $ny < 0 );
if ( $grid[$x][$y] eq $grid[ $nx ][ $ny ] and
$region[$x][$y] ne $region[ $nx ][ $ny ] ) {
# Cell is the same color as its neighbor, join it
merge_regions( $x, $y, $nx, $ny )
}
}
}
}
sub merge_regions {
my ( $tx, $ty, $nx, $ny ) = @_;
my $tr = $region[$tx][$ty];
my $nr = $region[$nx][$ny];
foreach my $x ( 0 .. $#grid ) {
foreach my $y ( 0 .. $#{ $grid[0] } ) {
if ( $region[$x][$y] eq $tr ) {
$region[$x][$y] = $nr
}
}
}
}
my $count = 0;
my %regions;
foreach my $x ( 0 .. $#grid ) {
foreach my $y ( 0 .. $#{ $grid[0] } ) {
my $num = ( $regions{ $region[$x][$y] } ||= ++ $count );
print $num . " ";
}
print "\n"
}
__DATA__
P P B R B
P R B B B
B R R R B
B R R R B
B G G B B
The output needs to be adjusted to your application; for now it just prints a grid of contiguous regions:
1 1 2 3 2
1 4 2 2 2
5 4 4 4 2
5 4 4 4 2
5 6 6 2 2
P.S. I've only seen "Moore Neighbourhood" used to refer to the immediate lateral and diagonal neighbors of a cell, but perhaps there's more than one meaning? Do you want to allow diagonal connections between neighbors, or only lateral ones?
Update: Looking at kvale's solution, I noticed that I implicitly assumed that the OP was looking for "contiguous regions" rather than "boundaries" -- it works out to the same thing, but influenced my choice of approach. | [reply] [d/l] |
|
I might be wrong but to me this looks very similar as the input ... ?!
| [reply] |
|
I might be wrong but to me this looks very similar as the input
Yes, but the regions have been assigned distinct numbers. (Looking closely, you'll see that the clump of "B"s in the top right corner is given a different number than the clump of "B"s in the bottom left.)
| [reply] |
Re: Map grid to boundary conversion algorithm
by BrowserUk (Patriarch) on Apr 16, 2004 at 18:58 UTC
|
#! perl -slw
use strict;
my $g =
qq[PPBRB
PRBBB
BRRRB
BRRRB
BGGBB];
my $w = 5 -1;
my( $o1, $o2 )= ( $w * 2, $w *2 +1 );
$g =~ s[\n]["\n" . '-+' x $w . "-\n"]eg;
$g =~ s[([PRGB])(?=[PRGB])][$1|]g;
$g =~ s[(?<=([PRGB]))\|(?=\1)] [ ]g;
$g =~ s[(?<=(.).{$o2})[-](?=.{$o2}\1)] [ ]gs;
$g =~ s[(?<= .{$o1}[-])\+(?=[-].{$o1} )] [-]gs;
$g =~ s[(?<= .{$o1}[ -])\+(?=[ -].{$o1} )][ ]gs;
$g =~ s[(?<=\|.{$o1} )\+(?= .{$o1}\|)] [|]gs;
print $g;
__END__
P:\test>345780
P P|B|R|B
+-+ +-+
P|R|B B B
-+ +---+
B|R R R|B
| |
B|R R R|B
+---+-+
B|G G|B B
Examine what is said, not who speaks.
"Efficiency is intelligent laziness." -David Dunham
"Think for yourself!" - Abigail
| [reply] [d/l] |
Re: Map grid to boundary conversion algorithm
by pelagic (Priest) on Apr 16, 2004 at 15:24 UTC
|
Hi,
I'd first define a 2-dimensional system to identify the terrain-data and to identify all distinct border pieces within the same terrain. You should be able of identifying all 4 borders of any terrain-piece. You should also be able of identifying the crossings in the same way.
So if you start with a piece of terrain
e.g. $t[x][y] you should have an algorithm to find its borders and border-crossings.
One possibility might be to define that every piece of terrain has it's own borders and crossings and make the identification dependant like that: $t[x][y] would lead to $b[x][y][E], $b[x][y][S], $c[x][y][NE] and $c[x][y][SE].
| [reply] [d/l] [select] |
Re: Map grid to boundary conversion algorithm
by jdporter (Paladin) on Apr 16, 2004 at 15:33 UTC
|
The WAsP web site mentions a map conversion utility called Surfer. Does it not do what you need?
jdporter The 6th Rule of Perl Club is -- There is no Rule #6.
| [reply] |
|
| [reply] |
Re: Map grid to boundary conversion algorithm
by BrowserUk (Patriarch) on Apr 16, 2004 at 19:31 UTC
|
UPDATE: Many thanks to all who responded. I should maybe have been a little less figurative with the ASCII art; it was the actual roughness contour lines I was after, though I'm sure I could write an ASCII to vector converter.
Perhaps you could give an example of the format you need, for your sample?
Examine what is said, not who speaks.
"Efficiency is intelligent laziness." -David Dunham
"Think for yourself!" - Abigail
| [reply] |
|
Sorry for the delay. With your comments in mind, I ended up coding it this way:
- define a zero-value one cell border around the whole array.
- walk through each row horizontally, looking for vertical changes in value. Store each one in a structure containing the left and right values, and the coordinates of the end points
- walk through each column vertically, looking for horizontal changes in value, as above.
- search for adjoining vertical segments, and merge them.
- search for adjoining horizontal segments, and merge them.
- Write out the lists of line segments.
It appears that the mapping tool we use is clever enough to join up adjacent lines into areas, so lines are all we need. The reason for the zero-value border isn't initially obvious, but it's necessary for the contouring routine to get its senses right.
I put an example of what a tiny (300m x 300m) test file in my blog, if anyone cares to see what it looks like.
I know my algorithm isn't that efficient; it took nearly 8 hours to process a real 73 x 58 km dataset on a P4-2800. My Fortran version (compiled with the excellent free-for-personal use Intel Fortran Compiler for Linux) looks like it will run at least an order of magnitude quicker.
I'm beginning to warm to Fortran (90, or 95; F77 I cannot love). It has a nifty WHERE command which is somewhere between map and grep.
Yes, at this point, you can say 'He's got away from us Jack.' ...
-- bowling trophy thieves, die!
| [reply] [d/l] [select] |
|
| [reply] |
|
|
|
|