in reply to Add-A-Gram Performance
#!perl use strict; use Data::Dumper; $|++; my %WordTree = (); my %WordLengths = (); my $LongWordLength = 1; open (DATA, "Word.txt"); while (<DATA>) { chomp; my $Word = $_; my $Length = length($_); next if $Length < 3; $LongWordLength = $Length if ($LongWordLength < $Length); push (@{$WordLengths{$Length}}, $Word); } print "Finished reading Data\n"; close (DATA); for (my $CurrentLength = 3; $CurrentLength <= $LongWordLength; $Curren +tLength++) { print "Working on words of length $CurrentLength\n"; my ($Word) = ""; foreach $Word (@{$WordLengths{$CurrentLength}}) { my (@SortedLetters) = sort split //, $Word; if ($CurrentLength > 3) { my $TempWord = ""; my @SplicedLetters = ""; my $MatchFlag = 0; for (my $Splice = 0; $Splice <= $#SortedLetters; $Splice++ +) { @SplicedLetters = @SortedLetters; splice(@SplicedLetters, $Splice, 1); $TempWord = join '', @SplicedLetters; if (exists($WordTree{$#SortedLetters}->{$TempWord})) { if (! exists($WordTree{$CurrentLength}->{join '', +@SortedLetters})) { push (@{$WordTree{$CurrentLength}->{join '', @ +SortedLetters}}, $Word); push (@{$WordTree{$CurrentLength}->{join '', @ +SortedLetters}}, @{$WordTree{$CurrentLength - 1}->{join ' +', @SplicedLetters}}); } last; } } } else { if (! exists($WordTree{3}->{join '', @SortedLetters})) { push (@{$WordTree{3}->{join '', @SortedLetters}}, $Wor +d); } } } } my (@LongestMatch) = sort {$a<=>$b} keys %WordTree; my $NotFoundLongest = 1; while ($NotFoundLongest && $#LongestMatch > 1) { if (keys %{$WordTree{$LongestMatch[$#LongestMatch]}} > 0) { print "The longest length is $LongestMatch[$#LongestMatch]\n"; print Dumper $WordTree{pop @LongestMatch}; $NotFoundLongest = 0; } pop @LongestMatch; }
|
|---|