How to analysis the "neighborhood relationship" of an array with perl

Question

(I). I got a software which contains a command "rectangle(x1,x2,y1,y2)", it can generate a rectangle with bottom-left corner coordinate(x1,y1) and upper-right corner coordinate(x2,y2) on x-y plane

(II). I wanna use this software to create all alphanumeric in x-y plane with stack up rectangles, basically I wanna print out those commands by perl

(III). My idea is to create a 5x7 table by filling this table with rectangles then put it to the coordinate I want as following:

#!/usr/bin/perl

use strict;
use warnings;
###=================================================================================###
###=================================================================================###
###========= This script will generate alphanumeric by filling polygon in =========###
###==================== the specific position of a 5 x 7 table =====================###
###================= following case represents the alphanumeric:"1"================###
###=================================================================================###
###===           ---------------------                                           ===###
###===           |   |   | O |   |   |  6                                        ===###
###===           ---------------------                                           ===###
###===           |   | O | O |   |   |  5                                        ===###
###===           ---------------------                                           ===###
###===           |   |   | O |   |   |  4                                        ===###
###===           ---------------------                                           ===###
###===           |   |   | O |   |   |  3  row number                            ===###
###===           ---------------------                                           ===###
###===           |   |   | O |   |   |  2                                        ===###
###===           ---------------------                                           ===###
###===           |   |   | O |   |   |  1                                        ===###
###===           ---------------------                                           ===###
###===           |   | O | O | O |   |  0                                        ===###
###===           ----------*----------    "*" stand for (coor_x, coor_y)         ===###
###===            -2  -1   0   1   2  --> column number                          ===###                                       

my grid_x = 1;   # the size of a grid along x-direction
my grid_y = 1;   # the size of a grid along y-direction

sub alphanum_1 {

my $coor_x = shift;              # the x coordinate that I wanna put this "polygon 1"
my $coor_y = shift;              # the y coordinate that I wanna put this "polygon 1"

my ($i,$j,$mkrstring);
my @col_neg2 = ("");            # the positions which needs to be filled in col -2
my @col_neg1 = (0,5);           # the positions which needs to be filled in col -1
my @col_zero = (0,1,2,3,4,5,6); # the positions which needs to be filled in col 0
my @col_pos1 = (0);             # the positions which needs to be filled in col +1
my @col_pos2 = ("");            # the positions which needs to be filled in col +2
my (@marker,@anchor);

for ($i=0; $i<=$#col_zero-1; $i++) {
$marker[$i] = ($col_zero[$i+1] - $col_zero[$i] == 1)? "m" : "0";
$mkrstring = $mkrstring.$marker[$i];
}
}

&alphanum_1;

Here comes the problem, as you can see the column 0 needs to be filled by all 7 rows, if I only want to use the "rectangle" command once instead of 7 times :

assume that coor_x=0, coor_y=0
method 1:

rectangle(-0.5,0.5,0,7)

method 2:

rectangle(-0.5,0.5,0,1)
rectangle(-0.5,0.5,1,2)
rectangle(-0.5,0.5,2,3)
rectangle(-0.5,0.5,3,4)
rectangle(-0.5,0.5,4,5)
rectangle(-0.5,0.5,5,6)
rectangle(-0.5,0.5,6,7)

method 1 and 2 will achieve the same result, but I prefer to use method 1 which means I need to check the "neighborhood relationship" in the same column, but I got stuck in this part, basically, I wanna stick the rectangles as long as they can be stuck together in the same column.

I'm a newbie in perl, is there any hint? I need your help!

This looks more like a question of algorithm rather than some perl tricks. It seems to me like an NP complete task, to minimize the calls of the rectangle function. A few questions: 1) Can two rectangles overlap? (i.e. can you call `rectangle(-0.5,0.5,0,7)` and then `rectangle(-1.5,1.5,0,1)`) 2) what exactly is the reason not to call the rectangle function multiple times? Do you want to call it the _minimum_ times or are you satisfied with a smaller reduction? — Jindra Helcl, Jul 26 '14 at 15:54
(1) yes, all rectangles can overlap as long as it can complete the right shape — liltme, Jul 26 '14 at 16:03
(2). I need to use "rectangle" function million times, so I want to do some reduction, minimum value is terrific, but not necessary — liltme, Jul 26 '14 at 16:10

score 1 · Accepted Answer · edited Jul 26 '14 at 18:29

Here is a way how to slightly reduce the number of rectangles (it is definitely not a reduction to minimum, however, it can help):

First, I would choose another representation of the matrix:

my @one = ([0,0,0,0,0,0,0],
           [1,0,0,0,0,1,0],
           [1,1,1,1,1,1,1],
           [1,0,0,0,0,0,0],
           [0,0,0,0,0,0,0]);

The @one variable is an array of references to arrays that representing the columns. Then, I would create an array of rectangles that must be painted:

my @rectangles;

for my $columnRef (@one) {
    my @column = @$columnRef;
    my @colRects = ();

    my $inRectangle = 0;
    my $rectBegin = 0;

    for my $i (0 .. $#column) {
        my $pixel = $column[$i];

        # closing a rectangle
        if($inRectangle == 1 and $pixel == 0) {
            $inRectangle = 0;

            my $rectEnd = $i - 1;
            push @colRects, [$rectBegin, $rectEnd];
        }

        # opening a rectangle
        if ($inRectangle == 0 and $pixel == 1) {
            $inRectangle = 1;
            $rectBegin = $i;
        }
    }

    # don't forget to close a rectangle if opened
    if ($inRectangle == 1) {
        push @colRects, [$rectBegin, $#column];
    }

    push @rectangles, \@colRects;
}

This code should fill the @rectangles variable with a list of rectangle starts and ends for each column:

([], [[0,0],[5,5]], [[0,6]], [[0,0]], [])

You can produce the desired output from that using

my $x = -2;
for my $col_rectangles (@rectangles) {
    for my $col_rectangle (@$col_rectangles) {
        printf("rectangle(%d,%d,%d,%d)",
           $x - 0.5,
           $x + 0.5,
           @$col_rectangle,
        );
    }
}

Now, you have minimized the number of calls of the rectangle function in each column separately. However, this solution will perform badly on more horizontal-oriented letters.

You can of course transpose it and perform the optimalization on rows instead of columns, but somehow I think that would not be better.

thanks for your help! would you mind to explain more about the role of `$inRectangle` playing here? — liltme, Jul 27 '14 at 03:45
You go through the pixels in a column. Every time you see a pixel that is "on", you are entering a rectangle. When you are in a rectangle and see a pixel that is "off", you have just left the rectangle. When you leave a rectangle and you remember where you have entered it, you can draw it from the beginning to the place where you left it. The `$inRectangle` is just a variable that tells whether you are in such a rectangle or not. — Jindra Helcl, Jul 27 '14 at 10:23
thank you, I know the algorithm, now I need to figure out the relationship between an array and lists, so much work to do... — liltme, Jul 27 '14 at 16:14
[http://stackoverflow.com/questions/6023821/perl-array-vs-list](http://stackoverflow.com/questions/6023821/perl-array-vs-list) I'm just learning how to use it — liltme, Jul 29 '14 at 04:02
Oh I see. I would downvote my earlier comment if i could.. :) — Jindra Helcl, Jul 30 '14 at 10:08

How to analysis the "neighborhood relationship" of an array with perl

1 Answers1