sift_wrap.pl

#!/usr/bin/perl
use strict;
use warnings;

# $ ./sift_wrap.pl nantoka.jpg 4
# This script is a Vlfeat no sift command no wrapper desu.
# pgm ja nakattara convert de henkan simasu.
# 128 jigen no vector no youso ha sorezore 0-255 no suuchi nanode
# sono range wo chidimeru option ga aru. tatoeba 0-3 nara 4 to shitei suru.
# sitei sinakattara sift command no kekka wo haku.
# sitei attara gazou ni fukumareru sosei no hindo wo yaml de haku yo.
# tempfile no tsukaikata ga shoboi node parallel de tsukau no ha kowai desu ne.

use File::Temp;
use File::Slurp;
use POSIX;

use YAML;
use List::Util qw( max );
use Digest::MD5 qw( md5_hex );

# TODO: sonouchi naosu
my $sift = '/usr/local/bin/sift';
my $convert = '/opt/local/bin/convert';
my $ln = '/bin/ln';
my $tempdir = '/tmp';

my $filename = shift or die 'no filename';
my $option = shift;
my $threshold = shift || 0;

my $picture_temp = File::Temp::tempnam($tempdir, '').'.pgm';

if ($filename !~ /\.pgm/) {
    system("$convert \"$filename\" -geometry 200x200 \"$picture_temp\"");
}
else {
    system("$ln -s \"$filename\" \"$picture_temp\"");
}

my $result_temp = File::Temp::tempnam($tempdir, '');
system("$sift -o \"$result_temp\" \"$picture_temp\"");

my @result_lines = read_file $result_temp;
unlink $result_temp;
unlink $picture_temp;

if (defined $option && $option =~ /^\d+$/) {
    my $acc = int($option);
    my %feats;
    map {
        chomp;
        my $line = $_;
        my @data = split /\s+/, $line;
        my @data_x;
        for my $i (4..131) {
            my $value = floor($data[$i]/(256/$acc));
            if ($value > $threshold) {
                push @data_x, $value;
            }
        }
        my $feat = md5_hex(unpack("H*", pack("C*", @data_x)));
        $feats{$feat} ||= 0;
        $feats{$feat}++;
    } @result_lines;

    my $max = max(values %feats) || 1;
    my %newfeats = map {+($_, $feats{$_} / $max)} keys %feats;

    use YAML;
    print YAML::Dump \%newfeats;
    exit;
}

print @result_lines;