EchoAngel has asked for the wisdom of the Perl Monks concerning the following question:

Hello Monks! This is my current code. I currently have data saved in this aarray which was originally taken from a 2d array. Right now, I'm trying to make a general list such that if i put "2,4:3,5" it should try to generate a rectangular coordinate of 2,4 2,5 3,4 3,5. But now i realize this won't work if someone puts "2,4:5,2" or "8,5:3:2". any ideas 
foreach $element (@list_of_Num_Extraction)
   {
      if ($element =~ m/^([0-9]+),([0-9]+)$/)
      {
         my $first_num     = $1;
         my $second_num    = $2;
         my $current_num   = ($first_num - 1)*$NumOfColumns + $second_
+num; 

         $Unique_Num_List{$current_num} = "($first_num,$second_num)";
      } 
      elsif ($element =~ m/^([0-9]+),([0-9]+):([0-9]+),([0-9]+)$/)
      {
         my $num1x = $1;
         my $num1y = $2;
         my $num2x = $3;
         my $num2y = $4;

         my $counter1 = 0;
         my $counter2 = 0;

         foreach $counter1 ($num1x .. $num2x) {
         foreach $counter2 ($num1y .. $num2y) {
            
            my $current_num   = ($counter1 - 1)*$NumOfColumns + $count
+er2;
            $Unique_Num_List{$current_num} = "($counter1,$counter2)";
            #print "$counter1 - $counter2 \n"; 
         }}
      }
   }

[download]

Replies are listed 'Best First'.
Re: Extraction of List of Coordinates
by kvale (Monsignor) on Oct 05, 2004 at 22:45 UTC
    Your regex is ok, but to get a proper rectangle, you need to test your coordinates: 
    if ($1 > $3) {
   $num1x = $3;
   $num2x = $1;
{
else {
   $num1x = $1;
   $num2x = $3;
}
# same for y coords

    [download]

    -Mark

[reply]
[d/l]
Re: Extraction of List of Coordinates
by ikegami (Patriarch) on Oct 05, 2004 at 23:28 UTC

    You're using a hash, but you're treating it as an array. Here's your code with the fix, and using an array.

    foreach $element (@list_of_Num_Extraction)
   {
      if ($element =~ m/^([0-9]+),([0-9]+)$/)
      {
         my $first_num   = $1;
         my $second_num  = $2;
         my $current_num = ($first_num-1)*$NumOfColumns + $second_num;

         $Unique_Num_List[$current_num] = "($first_num,$second_num)";
      } 
      elsif ($element =~ m/^([0-9]+),([0-9]+):([0-9]+),([0-9]+)$/)
      {
         my ($num1x,$num1y,$num2x,$num2y) = ($1,$2,$3,$4);

         # Swap
         if ($num1x > $num2x)
         { $num1x ^= $num2x; $num2x ^= $num1x; $num1x ^= $num2x; }
         if ($num1y > $num2y)
         { $num1y ^= $num2y; $num2y ^= $num1y; $num1y ^= $num2y; }

         my $counter1 = 0;
         my $counter2 = 0;

         foreach $counter1 ($num1x .. $num2x) {
         foreach $counter2 ($num1y .. $num2y) {
            
            my $current_num = ($counter1-1)*$NumOfColumns + $counter2;
            $Unique_Num_List[$current_num] = "($counter1,$counter2)";
         }}
      }
   }
}

    [download]
[reply]
[d/l]
      In Perl, swaps can be accomplished thus: 
      if ($num1x > $num2x) { ($num1x, $num2x) = ($num2x, $num1x) }

      [download]
      Caution: Contents may have been coded under pressure.
[reply]
[d/l]
        I was going to point out the same thing, and that doing it the Perl way is actually faster, but it turns out ikegami's XOR trick is slightly faster:
        Read more... (1026 Bytes)
[reply]
[d/l]
[select]
Re: Extraction of List of Coordinates
by tmoertel (Chaplain) on Oct 06, 2004 at 00:37 UTC
    It seems that you're on the right track. You just need to extract the left, right, top, and bottom coordinates from the corner points of each rectangle specification. This is easy to do using min and max from List::Util: 
    sub minmax { ( min(@_), max(@_) ) }  # helper function

for (@list_of_Num_Extraction) {
    if (/^(\d+),(\d+):(\d+),(\d+)$/) {
        my ($l,$r, $t,$b) = (minmax($1,$3), minmax($2,$4));
        for my $x ($l .. $r) {      # left to right
            for my $y ($t .. $b) {  # top to bottom
              $Unique_Num_List{($x-1)*$num_columns + $y} = "($x,$y)";
            }
        }
    }
    # and so on ...
}

    [download]
    Just to show that it works, here's a bit of code that uses the above method to draw rectangles onto a virtual screen (represented by a sparse array). 
    #!/usr/bin/perl -w

use strict;
use List::Util qw( min max );

sub minmax { ( min(@_), max(@_) ) }

# draw rectangles onto sparse screen matrix

my %screen;  # sparse screen matrix
my $rectangle_name = "A";
for (<DATA>) {
    if (/^(\d+),(\d+):(\d+),(\d+)$/) {
        my ($l,$r, $t,$b) = (minmax($1,$3), minmax($2,$4));
        for my $x ($l .. $r) {     # left to right
            for my $y ($t .. $b) { # top to bottom
                $screen{$y}{$x} = $rectangle_name;
            }
        }
    }
    $rectangle_name++;
}

# print out screen

for my $f (sub {$_/10 % 10}, sub {$_ % 10}, sub {"_"}) {
    print "   ", (map &$f, 1..20), "\n";
}

my ($ymin, $ymax) = minmax(keys %screen);

for my $y ($ymin .. $ymax) {
    printf "%2d|", $y;
    for my $x (1 .. 60) {
        print $screen{$y}{$x} || " ";
    }
    print "\n";
}

__DATA__
2,2:4,4
5,10:10,5
12,5:6,1
8,12:1,15

    [download]
    And the output: 
       00000000011111111112
   12345678901234567890
   ____________________
 1|     CCCCCCC                                                
 2| AAA CCCCCCC                                                
 3| AAA CCCCCCC                                                
 4| AAA CCCCCCC                                                
 5|    BCCCCCCC                                                
 6|    BBBBBB                                                  
 7|    BBBBBB                                                  
 8|    BBBBBB                                                  
 9|    BBBBBB                                                  
10|    BBBBBB                                                  
11|                                                            
12|DDDDDDDD                                                    
13|DDDDDDDD                                                    
14|DDDDDDDD                                                    
15|DDDDDDDD

    [download]
    Cheers,
    Tom

    Tom Moertel : Blog / Talks / CPAN / LectroTest / PXSL / Coffee / Movie Rating Decoder

[reply]
[d/l]
[select]
Re: Extraction of List of Coordinates
by Roy Johnson (Monsignor) on Oct 06, 2004 at 02:43 UTC
    Yet another way to get the canonical coordinate spec: 
    my ($num1x, $num2x) = sort {$a <=> $b} ($1, $3);
my ($num1y, $num2y) = sort {$a <=> $b} ($2, $4);

    [download]
    Caution: Contents may have been coded under pressure.
[reply]
[d/l]
Re: Extraction of List of Coordinates
by TedPride (Priest) on Oct 06, 2004 at 01:59 UTC 
    my @list_of_Num_Extraction = ('2,4:3,5', '3,7:1,19');

my ($l, $r, $t, $b);
foreach (@list_of_Num_Extraction) {
    if ($_ =~ /^(\d+),(\d+):(\d+),(\d+)$/) {
        if ($1 > $3) { $l = $3; $r = $1; }
        else { $l = $1; $r = $3; }
        if ($2 > $4) { $t = $4; $b = $2; }
        else { $t = $2; $b = $4; }
        print "$l,$t $l,$b $r,$t $r,$b\n";
    }
}

    [download]
[reply]
[d/l]

Back to Seekers of Perl Wisdom