Ищем дубликаты фотографий с помощью Perl

За 20 лет у меня скопилось несколько тысяч фотографий: праздники, свадьбы, рождение детей, и прочее, прочее... Понятно что снималось всё это на разные цифровики, присылалось почтой, сливалось через ICloud и GDrive, FTP, самба и т.п. По итогу всё это превратилось в дикий хаос папок и что-то найти в архиве можно было только с большим трудом.

В какой-то момент мне нечем было заняться это надоело и я за пару дней накидал скрипт, который всё это безумие раскидал по годам->месяцам->дням. Понятно, что и эта задача не такая простая как кажется на первый взгляд, что например делать с фото, у которых дата создания 1970? Но в этой статье я хотел бы рассказать о другом.

Так вот, во многих папках у меня получилось по 2 и более копий одной и той же фотографий. Как так получилось? Я могу привести кучу вариантов ответа на этот вопрос, но копии от этого сами никуда не рассосутся.

Быстренько погуглив, нашел несколько методов для сравнения фото на идентичность.

Кроме тех, что вы найдете по ссылке, приведу еще пару примеров:

библиотека GD::Image

  my $im1 = GD::Image->new( $image1 );
  my $im2 = GD::Image->new( $image2 );

  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;

  my $pr = ( $all - $diff ) / $all * 100;
  print $all, ' ', $diff;
  printf "The simlarity is %.3f%%n", ( $all - $diff ) / $all * 100;

В данном случае используется сравнение, что называется "в лоб", рассчитывается процент исключенных побитово операндов в выражении $xored = $raw1 ^ $raw2 .

библиотека Image::Compare

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 "samen";
}
else {
# The images differ beyond the threshold
  print "not samen";
}

Image::Compare написана как раз для сравнения изображений, использует разные методы и имеет кучу параметров. С нужной мне задачей она прекрасно справляется, однако функционал библиотеки гораздо шире. В "недра" библиотеки я не заглядывал, по описанию используется анализ pixel-by-pixel.

Итак, у меня есть рабочие методы сравнения и я даже успел протестировать какой из них более производительный. Но... Вот именно производительность меня и не устраивает, ведь даже самое быстрое сравнение только двух фото занимает 2-3 секунды в зависимости от разрешения сравниваемых фотографий. А если изображений несколько тысяч?

Естественно, видя, как работает поиск по изображениям в яндекс и гугл, я ожидал совсем другого. Не унываем, ищем дальше.

библиотека Image::Hash

Итак, что умеет эта библиотека. Цитирую "calculate the average hash, difference hash and perception hash an image". Кроме того, она поддерживает несколько модулей для работы с изображениями: GD, Image::Magick и Imager. Ага, уже интересно, многие советуют для сравнения использовать ImageMagick, а мне как раз его ставить совсем лениво, уж больно много он тянет за собой зависимостей(я поэтому и не стал приводить с ним примеры), а тут замечательные альтернативы. Попробуем:

use Image::Hash;
use GD;
 
my $ihash = Image::Hash->new('/spool/Photo/2015/01/06/00_17_50.jpeg');
 
# Возьмём только ahash
my $a = $ihash->ahash();
 
print "1 Ph: $an";

#Второе изображение точная копия первого
$ihash = Image::Hash->new('/spool/Photo/2015/01/06/00_17_50_1082302.jpeg');
$a = $ihash->ahash();
print "2 Ph: $an";

#Ну и для чистоты эксперемента...
$ihash = Image::Hash->new('/spool/Photo/2015/01/06/00_17_55.jpeg');
$a = $ihash->ahash();
print "3 Ph: $an";

смотрим результат:

1 Ph: C5D74745060CFFFF
2 Ph: C5D74745060CFFFF
3 Ph: 036C040C0878FFFF

Совсем другое дело! Ну и для закрепления быстренько напишем скрипт, который будет проверять файлы в папке на "одинаковость":

use File::stat; #Добавим проверку на размер файла
use Image::Hash;
use GD;

my %args;
foreach my $vl (@ARGV) {
        my ($key,$value) = split(/=/, $vl);
        $args{$key} = $value;
}

my $dir = $args{DIR} or die "Please specify the foldern";
my @files = glob( $dir . '/*.jpeg' );
my %fhash;
my @results;

for my $val (@files){
    my $ihash = Image::Hash->new($val);
    # Получаем размер проверяемого файла
    my $fsize = stat($val)->size;
    # Получаем хеш файла
    my $a = $ihash->ahash();

#Тут немного распишу:
# 1.проверяем, если такого хеша ранее не было 
# 2.проверяем, если был хеш, то сравниваем размеры файла,
# выигрывает файл большего размера
# По итогу проверки файл с уникальным хешем попадает в %fhash,
# а дубликат в массив на удаление 
if ( !exists $fhash{$a} || (exists $fhash{$a} && $fhash{$a}[1] <=  $fsize) ) {
        $fhash{$a} = [ $val, $fsize];
    }
    else {
        push @results, $val;
    }
}

#Ну и удаляем дубликаты с запросом, будет выведен список файлов на удаление.
if ( @results > 0 ) {
    print 'Total ' . scalar(@results)  . " double files:n" . join("n", sort @results) . "n";
    print "Delete files(Y/N): ";
    my $ans = <STDIN>;
    chomp $ans;
    if ( $ans eq 'Y' ) {
        foreach my $dfile ( @results ) {
            unlink $dfile;
        }
        print 'Check complete! Result: ' . scalar(@results) . " img removedn";
    }
}
else {
    print "Goodbye!n"
}

Погоняем по тестовой папке... Ну вот. За 10 секунд "прочесало" 60 изображений, и безошибочно нашло все дубликаты.

Пока дебажил скрипт, замечаю ещё одну полезную вещь, если изображения не являются полной копией, а ОЧЕНЬ похожи, то их хеши различаются в 1-2 разряда. А таких у меня тоже немало, я так понимаю снимали в многокадровом режиме, но почему-то сохранились все исходники.

Тут же возникает идея слить хеши в БД и организовать поиск по фото. Для понимания привожу пример сравнения двух изображений:

1 Ph: ECFCF4F4E4C4C4C4
2 Ph: E4FCFCFCC4D4C4C4

То есть, даже несмотря на огромные отличия, в том числе и разное сотношение сторон, хеши очень похожи. Но это уже история для отдельной статьи.

В заключение

По итогу простая сортировка фотографий вылилась у меня в написание полноценной фотогалерии, с бекендом на Perl и фронтом на JS, обработчиком добавления новых фото с автосортировкой и проверкой на дубликаты.

Если Вас зантересовал этот метод, но Вы не являетесь фанатом Perl, то спешу обрадовать, есть подобные библиотекии для других ЯП: Python и класс для PHP.