Perl: best way to do longest prefix match (string)

Question

I have a list of around 5000 words. I want to find the longest prefix match among those words for a given word. For example, in my list I have :

1
121
12234
20345
21345

Now If I search for 12134 the result will be 121 (longest match). I know it can be done in different ways. But, what should be the most efficient way ?

Answer 1

#!/usr/bin/env perl

use strict;
use warnings;

my @prefixes = qw(
    1
    121
    12234
    20345
    21345
);

my $num = '12134';

my ($longest) = sort { length $b <=> length $a } grep { 0 == index $num, $_ } @prefixes;

print "$longest\n";

Outputs

121

Answer 2

You can get the regex engine to do this for you. It should be very fast

I hope it's obvious that the regex pattern needs to be built only once, and can then be used to find the longest prefix for any number of target strings

use strict;
use warnings;
use 5.010;

my @prefixes = qw/
    1
    121
    12234
    20345
    21345
/;

my $target = 12134;

my $re = join '|', sort { length $b <=> length $a } @prefixes;
$re = qr/(?:$re)/;

say $1 if $target =~ /^($re)/;

output

121

---

Update

Alternatively, the Tree::Trie module can be used to implement the trie search that the regex engine provides like this

use strict;
use warnings;
use 5.010;

use Tree::Trie;

my @prefixes = qw/
    1
    121
    12234
    20345
    21345
/;

my $target = 12134;

my $trie = Tree::Trie->new({ deepsearch => 'prefix' });
$trie->add(@prefixes);

say scalar $trie->lookup($target);

The output, of course, is the same as that of the previous code