Experimental Image::BoxFind module:    Image/t/09-has_pixpat_changed_past_threshold-color_distance.t


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

use warnings;
use strict;
$|=1;
my $DEBUG = 1;             # TODO set to 0 before ship
use Data::Dumper;

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

use Data::Dumper;
use File::Basename qw( basename );

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

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

#2
ok(1, "Traditional: If we made it this far, we're ok.");

{#3
  my $test_name = "has_pixpat_changed_past_threshold";
  my $bf = Image::BoxFind->new( {
                                  DEBUG      => $DEBUG,
                                } );


  $bf->set_pixpat_threshold( 1000 ); # TODO

  my ($pixpat, $orig_pixpat, $status, $expected);

  $pixpat = [
          '65535,65535,65535,0',
          '65535,65535,65535,0',
          '52000,61937,54313,0',
          '45232,60138,48702,0'
        ];

  @{ $orig_pixpat } = @{ $pixpat };

  $status = $bf->has_pixpat_changed_past_threshold( $pixpat, $orig_pixpat );

  $expected = '';
  is_deeply( $status, $expected,
               "Testing $test_name identical input => no change " );

  #4

  $pixpat = [
          '61423,61423,61423,0',
          '44204,51914,58724,0',
          '34352,44375,53199,0',
          '42148,49665,56283,0',
          '46825,52839,58133,0',
          '49944,54955,59367,0',
          '52171,56467,60248,0',
          '53842,57600,60909,0'
        ];

  $orig_pixpat = [
          '61423,61423,61423,0',
          '64204,51914,58724,0',
          '34352,44375,53199,0',
          '62148,49665,56283,0',
          '66825,52839,58133,0',
          '69944,54955,59367,0',
          '52171,56467,60248,0',
          '53842,57600,60909,0'
        ];


  $status = $bf->has_pixpat_changed_past_threshold( $pixpat, $orig_pixpat );

  $expected = 1;
  is_deeply( $status, $expected,
               "Testing $test_name big changes in some RR values" );


  #5

  $pixpat = [
          '61423,61423,61423,0',
          '44204,51914,58724,0',
          '34352,44375,53199,0',
          '42148,49665,56283,0',
          '46825,52839,58133,0',
          '49944,54955,59367,0',
          '52171,56467,60248,0',
          '53842,57600,60909,0'
        ];

  $orig_pixpat = [
          '61423,61423,61423,0',
          '44204,51914,58724,0',
          '34352,44375,53199,0',
          '42150,49667,56285,0',
          '46825,52839,58133,0',
          '49944,54955,59367,0',
          '52171,56467,60248,0',
          '53842,57600,60909,0'
        ];


  $status = $bf->has_pixpat_changed_past_threshold( $pixpat, $orig_pixpat );

  $expected = '';
  is_deeply( $status, $expected,
               "Testing $test_name minor changes to one position " );

}

{ #6
  my $test_name = 'color_distance';
  my $bf = Image::BoxFind->new( DEBUG => $DEBUG );

  my $color1 = '49944,54955,59367,0';
  my $color2 = '69944,54955,59367,0';

  my $expected = 20000;

  my $color_distance = $bf->color_distance($color1, $color2);

  is( $color_distance, $expected, "Testing $test_name: RR diff only" );
}

{ #7
  my $test_name = 'color_distance';
  my $bf = Image::BoxFind->new( DEBUG => $DEBUG );

  my $color1 = '9292,9232,9204,0';
  my $color2 = '6826,6826,6826,0';

  my $expected = 4186.27232750092;

  my $color_distance = $bf->color_distance($color1, $color2);

  is( $color_distance, $expected, "Testing $test_name: diffs of ~2400 all 3" );
}


# TODO Add some even more through tests, perhaps...


     

Joseph Brenner, Tue Nov 27 17:40:02 2007