perl PNG image searching

[elie]

Hello,

so I have some images (all PNG)

I have a small image, ( a checkered box) and other larger images that
may or may not contain the checkered box small image.
I want to somehow find out if the small image (the checkered box)
apprears anywhere in the larger PNG's or not.

any hits would be appreciated.

Regards,

 

[Ben Bullock]

so I have some images (all PNG)

I have a small image, ( a checkered box) and other larger images that
may or may not contain the checkered box small image.
I want to somehow find out if the small image (the checkered box)
apprears anywhere in the larger PNG's or not.

I don't have any idea how to do this, but whatever solution you arrive
upon it will depend upon some kind of graphics library, which you can
access by Perl, rather than being something you can do with pure Perl
commands. There are a lot of graphics libraries, such as ImageMagick,
which have interfaces to Perl.

You might also want to try asking your question on a graphics
newsgroup or web forum.

 

[zentara]

Hello,

so I have some images (all PNG)

I have a small image, ( a checkered box) and other larger images that
may or may not contain the checkered box small image.
I want to somehow find out if the small image (the checkered box)
apprears anywhere in the larger PNG's or not.

any hits would be appreciated.

Regards,

This is just a brainstorm,
but you might be able to do some sort
of binary regex search of the larger images. You would have to strip
off the png header of the smaller image.

The problem, is that the smaller image will not be contained as a linear
string in the larger image.
What you might do, is break the larger image into "binary lines"
depending on it's resolution. Then do the same thing for the
smaller image.

Then a fast go/no-go test would be to seach each binary line of the
large image for the first non-header binary line of the smaller one.

If a first line match is found, then continue for matching the rest
of the lines.

The only problem left, is to determine if the matches all line up at
the same pixel shift point. Regexes do have the ability to report
the position of the match, so it should be doable.

I'm sorry my regex skills (especially with binary data) is not that
expert, but someone else here may know.

Goodluck,
zentara

 

[Ben Bullock]

This is just a brainstorm,
but you might be able to do some sort
of binary regex search of the larger images. You would have to strip
off the png header of the smaller image.

As far as I know, PNG is a compressed format, so it's not possible to access
the actual pixel data just by "stripping off the png header".

 

[elie]

I've been playing around with perlMagick (which is a perl interface to
Image-Magic), I think it can decompress the PNG into some binary, but
its way too complex, I get some binary, but I can't tell what it is,
the number of bytes doesn't match the number of pixels, and is not a
multiple. I've been using the perlmagik function getPixels() but I
don't know what the binary its returning is yet.

I'm going to try to match part of the binary from the sub image in the
big image, but its still not making sence.

 

[elie]

thanks ben,
I think perlMagik is the right library to use, I'm going to find an
imageMagic newsgroup to ask around in, I'll post my findings later.

 

[Ben Morrow]

As far as I know, PNG is a compressed format, so it's not possible to access
the actual pixel data just by "stripping off the png header".

A good way around this is to run the PNG through pngtopnm |
pnmtoplainpnm. ASCII pnm format is very simple (that's the point).

Ben

 

[A. Sinan Unur]

[ Don't top post here ]

I've been playing around with perlMagick (which is a perl interface to
Image-Magic), I think it can decompress the PNG into some binary, but
its way too complex, I get some binary, but I can't tell what it is,
the number of bytes doesn't match the number of pixels, and is not a
multiple. I've been using the perlmagik function getPixels() but I
don't know what the binary its returning is yet.

I'm going to try to match part of the binary from the sub image in the
big image, but its still not making sence.

I don't know what size images you are playing with, how much CPU
and RAM are available. However, the naive implementation of this
functionality is really not that hard.

Below, for convenience, I used the GD library. The code looks for
a 32x32 pattern in a 2816x2112 photo with the pattern pasted in to
roughly the center of the larger image.

perl takes about 4Mb memory when the program below is running.
First, the results:

E:\img> timethis fi

TimeThis : Command Line : fi
TimeThis : Start Time : Wed May 07 15:29:14 2008

Possible match at 1393 1041
Matched line: 0
Matched line: 1
Matched line: 2
Matched line: 3
Matched line: 4
Matched line: 5
Matched line: 6
Matched line: 7
Matched line: 8
Matched line: 9
Matched line: 10
Matched line: 11
Matched line: 12
Matched line: 13
Matched line: 14
Matched line: 15
Matched line: 16
Matched line: 17
Matched line: 18
Matched line: 19
Matched line: 20
Matched line: 21
Matched line: 22
Matched line: 23
Matched line: 24
Matched line: 25
Matched line: 26
Matched line: 27
Matched line: 28
Matched line: 29
Matched line: 30
Matched line: 31
Definite match at 1393 1041 ( 32 x 32 )

TimeThis : Command Line : fi
TimeThis : Start Time : Wed May 07 15:29:14 2008
TimeThis : End Time : Wed May 07 15:29:29 2008
TimeThis : Elapsed Time : 00:00:15.015

That took 15 seconds to find the 32x32 pattern in the larger
image. That is probably not fast enough, but it is a starting
point.

Of course, it might be easier just to convert both images to
binary or ASCII encoded PPM and do the matching from there
(in that case, the regex approach is almost trivial) and I
would guess would be faster than dealing with the repeated
rgb and getPixel calls.

#!/usr/bin/perl

use strict;
use warnings;

use GD;
GD::Image->trueColor(1);

use constant FIND_MULTIPLE => 0;

my ($source, $pattern) = qw( source.png pattern.png );

my $sgd = GD::Image->new( $source );
my $pgd = GD::Image->new( $pattern );

my ( $start_x, $start_y ) = (0, 0);

COORD:
while ( my @coord = find_first_match( $sgd, $pgd, $start_x, $start_y ) ) {
warn "Possible match at @coord\n";

my ( $pw, $ph ) = $pgd->getBounds;

SCAN:
for ( my $py = 0; $py < $ph; $py += 1 ) {
if ( match_hscanline($sgd, $pgd, @coord, $py) ) {
warn "Matched line: $py\n";
}
else {
warn "Failed to match line: $py\n";
$start_x = $coord[0] + 1;
$start_y = $coord[1];
next COORD;
}
}

warn "Definite match at @coord ( $pw x $ph )\n";
last unless FIND_MULTIPLE;

$start_x = $coord[0] + $pw;
$start_y = $coord[1];
}

sub find_first_match {
my ( $sgd, $pgd, $start_x, $start_y ) = @_;

my ( $sw, $sh ) = $sgd->getBounds;
my ( $pw, $ph ) = $pgd->getBounds;

my $lookfor = make_rgb( $pgd->rgb( $pgd->getPixel(0, 0) ) );

for ( my $y = $start_y; $y < $sh - $ph; $y += 1 ) {
for ( my $x = $start_x; $x < $sw - $pw; $x += 1 ) {
if ( $lookfor == make_rgb(
$sgd->rgb( $sgd->getPixel( $x, $y ) ) ) ) {
return my @r = ($x, $y);
}
}
}
return;
}

sub match_hscanline {
my ( $sgd, $pgd, $sx, $sy, $py ) = @_;
my ( $pw, $ph ) = $pgd->getBounds;

for ( my $px = 0; $px < $pw; $px += 1 ) {
return if make_rgb($pgd->rgb( $pgd->getPixel($px, $py)))
!= make_rgb($sgd->rgb( $sgd->getPixel($sx + $px, $sy + $py)));
}

return 1;
}

# memoizing this function does not speed things up
sub make_rgb {
my ( $r, $g, $b ) = @_;
return ( $r << 16 ) | ( $g << 8 ) | $b;
}


__END__



--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/

 

[sheinrich]

I've been playing around with perlMagick (which is a perl interface to
Image-Magic), I think it can decompress the PNG into some binary, but
its way too complex, I get some binary, but I can't tell what it is,
the number of bytes doesn't match the number of pixels, and is not a
multiple. I've been using the perlmagik function getPixels() but I
don't know what the binary its returning is yet.

I'm going to try to match part of the binary from the sub image in the
big image, but its still not making sence.

By means of ImageMagick or any other library, I'd first turn both
images into some sort of bitmap format, preferably monochrome, and
reduce their sizes below the threshold of any pixel errors caused by
the transformation.
It should then be poossible to slide the smaller image over the bigger
one and apply some bitwise logic (XOR) to the corresponding pixels.

Cheers, Steffen

 

[elie]

ben with your method,
pngtopnm | pnmtoplainpnm
I was able to find out if the pattern is there or not.

now i only need to find out the location, any idea how that ASCII maps
to pixels. i need to find out if my pattern is below y pixels or right
of x pixels.

I'll go look for a pnm specification.

 

[elie]

thank you for your reply Sinan, I will try your suggestion if the
pngtopnm | pnmtoplainpnm doesn't work.

 

[A. Sinan Unur]

Of course, it might be easier just to convert both images to
binary or ASCII encoded PPM and do the matching from there
(in that case, the regex approach is almost trivial)

Actually, I should have said index rather than a regex match.

Sinan

--
A. Sinan Unur <[email protected]>
(remove .invalid and reverse each component for email address)

comp.lang.perl.misc guidelines on the WWW:
http://www.rehabitation.com/clpmisc/

 

[elie]

okay I figured out the pnm format, Its explained in wikipedia

http://en.wikipedia.org/wiki/Portable_pixmap

 

[elie]

thanks all for your help

 

[zentara]

As far as I know, PNG is a compressed format, so it's not possible to access
the actual pixel data just by "stripping off the png header".

Well then, you probably can convert each pixel to rgb values, and
compare the following hex data:

Pixel Data looks like:
ffffff00 e7e7ffff e7e7ffff e7e7ffff e7e7ffff e7e7ffff e7e7ffff e7e7ffff
e7e7ffff e7e7ffff e7e7ffff e7e7ffff e7e7ffff e7e7ffff e7e7ffff e7e7ffff
ffffff00 ffffff00 ffffff00 ffffff00

The nice thing about pixel rgb data, is you can then set some
sort of threshold for a close match.

#!/usr/bin/perl
#None of these is fast, mainly because of the overhead of calling Perl
#code for each pixel.
use strict;

my $imagefile = shift or die "No file specified\n";

sub rgba2hex {
sprintf "%02x%02x%02x%02x", map { $_ || 0 } @_;
}

{
use Imager;
my %colors;
my $img = Imager->new();
$img->open( file => $imagefile ) or die $img->errstr;
my ( $w, $h ) = ( $img->getwidth, $img->getheight );
for my $i ( 0 .. $w - 1 ) {
for my $j ( 0 .. $h - 1 ) {
my $color = $img->getpixel( x => $i, y => $j );
my $hcolor = rgba2hex $color->rgba();

print "$hcolor ";

$colors{$hcolor}++;
}
}

printf "Imager: Number of colours: %d\n", scalar keys %colors;
}

{
use GD;
my %colors;
my $gd = GD::Image->new($imagefile) or die
"GD::Image->new($imagefile)";
my ( $w, $h ) = $gd->getBounds();
for my $i ( 0 .. $w - 1 ) {
for my $j ( 0 .. $h - 1 ) {
my $index = $gd->getPixel( $i, $j );
my $hcolor = rgba2hex( $gd->rgb($index), 0 );
$colors{$hcolor}++;
}
}

printf "GD: Number of colours: %d\n", scalar keys %colors;
}


{
use Image::Magick;
my %colors;
my $img = Image::Magick->new();
my $rc = $img->Read($imagefile);
die $rc if $rc;
my ( $w, $h ) = $img->Get( 'width', 'height' );
for my $i ( 0 .. $w - 1 ) {
for my $j ( 0 .. $h - 1 ) {
my $color = $img->Get("pixel[$i,$j]");
my $hcolor = rgba2hex split /,/, $color;
$colors{$hcolor}++;
}
}

printf "Image::Magick: Number of colours: %d\n", scalar keys
%colors;
}
__END__

zentara

 

[Josef Moellers]

Hello,

so I have some images (all PNG)

I have a small image, ( a checkered box) and other larger images that
may or may not contain the checkered box small image.
I want to somehow find out if the small image (the checkered box)
apprears anywhere in the larger PNG's or not.

any hits would be appreciated.

BTDT, however with a C program (I wanted to find the best fit for series
of screen shots of a game, so I could draw up a map of the game).

If you *must* use Perl, take a look at Image::Magick, more precise the
GetPixels method. I used it to to build an el-cheapo OCR program for
screen shots.

You can mail me for the sources. No problem.

Josef