#!/usr/bin/perl -w
#file://letrie.pl
use strict;
$\="\n";
my %T=();

for my $word( qw/ aba abba abbda abbaracadabra bam bamara barbara / ) 
+{
    print $word;

    my $R = \%T;
    my $C = -1;
    my( @word ) = $word =~ m{.}g;
    my $p = "";
    while(++$C < @word) {
        $p  = $word[$C];
        if(exists $R->{$p}) {
            if(ref $R->{$p}) {
                $R = $R->{$p};
            } else {
                $R = $R->{$p} = {};
            }
        }else{
            $R = $R->{$p} = {};
        }
    }

    $R->{"\\NULL"}=1; # for exact match testing

}#endof for
use Data::Dumper;
$Data::Dumper::Indent=1;
$Data::Dumper::Purity=1;
$Data::Dumper::Quotekeys=1; 
print Dumper \%T;
print "Is 'abba' in a trie?  ",in_a_trie(\%T,'abba');
print "Is 'abbda' in a trie? ",in_a_trie(\%T,'abbda');
print "Is 'abbdr' in a trie? ",in_a_trie(\%T,'abbdr');
print "Is 'a' in a trie?     ",in_a_trie(\%T,'a');
print "Is 'b' in a trie?     ",in_a_trie(\%T,'b');
print "Is 'ba' in a trie?    ",in_a_trie(\%T,'ba');
print "Is 'bam' in a trie?   ",in_a_trie(\%T,'bam');
print "Is 'fsck' in a trie?  ",in_a_trie(\%T,'fsck');
exit;

sub in_a_trie {
    my( $T, $W ) = @_;
    my $R = 0;
    my $SH = "";

    for $SH ($W =~ m{.}g) {
        if(exists $T->{$SH} ) {
            $T = $T->{$SH};
            $R++;
        } else {
            return 'no';
        }
    }

    return ($R ? 'yes' : 'no').' '
          .(ref $T and $T->{"\\NULL"} ? 'exact' : 'partial' );
}

__DATA__

aba
abba
abbda
abbaracadabra
bam
bamara
barbara
$VAR1 = {
  'a' => {
    'b' => {
      'a' => {
        '\\NULL' => 1
      },
      'b' => {
        'a' => {
          '\\NULL' => 1,
          'r' => {
            'a' => {
              'c' => {
                'a' => {
                  'd' => {
                    'a' => {
                      'b' => {
                        'r' => {
                          'a' => {
                            '\\NULL' => 1
                          }
                        }
                      }
                    }
                  }
                }
              }
            }
          }
        },
        'd' => {
          'a' => {
            '\\NULL' => 1
          }
        }
      }
    }
  },
  'b' => {
    'a' => {
      'm' => {
        '\\NULL' => 1,
        'a' => {
          'r' => {
            'a' => {
              '\\NULL' => 1
            }
          }
        }
      },
      'r' => {
        'b' => {
          'a' => {
            'r' => {
              'a' => {
                '\\NULL' => 1
              }
            }
          }
        }
      }
    }
  }
};

Is 'abba' in a trie?  yes exact
Is 'abbda' in a trie? yes exact
Is 'abbdr' in a trie? no
Is 'a' in a trie?     yes partial
Is 'b' in a trie?     yes partial
Is 'ba' in a trie?    yes partial
Is 'bam' in a trie?   yes exact
Is 'fsck' in a trie?  no
[download]

 

______crazyinsomniac_____________________________ Of all the things I've lost, I miss my mind the most. perl -e "$q=$_;map({chr unpack qq;H*;,$_}split(q;;,q*H*));print;$q/$q;"