AppleScript C Perl Shell Xcode Other

Compare images in a folder, find identical

Post Reply
coding / perl     Views: 3097Prev .. Next
Compare images in a folder, find identicalPosted: Friday, October 25, 2013 [20:50:24] - 1
rootPosted by:rootMember Since:
June 16 2010
Posts: 128
When processing bulk images or collecting them - often there are tons of duplicates.
Weeding them out manually could be an impossible task.
Here is a quick Perl/ImageMagick/NetPBM hack:
View Code#!/usr/bin/perl
## GET VARIABLES FIRST
print "Choose Folder to compare images: ";
$fromdir = <STDIN>;chomp $fromdir;$fromdir =~ s/\s+$//;$fromdir =~ s/\/+$//;
unless(-d $fromdir) {print "No folder $fromdir found\n";exit(0);}
print "Choose Folder to save results: ";
$svres = <STDIN>;chomp $svres;$svres =~ s/\s+$//;$svres =~ s/\/+$//;
unless(-d $svres) {print "No folder $svres found\n";exit(0);}
$imgdir = $fromdir;
$rescmp = $svres.'/test.comp.gif'; ## FOR WHATEVER REASON ImageMagick wouldn't process without saved-file
unless(-f "$svres/images.sizes.txt") { ################## COMPILE TXT FILE IF NEEDED #######
@all = glob("$imgdir/*");

## GET PHYSICAL FILE SIZES FIRST
foreach $f (@all) {
if($f =~ m/\/sm\./) {next;}
$size = (stat ("$f"))[7];$origsize=$size;&getlowest; ## GET SIZE WITH ZERO ON THE END TO STORE CLOSE TO IDENTICAL FILES
$sifiles{$size}{$f}=$origsize;
}
## NOW SAVE THE DATA IN A TEMP FILE WITH FILE SIZE AND IMAGE SIZE
open(TXT,">$svres/images.sizes.txt");
foreach $size (sort keys(%sifiles)) {
print "$size\:\n";
foreach $f (sort keys %{$sifiles{$size}}) {
print "\t$f\t$sifiles{$size}{$f}\n";
$imdo = `anytopnm $f`;($width,$height) = &pnmsize($imdo);$imdo=''; ## GETTING IMAGE SIZE
print TXT "$size\t$f\t$sifiles{$size}{$f}\t$width,$height\n";
}
} ## END FOREACH
close(TXT);%sifiles=();
} ######################################################### COMPILE TXT FILE IF NEEDED #####

unless(-f "$svres/im.exacts.txt") { ################################# COMPILE EXACTS FILE ################
$d = `cat $svres/images.sizes.txt`;@all = split(/\n/,$d);$d='';
foreach $l (@all) {
($s,$f,$os,$wh) = split(/\t/,$l);
unless(-f $f) {next;}
$check{$s}{$wh}{$f}=1; ## HASH BY: FILE SIZE/IMAGE SIZE
} ## FOREACH LINE END

foreach $s (sort num keys(%check)) { ## FILE SIZE
foreach $wh (keys %{$check{$s}}) { ## IMAGE SIZE
print "$s - $wh:\n";$nof='';
foreach $f (%{$check{$s}{$wh}}) { ## EACH FILE
unless(-f $f) {next;}$nof++;
push @gf, $f;
print "\t\"$f\"\n";
} ## FOREACH FILE END
if($nof > 1) {
foreach $f (@gf) {
if(-f $f) {$docompare{$s}{$wh}{$f}=1;}
}
}
@gf=();
} ## FOREACH W AND H END
} ## FOREACH SIZE END
%check=();
print "\n\n";
foreach $s (sort num keys (%docompare)) {
foreach $wh (keys %{$docompare{$s}}) {
@ard = keys %{$docompare{$s}{$wh}};$noin=@ard;
if($noin < 1) {next;} ## IF LESS THAN 1 IMAGE - NEXT
unless($noin) {next;} ## IF EMPTY - NEXT
print "$s - $wh:\t$noin\n";
foreach $f (keys %{$docompare{$s}{$wh}}) {
unless(-f $f) {next;} ## SKIP INVALID FILES
print "\t$f\n";
push @cmpr, $f; ## COLLECT FILES TO COMPARE
} ## FOREACH FILE END
&comparethem; ## ACTUALLY COMPARE IMAGES
@cmpr=();
} ## FOREACH W H END
} ## FOREACH SIZE END
%docompare=(); ## SAVE RESULTS IN A FILE
open(EXC,">$svres/im.exacts.txt");
foreach $f (sort keys (%exacts)) {
@more = keys %{$exacts{$f}};$nmore=@more;
if($nmore < 1) {next;}
print EXC "$f";
foreach $sf (sort keys %{$exacts{$f}}) {print EXC "\t$sf";}
print EXC "\n";
} ## FOREACH 1 END
close(EXC);
} ################################################################### COMPILE EXACTS FILE ################

## ACTUALLY COMPARE IMAGES
sub comparethem { #####
$from = shift(@cmpr);
foreach $cf (@cmpr) {
unless($cf) {next;}
if($cf eq $from) {next;}
$nmb=`compare -metric AE -fuzz 5% $from $cf $rescmp 2>&1`; ## compare does not report to STDOUT - force it with "2>&1"
$nmb =~ s/\D//g; ## result comes-out with a newline - delete anything non-digit
print "$from $cf\t\"$nmb\"\n";
if($nmb == 0) {$nmb--;} ## compare result: 0 - exact match, more than 0 - no match
if($nmb < 1) {
unless($exacts{$cf}{$from}) {$exacts{$from}{$cf}=1;
print "\tWritten: $from\t$cf\n";
}
}$nmb=2;
}
} ## END COMPARE ######

sub getlowest { ## GET THE FILE SIZES WITH ZERO ON THE END i.e. file size 17684 converted to 17680
while(1) {$size =~ s/\d$/$&/;$lst=$&;
if($lst < 1) {return $size;last;}
$size--;
}
} ## END GET LOWEST

sub pnmsize { ## GET THE IMAGE SIZE IN PIXELS
my($pnm) = @_;
my ($width,$height);
($width,$height)=$pnm=~m#^P\d+\s+(\d+)\s+(\d+)\s+\d+\s#ois;
unless($width && $height) {($width,$height)=$pnm=~m#^P\d{1,4}\s+(\d+)\s{1,3}(\d+)\s#ois;}
return ($width,$height) if ($width && $height);
} ## END SUB PNM SIZE ##

sub num {$a <=> $b;} ## SORT THINGS

Script runs fine on folders with 100,000 images. On the end you'll get im.exacts.txt file with exact matches.
This is not perfect, but it works.There's no place like ~
RE: Compare images in a folder, find identicalPosted: Friday, October 25, 2013 [20:56:47] - 2
rootPosted by:rootMember Since:
June 16 2010
Posts: 128
To read the output visually on Mac:
View Code#!/usr/bin/perl
print "Choose file with images information: "; ## your im.exacts.txt file
$fromfile = <STDIN>;chomp $fromfile;$fromfile =~ s/\s+$//;$fromfile =~ s/\/+$//;

unless(-f $fromfile) {print "$fromfile not present\n";exit(0);}
$d = `cat $fromfile`;@all = split(/\n/,$d);$d='';
foreach $l (@all) {
@lz = split(/\t/,$l);$origfl = pop(@lz);@fpr = split(/\//,$origfl);$orfname=pop(@fpr);$wrdir=join'/',@fpr;
unless($origfl) {next;}
`open $origfl`;
print "Original file: $origfl\t$orfname\n";
foreach $f (@lz) {
unless($f) {next;}
`open $f`;
} ## FOREACH LINE END
print "See more? \[y\]: ";
$forw = <STDIN>;chomp $forw;
if($forw) {exit(0);}
} ## FOREACH LINE END

It uses "open" which I am not sure present on other UNIX flavors.There's no place like ~
coding / perlPrev .. Next
 
Post Reply
Home - Coding: AppleScript C Perl Shell Xcode Other