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

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

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

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

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

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

библиотека 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 ^[2] написана как раз для сравнения изображений, использует разные методы и имеет кучу параметров. С нужной мне задачей она прекрасно справляется, однако функционал библиотеки гораздо шире. В "недра" библиотеки я не заглядывал, по описанию используется анализ 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 разряда. А таких у меня тоже немало, я так понимаю снимали в многокадровом режиме ^[3], но почему-то сохранились все исходники.

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

1 Ph: ECFCF4F4E4C4C4C4
2 Ph: E4FCFCFCC4D4C4C4

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

В заключение

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

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