Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

Re^2: Challenge: "Words" In A String

by oshalla (Deacon)
on Sep 19, 2008 at 14:18 UTC ( #712528=note: print w/ replies, xml ) Need Help??


in reply to Re: Challenge: "Words" In A String
in thread Challenge: "Words" In A String

A trie ! Beautiful :-)

For repeated use it's obvious to consider preprocessing the dictionary into the trie, and reading that each time.

Of interest is how beautifully this trie will compress, by folding the matching sub-tries. Code to illustrate this given below. On my machine the result is:

Loading dictionary '2of4brif.txt'... done -- 1.30 Secs Writing trie '2of4brif.trie'... 22599/138676 done -- 1.35 Secs Reading trie '2of4brif.trie'... done -- 0.25 Secs Walking the tries... done -- 1.94 Secs Original trie is: 27.1M, new trie is: 5.4M
showing the degree of compression (22599/138676), and that reading the trie takes 0.25 Secs where loading the dictionary takes 1.30 Secs. Result :-)

(The memory footprint is also reduced, but that's not hugely significant.)


use strict; use warnings; use constant DICT => "2of4brif.txt"; use constant TRIE => "2of4brif.trie" ; sub get_cpu { my $t = (times)[0] ; if (@_) { $t = sprintf('%4.2f Secs', $t - $_[0]) ; } ; return $t ; } ; my $took ; print STDERR "Loading dictionary '", DICT, "'" ; $took = get_cpu() ; my $trie = load_dict(DICT) ; print STDERR "... done -- ", get_cpu($took), "\n" ; print STDERR "Writing trie '", TRIE, "'" ; $took = get_cpu() ; my ($now, $was) = write_trie(TRIE, $trie) ; print STDERR "... done -- ", get_cpu($took), "\n" ; print STDERR "Reading trie '", TRIE, "'" ; $took = get_cpu() ; my $check = read_trie(TRIE) ; print STDERR "... done -- ", get_cpu($took), "\n" ; print STDERR "Walking the tries" ; $took = get_cpu() ; walk('', $trie, $check) ; print STDERR "... done -- ", get_cpu($took), "\n" ; use Devel::Size qw(total_size) ; printf STDERR "Original trie is: %3.1fM, new trie is: %3.1fM\n", total_size( $trie)/(1024 * 1024), total_size($check)/(1024 * 1024) ; #=================================================================== +====================== # Loading the Dictionary into the Trie. sub load_dict { my ($d_name) = @_ ; # Constructs a trie from the dictionary. open(my $fh, '<', $d_name) or die("Unable to open dictionary '$d_name': $!\n"); my $trie = undef ; while (<$fh>) { s/\s+$// ; # chomp; my $p = \$trie; for ( split(//, $_), '!' ) { $p = \( $$p->{$_} ) ; } } return $trie ; } #=================================================================== +====================== # Writing the Trie. my %node_map ; my $idx ; my $node_count ; sub write_trie { my ($t_name, $trie) = @_ ; open(my $fh, '>', $t_name) or die("Unable to create trie '$t_name': $!\n"); $node_count = 0 ; $idx = 1 ; # Index 0 reserved for what '!' points at ! %node_map = ('!' => "$idx") ; # Preset end of word node write_node($fh, $trie) ; close $fh ; return ($idx, $node_count) ; } ; sub write_node { my ($fh, $node) = @_ ; $node_count++ ; my @chs = sort keys %$node ; # NB '!' sorts to the front ! my @n = $chs[0] eq '!' ? (shift @chs) : () ; foreach my $ch (@chs) { my $p = write_node($fh, $node->{$ch}) ; push @n, $ch.$p ; } ; my $n = join(' ', @n) ; my $p ; unless (defined($p = $node_map{$n})) { $p = $node_map{$n} = sprintf('%X', ++$idx) ; # Assign new index and record print $fh $n, "\n" ; # Output new node } ; return $p ; } ; #=================================================================== +====================== # Reading the Trie. my @nodes ; sub read_trie { my ($t_name) = @_ ; open(my $fh, '<', $t_name) or die("Unable to open trie '$t_name': $!\n"); @nodes = (undef, {'!' => undef}) ; while (<$fh>) { push @nodes, { map { my ($c, $p) = unpack('AA*', $_) ; ($c, $nodes[hex($p)]) } split } ; # Note hex('') += 0 } ; close $fh ; my $trie = pop @nodes ; @nodes = () ; return $trie ; } ; #=================================================================== +====================== # Walk two tries to check they are identical sub walk { my ($w, $ra, $rb) = @_ ; my @ac = sort keys %$ra ; my @bc = sort keys %$rb ; if (@ac != @bc) { die "node length mismatch \@ '$w': (@ac) vs (@bc +)" ; } ; for my $i (0..$#ac) { if ($ac[$i] ne $bc[$i]) { die "node mismatch \@ '$w': (@ac) vs ( +@bc)" ; } ; } ; foreach my $ch (@ac) { my $ad = $ra->{$ch} ; my $bd = $rb->{$ch} ; if ($ch eq '!') { if (defined($ad)) { die "'!' with defined down ($ad) in 'a' \@ + '$w'" ; } ; if (defined($bd)) { die "'!' with defined down ($bd) in 'b' \@ + '$w'" ; } ; } else { walk($w.$ch, $ad, $bd) ; } ; } ; } ;


Comment on Re^2: Challenge: "Words" In A String
Select or Download Code

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://712528]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (7)
As of 2014-12-29 03:24 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    Is guessing a good strategy for surviving in the IT business?





    Results (184 votes), past polls