in reply to Map grid to boundary conversion algorithm

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

[download]
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.

-Mark

Replies are listed 'Best First'.
Re: Re: Map grid to boundary conversion algorithm
by tachyon (Chancellor) on Apr 16, 2004 at 17:02 UTC

    Here is my stab. As kvale notes you can decrease the number of passes. 

    #!/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;

    [download]

    cheers

    tachyon

[reply]
[d/l]

In Section Seekers of Perl Wisdom