compress_fingerprints

   1 #!/usr/bin/perl
   2 use strict;
   3 use warnings;
   4 use open ':utf8';
   5
   6 use Digest::SHA1 qw(sha1_base64);
   7 use Getopt::Long;
   8
   9 my $conf  = {}; # configuration hashref
  10 initialize($conf);
  11
  12 my %fps  = (); # records matching each fingerprint (and the lead)
  13 my %recs = (); # fingerprints belonging to each record
  14
  15 open FP, '<', $ARGV[0] or die "Can't open input file: $!\n";
  16
  17 my $count = 0;
  18 my $total = `wc -l $ARGV[0]'`;
  19
  20 print "Loading and ranking fingerprints\n";
  21 while (<FP>) {
  22     my @fields = split "\t", $_;
  23     my $fp = populate_fingerprint(@fields);
  24     rank_fingerprint($fp);
  25 }
  26 print "Writing results ($count lead records) to disk\n";
  27 dump_records();
  28
  29
  30
  31 sub populate_fingerprint {
  32     my @fields = @_;
  33     my %fp = (); # zero fingerprint hash each time thru
  34
  35     # populate fp hash -- first the simple data
  36     $fp{compact} = shift @fields;
  37     $fp{json}    = shift @fields;
  38     $fp{id}      = shift @fields;
  39     # then smash everything else together, remove non-Roman characters, and
  40     # generate a SHA1 hash to represent it
  41     my $stripped = join('', @fields);
  42     $stripped   =~ s/[^A-Za-z0-9]//g;
  43     $fp{sha1}    = sha1_base64($stripped);
  44
  45     # populate records hash
  46     $recs{ $fp{id} }{ $fp{sha1} } = {};
  47
  48     return \%fp;
  49 }
  50
  51
  52 sub rank_fingerprint {
  53     my ($fp) = @_;
  54
  55     my $sha1 = $fp->{sha1};
  56     my $id   = $fp->{id};
  57     my $islead = $recs{$id}{lead};
  58
  59     # only process records which haven't already been set as a sub
  60     unless (defined $islead and $islead) {
  61         unless ($fps{$sha1}) {
  62             # haven't seen this fp before. create a new hashref with the current
  63             # record as lead
  64             $fps{$sha1} = { lead => { id    => $id,
  65                                       score => $fp->{compact} },
  66                             recs => [ $id ] };
  67             $recs{$id}{$sha1}{lead} = 1;
  68             $count++;
  69         } else {
  70             # have seen this fp. push record id onto matchlist
  71             push @{ $fps{$sha1}{recs} }, $id;
  72             if ($fp->{compact} > $fps{$sha1}{lead}{score}) {
  73                 # and set this record as lead if it scores higher than current lead
  74                 $recs{ $fps{$sha1}{lead}{id} }{lead} = 0; # unset current
  75                 $recs{ $id }{lead} = 1;                   # set new as lead
  76                 $fps{$sha1}{lead}{id}    = $id;
  77                 $fps{$sha1}{lead}{score} = $fp->{compact};
  78             }
  79         }
  80     }
  81 }
  82
  83
  84 =head2 dump_records
  85
  86 Writes out a 2-column file of lead and subordinate records.
  87
  88 =cut
  89
  90 sub dump_records {
  91     my %used = ();
  92     open OUT, '>', $conf->{output}
  93       or die "Can't open ", $conf->{output}, "$!\n";
  94     for my $id (keys %recs) {
  95         next unless $recs{$id}{lead};
  96         for my $sha1 ( keys %{$recs{$id}} ) {
  97             for my $subid ( @{$fps{$sha1}{recs}} ) {
  98                 next if ($id == $subid);
  99                 next if defined $used{$subid};
 100                 $used{$subid} = 1;
 101                 print OUT "$id\t$subid\n";
 102             }
 103         }
 104     }
 105 }
 106
 107 sub initialize {
 108     my ($c) = @_;
 109     my @missing = ();
 110
 111     # set mode on existing filehandles
 112     binmode(STDIN, ':utf8');
 113
 114     my $rc = GetOptions( $c,
 115                          'output|o=s',
 116                          'help|h',
 117                        );
 118     show_help() unless $rc;
 119     show_help() if ($c->{help});
 120
 121     my @keys = keys %{$c};
 122     show_help() unless (@ARGV and @keys);
 123     for my $key ('output')
 124       { push @missing, $key unless $c->{$key} }
 125     if (@missing) {
 126         print "Required option: ", join(', ', @missing), " missing!\n";
 127         show_help();
 128     }
 129 }
 130
 131 sub show_help {
 132     print <<HELP;
 133 Usage is: compress_fingerprints -o OUTPUTFILE INPUTFILE
 134 HELP
 135 exit;
 136 }