#!/usr/bin/perl
#
#    multi-string-match.pl <FName>
#
#    Grind through a set of strings, and keep only the ones that don't contain
#    any of the others as a substring.  FName is a file containing a list of 
#    strings, and if null, we'll use our test data.
#
#    Inspired by perlmonks node 906020, and the Knuth-Morris-Pratt algorithm.
#
use strict;
use warnings;
use feature ':5.10';

# function is 10.67 chars wide, so need to round up, or we can't find partials 
# (previous state will linger, so we can't find 'em!)
my $hashwidth = 11;

# our alphabet
my %xlat = (A=>1, C=>2, G=>3, T=>4, N=>0);

my @unique;
my @candidates;
my %MatchKeys;

my $fname = shift;
open my $FH, '<', $fname or die;
@candidates = <$FH>;

@candidates =
        grep { /^[ACGTN]+$/ } # delete the comments
        map { s/^\s+//; s/\s+$//; $_ }
        @candidates;

my $start = time;
@candidates = sort { length($a) <=> length($b) || $a cmp $b } @candidates;

my (@keypath, $t); #, @chars, @keypath);

my $cnt_dup=0;
CANDIDATE:
while ($t = shift @candidates) {
    my $h = 0;
    my $keywidth=0;
    @keypath=();
    my $rMatchKeys = \%MatchKeys;
    my $fl_partial=-1;
    my $l = length($t);
    while ($keywidth < $l) {
        $h = hash(substr($t,$keywidth,1), $h);
        ++$keywidth;
        if ($keywidth % $hashwidth == 0) {
            push @keypath, $h;
        }

        if ($fl_partial < 0) {
            # No current partial match
            if (exists $MatchKeys{$h}) {
                $rMatchKeys = $$rMatchKeys{$h};
                $fl_partial = $keywidth;
            }
        }
        else {
            if ( ($keywidth - $fl_partial) % $hashwidth == 0 ) {
                $rMatchKeys = exists($$rMatchKeys{$h}) ? $$rMatchKeys{$h} : undef;
            }
            elsif (exists($$rMatchKeys{REM}) and exists($$rMatchKeys{REM}{$h})) {
                ++$cnt_dup;
                next CANDIDATE;
            }
        }
    }
    my $ar = [ $h, $keywidth % $hashwidth ];

    ### Add the path to %MatchKeys
    $rMatchKeys = \%MatchKeys;
    while (my $r = shift @keypath) {
        $$rMatchKeys{$r} = { } if !exists $$rMatchKeys{$r};
        $rMatchKeys = $$rMatchKeys{$r};
    }
    $$rMatchKeys{REM} = { } if !exists $$rMatchKeys{REM};
    if (exists($$rMatchKeys{REM}{$$ar[0]})
    and $$ar[1] == $$rMatchKeys{REM}{$$ar[0]}) {
        ++$cnt_dup;
        next CANDIDATE;
    }
    $$rMatchKeys{REM}{$$ar[0]} = $$ar[1];
    push @unique, $t;
}
my $end = time - $start;
print scalar(@unique), " unique items\n";
print "$cnt_dup rejected.\n";
print "$end seconds.\n";

sub hash {
    my ($curchar, $prevhash) = @_;
    $prevhash = ($prevhash * 8 + $xlat{$curchar}) & 0xffffffff;
}