Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

Can i Compare two images in perl ?

by deep3101 (Acolyte)
on May 30, 2011 at 16:44 UTC ( #907337=perlquestion: print w/replies, xml ) Need Help??
deep3101 has asked for the wisdom of the Perl Monks concerning the following question:

hey guys, need help in finding a way to compare two images by finding out the degree of difference b/w them.. Images are of same format and same resolution.

P.S. I don't want to "perlmagick" my code because i need to embed it and perlmagick needs a lot of stuff to be done before it can be used.

Replies are listed 'Best First'.
Re: Can i Compare two images in perl ?
by BrowserUk (Pope) on May 30, 2011 at 17:28 UTC
    a way to compare two images by finding out the degree of difference b/w them

    That is a really open ended question that will need a lot of clarification.

    For example:

    1. What degree of similarity would you ascribe to these two images? A, B

      These two are from a 'spot the differences' competition and have 10 substantial differences. Elements have changed color; things have changed position.

      How similar do you want to consider the two?

    2. How about these two? A, B

      This is more subtle. The two images are identical in their content, but the color of every pixel in the picture is slightly different. So if you do a simple numerical comparison, they would be rated as 100% different.

      Do you want them assessed as 100% different?


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
      actually kind of both to some extent... actually they are graphs generated from some source and have background of many greyish curves but an average curve derived from the constituents is formed in a prominent colour, so i need to find similarity/difference(threshold level would do) between them even if a single colour channel is considered i think my purpose will be solved.
        they are graphs generated from some source and have background of many greyish curves but an average curve derived from the constituents is formed in a prominent colour,

        If you posted (offsite) a couple of examples. Say, one pair that you want considered substantially similar, and another that want considered substantially different, then you would likely get much better suggestions for how to approach the problem.


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.

        Can you not work with the data that was used to form the image rather than futsing about with image recognition techniques? Sounds like you are trying to apply a solution that is "easy" for humans therefore easy to express in a way people understand, but is very difficult to code. You may be much better describing the problem in a numeric domain which may be harder to think about, but will be much easier to code.

        True laziness is hard work
Re: Can i Compare two images in perl ?
by zentara (Archbishop) on May 30, 2011 at 17:04 UTC
    Some untested code, and I don't know if Image::Compare uses ImageMagick internally? :-)
    #!/usr/bin/perl use warnings; use strict; use Image::Compare; my $file1 = shift; #some jpegs, or png my $file2 = shift; my ( $cmp ) = Image::Compare->new(); $cmp->set_image1( img => $file1, type => 'png', ); $cmp->set_image2( img => $file2, type => 'png' ); $cmp->set_method( method => &Image::Compare::THRESHOLD, args => 25, ); #$cmp->set_method( # method => &Image::Compare::EXACT, # ); if ( $cmp->compare() ) { # The images are the same, within the threshold print "same\n"; } else { # The images differ beyond the threshold print "not same\n"; }

    I'm not really a human, but I play one on earth.
    Old Perl Programmer Haiku ................... flash japh

      Makefile.PL has requires 'Imager' => 0.54;, so the answer is no :)


      Enjoy, Have FUN! H.Merijn
Re: Can i Compare two images in perl ?
by marto (Bishop) on May 30, 2011 at 17:05 UTC
Re: Can i Compare two images in perl ?
by Khen1950fx (Canon) on May 30, 2011 at 17:06 UTC
    Image::Compare::IMAGE can help.

    Update: Image::Compare has Imager as a prereq---no magick that I could find.

Re: Can i Compare two images in perl ?
by bart (Canon) on May 30, 2011 at 18:06 UTC
    You want image processing features but not use an image processing library. Yeah, right.
Re: Can i Compare two images in perl ?
by BrowserUk (Pope) on May 31, 2011 at 14:58 UTC

    As an example of what can be achieved without "image processing".

    This simple script compares two images and produces a single xx.xxx% similarity figure:

    #! perl -slw use strict; use GD; GD::Image->trueColor( 1 ); my $im1 = GD::Image->new( $ARGV[ 0 ] ); my $im2 = GD::Image->new( $ARGV[ 1 ] ); my $raw1 = $im1->gd; my $raw2 = $im2->gd; my $xored = $raw1 ^ $raw2; my( $all, $diff ) = (0)x2; $all += 255, $diff += ord substr $xored, $_, 1 for 0 .. length( $xored + ) - 1; print $all, ' ', $diff; printf "The simlarity is %.3f%%\n", ( $all - $diff ) / $all * 100;

    And here are the results of applying that to my previous 'problem' examples.

    • The 'spot-the-differences' ballons A & B:
      C:\test\xx>..\907337 ballons1.jpg ballons2.jpg 672410265 62443267 The simlarity is 90.714%
    • The 'identical except slight color fade' ballons; A & A':
      C:\test\xx>..\907337 ballons1.jpg ballons1a.jpg 672410265 92011553 The simlarity is 86.316%
    • The two BrowserUk late period variations of "Red rectangle on white background"; X & Y:
      C:\test\xx>..\907337 1.png 2.png 244802805 241803 The simlarity is 99.901%
    • And perhaps a more poignant example. MicroArray1 & MicroArray2:
      C:\test\xx>..\907337 microarray1.jpg microarray2.jpg 340764405 41409302 The simlarity is 87.848%

      In this example, the second microarray is just a mirror image of the first for test purposes as I couldn't find two similarly size examples. The reflection means that the registration is probably not as good as you'd expect from a true comparison, but it serves its purpose to highlight the possibilities and downsides of the technique.

    The technique could be much improved with good examples and a clearer statement of requirements.


    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.

        That's interesting. But only 1/4 of the information required to tackle the problem.

        Only one pair of images, and no reference as to you would rate them--are they 2% similar or 98% similar?

        Isolating the pink in the images is relatively simple: cluster1 & cluster8.

        One problem is that the graphs have been produced using anti-aliasing. A process that trades accuracy for aesthetic appearance. Which means that if you try to subtract one image from another you get a big blurry streak of color: cluster1 - cluster8

        With some more processing it should be possible to retrieve a single, contiguous line from those fat, fuzzy, discontinuous streaks. Albiet that it might take several passes to do so.

        But the show stopper as far as achieving your single similarity figure is the lack of any indication of how to rate the two posted images for similarity.

        It is obvious that if the two lines, once reduced to continuous, single pixel wide lines, exactly overlaid each other, that would constitute 100% similarity. But how do you rate divergence?

        Possibilities:

        1. You might consider any two pixels that do not exactly align a percentage point of divergence.

          That is, in the following 10 pixel wide overlay:

          x o x o x o oxoxox o x o x

          Because X positions 4 through 7 overlap, that would be 40% similarity.

        2. Or, you might consider not only the fact that two pixels diverge, but also by how much they diverge.

          Meaning that this overlay would rate as having a higher similarity than the one above:

          xxx ooo oxoxox oo xx

          Even though they overlap to the same extent.

          Meaning that:

          xxxxxxxxxx oooooooooo

          Would have a much higher simlilarity rating than:

          xxxxxxxxxx oooooooooo

          Despite there being no overlap at all.

        So then the problem is, what do you consider to be 0% similarity? (Which is why I asked for two pairs of images and associated ratings in the first place.)


        Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
        "Science is about questioning the status quo. Questioning authority".
        In the absence of evidence, opinion is indistinguishable from prejudice.
Re: Can i Compare two images in perl ?
by Anonymous Monk on May 30, 2011 at 22:15 UTC

    Compress the images three times: image1.zip, image2.zip both.zip.

    Then calculate similarity = (size(image1.zip) + size(image2.zip)) / size(both.zip).

    That value will approach 2.0 as the source bitmaps become more similar. No image processing required!

      This is one of those internet myths that just persists.

      According to your formula, this image and this one ought to approach 2.0. They are to all intents and purposes identical.

      The actual result:

      C:\test>jimagezipcmp.pl adding: 1.png (160 bytes security) (deflated 90%) adding: 2.png (160 bytes security) (deflated 89%) adding: 1.png (160 bytes security) (deflated 90%) adding: 2.png (160 bytes security) (deflated 89%) 1.0272952853598

      Try it yourself:

      #! perl -slw use strict; use GD; sub rgb2n { unpack 'N', pack 'CCCC', 0, @_ } for my $n ( 1, 2 ) { my $im1 = GD::Image->new( 600, 400, 1 ); $im1->filledRectangle( 0, 0, 600, 400, rgb2n( 255, 255, 255 ) ); $im1->filledRectangle( 100, 100, 500, 300, rgb2n( 255 - $n, 0, 0 ) + ); open O, '>:raw', $n . '.png' or die $!; print O $im1->png; close O; } system q[zip 1.zip 1.png]; system q[zip 2.zip 2.png]; system q[zip 3.zip 1.png 2.png]; my $size1 = -s '1.zip'; my $size2 = -s '2.zip'; my $size3 = -s '3.zip'; print +( $size1 + $size2 ) / $size3;

      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.

        Those are PNGs, not uncomressed bitmaps.

        I certainly wouldn't expect that to work.

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://907337]
Approved by Corion
Front-paged by Corion
help
Chatterbox?
and !@monks...

How do I use this? | Other CB clients
Other Users?
Others cooling their heels in the Monastery: (2)
As of 2017-08-20 05:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Who is your favorite scientist and why?



























    Results (313 votes). Check out past polls.

    Notices?