Experimental Image::BoxFind module:    Image/t/02-is_dupe_box-uniq_boxes-sort_boxes.t

     # Test created outside of h2xs framework.
# Run this like so: `perl Image-BoxFind.t'
#   doom@kzsu.stanford.edu     2007/10/13 03:50:28

#########################

use warnings;
use strict;
$|=1;
my $DEBUG = 0;
use Data::Dumper;

use Test::More;
BEGIN { plan tests => 9 };

use FindBin qw( $Bin );
use lib "$Bin/../..";

BEGIN {
  use_ok( 'Image::BoxFind' );
}

# arbitrarily starting a new test file, renaming the old with
# a "1-*" prefix: 1-Image-BoxFind.t

{
  my $test_name = "is_dupe_box";
#  my $image_file = "$Bin/dat/images/gimp_open_dialog.png"; # Dummy
# image_file  => $image_file,
  my $bf = Image::BoxFind->new( {
                                  DEBUG       => $DEBUG,
                                } );

  my ($r1, $r2, $ret);

  $r1 = [ [9, 3], [9, 29], [29, 29], [29, 3] ];
  $r2 = [ [9, 3], [9, 29], [29, 29], [29, 3] ];

  $ret = $bf->is_dupe_box( $r1, $r2 );
  ok( $ret, "Testing $test_name: exact dupe");

  $r1 = [ [9, 3], [9, 30], [29, 29], [29, 3] ];
  $r2 = [ [9, 3], [9, 29], [29, 29], [29, 3] ];

  $ret = $bf->is_dupe_box( $r1, $r2 );
  ok( $ret, "Testing $test_name: ignoring a small deviation");

  $r1 = [ [8, 4], [10, 28], [28, 30], [30, 4] ];
  $r2 = [ [10, 4], [8, 30], [30, 28], [28, 2] ];

  $ret = $bf->is_dupe_box( $r1, $r2 );
  ok( $ret, "Testing $test_name: rough duplicates") or
    do {
      $bf->print_box( $r1 );
      $bf->print_box( $r2 );
    };


  #5 - Note: this test presumes fuzziness is set to 4.
  #    if you increase it to 5, these will pass "is_dupe_box"
  $r1 = [ [8, 4], [10, 28], [28, 30], [30, 4] ];
  $r2 = [ [10, 9], [8, 30], [30, 28], [28, 2] ];

  $ret = $bf->is_dupe_box( $r1, $r2 );
  ok( not( $ret ), "Testing $test_name: not quite duplicates") or
    do {
      $bf->print_box( $r1 );
      $bf->print_box( $r2 );
    };
}

{
  my $test_name = "uniq_boxes";
#  my $image_file = "$Bin/dat/images/gimp_open_dialog.png"; # Dummy
# image_file  => $image_file,
  my $bf = Image::BoxFind->new( {
                                  DEBUG       => $DEBUG,
                                } );
  my $raw_rectangles =  define_rectangles();

  my $text;
  $text = $bf->dump_boxes_to_string( $raw_rectangles );
  $bf->debug( "Input rectangles: \n $text\n" );

  my $rectangles = $bf->uniq_boxes( $raw_rectangles );

  $text = $bf->dump_boxes_to_string( $rectangles );
  $bf->debug( "Uniq rectangles: \n $text\n" );

  my $expected = define_expected_uniq_boxes();
  is_deeply( $rectangles, $expected, "Testing $test_name");
}

{
  my $test_name = "sort_boxes";

#  my $image_file = "$Bin/dat/images/gimp_open_dialog.png"; # Dummy
# image_file  => $image_file,
  my $bf = Image::BoxFind->new( {
                                  DEBUG       => $DEBUG,
                                } );

  my $rectangles = define_expected_uniq_boxes();
  my $sorted1 = $bf->sort_boxes( $rectangles );

  my ($text, $expected);
  $text = $bf->dump_boxes_to_string( $sorted1 );
  $bf->debug( "Sorted 1: \n $text\n" );

  # print Dumper( $sorted1 ), "\n" ;
  $expected = define_expected_sorted1();

  is_deeply( $sorted1, $expected, "Testing $test_name: uniq list");

  my $raw_rectangles =  define_rectangles();
  my $sorted2 = $bf->sort_boxes( $raw_rectangles );

  $text = $bf->dump_boxes_to_string( $sorted2 );
  $bf->debug( "Sorted 2: \n $text\n" );

  # print "sorted2:", Dumper( $sorted2 ), "\n" ;
  $expected = define_expected_sorted2();
  is_deeply( $sorted2, $expected, "Testing $test_name: old raw list");


  my $rectangles3 =  define_rectangles_to_be_sorted_3();
  my $sorted3 = $bf->sort_boxes( $rectangles3 );

  $text = $bf->dump_boxes_to_string( $sorted3 );
  $bf->debug( "Sorted 3: \n $text\n" );

  # print "sorted3:", Dumper( $sorted3 ), "\n" ;
  $expected = define_expected_sorted3();

  is_deeply( $sorted3, $expected, "Testing $test_name: tie breaker");
}




sub define_rectangles {
  my $rect =
    [ [
      [ 20, 66 ],
      [ 20, 99 ],
      [ 130, 99 ],
      [ 130, 66 ]
     ],
     [
      [ 1522, 566 ],
      [ 520, 599 ],
      [ 631, 600 ],
      [ 630, 564 ]
     ],
     [
      [ 2, 6 ],
      [ 0, 9 ],
      [ 1, 0 ],
      [ 0, 4 ]
     ],
     [
      [ 1522, 566 ],
      [ 520, 599 ],
      [ 631, 600 ],
      [ 630, 564 ]
     ],
     [
      [ 1520, 564 ],
      [ 518, 601 ],
      [ 630, 603 ],
      [ 628, 562 ]
     ],
     [
      [ 1520, 564 ],
      [ 518, 601 ],
      [ 630, 603 ],
      [ 628, 562 ]
     ],
     [
      [ 2, 5 ],
      [ 0, 8 ],
      [ 1, 1 ],
      [ 0, 5 ]
     ],
     [
      [ 2, 5 ],
      [ 0, 8 ],
      [ 1, 1 ],
      [ 0, 5 ]
     ],
     [
      [ 200, 500 ],
      [ 000, 800 ],
      [ 100, 100 ],
      [ 000, 500 ]
     ],
    ];
  return $rect;
};


sub define_expected_uniq_boxes {
  my $rect =
    [ [
        [  20, 66 ],
        [  20, 99 ],
        [ 130, 99 ],
        [ 130, 66 ]
      ],
      [ [ 1520, 564 ],
        [  518, 601 ],
        [  630, 603 ],
        [  628, 562 ]
      ],
      [ [ 2, 5 ],
        [ 0, 8 ],
        [ 1, 1 ],
        [ 0, 5 ]
      ],
      [
        [ 200, 500 ],
        [ 0,   800 ],
        [ 100, 100 ],
        [ 0,   500 ]
      ]
    ];

  return $rect;
};


sub define_expected_sorted1 {
  my $expected =
    [
     [ [ 2, 5 ],
       [ 0, 8 ],
       [ 1, 1 ],
       [ 0, 5 ]
     ],
     [ [ 20, 66 ],
       [ 20, 99 ],
       [ 130, 99 ],
       [ 130, 66 ]
     ],
     [ [ 200, 500 ],
       [ 0, 800 ],
       [ 100, 100 ],
       [ 0, 500 ]
     ],
     [ [ 1520, 564 ],
       [ 518, 601 ],
       [ 630, 603 ],
       [ 628, 562 ]
     ]
    ];
  return $expected;
}

sub define_expected_sorted2 {
  my $expected =
    [
     [ [ 2, 5 ],
       [ 0, 8 ],
       [ 1, 1 ],
       [ 0, 5 ] ],
     [ [ 2, 5 ],
       [ 0, 8 ],
       [ 1, 1 ],
       [ 0, 5 ] ],
     [ [ 2, 6 ],
       [ 0, 9 ],
       [ 1, 0 ],
       [ 0, 4 ] ],
     [ [ 20, 66 ],
       [ 20, 99 ],
       [ 130, 99 ],
       [ 130, 66 ] ],
     [ [ 200, 500 ],
       [ 0, 800 ],
       [ 100, 100 ],
       [ 0, 500 ] ],
     [ [ 1520, 564 ],
       [ 518, 601 ],
       [ 630, 603 ],
       [ 628, 562 ] ],
     [ [ 1520, 564 ],
       [ 518, 601 ],
       [ 630, 603 ],
       [ 628, 562 ] ],
     [ [ 1522, 566 ],
       [ 520, 599 ],
       [ 631, 600 ],
       [ 630, 564 ] ],
     [ [ 1522, 566 ],
       [ 520, 599 ],
       [ 631, 600 ],
       [ 630, 564 ] ]
        ];
  return $expected;
}




sub define_rectangles_to_be_sorted_3 {
  my $rectangles =
    [
     [
      [  20, 66 ],
      [  20, 99 ],
      [ 130, 99 ],
      [ 130, 67 ]
     ],
     [
      [  20, 66 ],
      [  20, 99 ],
      [ 130, 99 ],
      [ 130, 66 ]
     ],
     [
      [  20, 66 ],
      [  20, 99 ],
      [ 130, 99 ],
      [ 130, 69 ]
     ],
     [
      [  20, 66 ],
      [  20, 99 ],
      [ 130, 99 ],
      [ 130, 63 ]
     ],
     [
      [   0,   0 ],
      [   0, 209 ],
      [ 111, 209 ],
      [ 111,   2 ]
     ],
     [
      [   0,   0 ],
      [   0, 209 ],
      [ 111, 209 ],
      [ 111,   3 ]
     ],
     [
      [   0,   0 ],
      [   0, 209 ],
      [ 111, 209 ],
      [ 111,   1 ]
     ],
     [
      [   0,   0 ],
      [   0, 209 ],
      [ 111, 209 ],
      [ 110,   2 ]
     ],
     [
      [   0,   0 ],
      [   0, 209 ],
      [ 111, 209 ],
      [ 109,   2 ]
     ],
     [
      [   0,   0 ],
      [   0, 209 ],
      [ 111, 209 ],
      [ 111,   2 ]
     ],
    ];

  return $rectangles;
}

sub define_expected_sorted3 {
  my $expected =
    [
     [
      [ 0, 0 ],
      [ 0, 209 ],
      [ 111, 209 ],
      [ 109, 2 ]
     ],
     [ [ 0, 0 ],
       [ 0, 209 ],
       [ 111, 209 ],
       [ 110, 2 ]
     ],
     [ [ 0, 0 ],
       [ 0, 209 ],
       [ 111, 209 ],
       [ 111, 1 ]
     ],
     [ [ 0, 0 ],
       [ 0, 209 ],
       [ 111, 209 ],
       [ 111, 2 ]
     ],
     [ [ 0, 0 ],
       [ 0, 209 ],
       [ 111, 209 ],
       [ 111, 2 ]
     ],
     [ [ 0, 0 ],
       [ 0, 209 ],
       [ 111, 209 ],
       [ 111, 3 ]
     ],
     [ [ 20, 66 ],
       [ 20, 99 ],
       [ 130, 99 ],
       [ 130, 63 ]
     ],
     [ [ 20, 66 ],
       [ 20, 99 ],
       [ 130, 99 ],
       [ 130, 66 ]
     ],
     [ [ 20, 66 ],
       [ 20, 99 ],
       [ 130, 99 ],
       [ 130, 67 ]
     ],
     [ [ 20, 66 ],
       [ 20, 99 ],
       [ 130, 99 ],
       [ 130, 69 ]
     ]
    ];
  return $expected;
}