Beefy Boxes and Bandwidth Generously Provided by pair Networks
Do you know where your variables are?
 
PerlMonks  

Re: Re: Re: Re: Add-A-Gram Performance

by smgfc (Monk)
on Feb 05, 2002 at 06:58 UTC ( [id://143370]=note: print w/replies, xml ) Need Help??


in reply to Re: Re: Re: Add-A-Gram Performance
in thread Add-A-Gram Performance

Thank you for your help. While I didnt turn on warnings, it should compile if you turn them on. I am all about learning for the other two sources posted so far, but also want to see what I can do with the code I came up with on my own. Thanks alot, and any suggestions on the new code I am posting are also extremely welcome!
use strict; my ($dict, $adda, $line, @words, $word, %wordpl, $k, @lengths, $l, @ad +dw, $oword, $lo, $i); $dict="<untitled:Desktop Folder:WORD.LST"; $adda=">untitled:Desktop Folder:addagram.lst"; #### #Open the dictionary file and read each word into @words #### open (DICT, $dict) or die ("Can't open $dict: $!\n"); while(defined($line=readline(*DICT))) { chomp $line; push @words, $line; } close (DICT); #### #Create a hash (%wordpl) of arrays, where each element in each array i +s #the same length, and the keys represent those lengths #### foreach $word (@words) { push @{ $wordpl{length($word)} }, $word; } #### #Read the keys of %wordpl, i.e. the lengths of the elements in the arr +ay #@{ $wordpl{length($word)} } in @lengths and sort @length numerically #in descending order #### foreach $k (keys %wordpl ) { push @lengths, $k; } @lengths = sort {$b <=> $a} @lengths; #### #Start a loop where $l is the length, or the key, for %wordpl. #### foreach $l (@lengths) { @addw=word(%wordpl, $l, $oword, @addw); } #### #Start a loop where you pick the a word in @{ $wordpl{$l} } #and pass that word and $l-1 (index of array of words with one #less character then aforementioned word) to word1() #### sub word { my ($word, $l, %wordpl, $oword, $p, @addw, $oword); %wordpl=$_[0]; $l=$_[1]; $oword=$_[2]; @addw=$_[3]; foreach $word ( @{ $wordpl{$l} } ) { $oword=$word; #define original word my $p=$l-1; word1($p, $word, %wordpl, $l, $oword, @addw); } return @addw; } #### #Split $word from sub word into an @a, do the same for the word #picked by WO. If the two words differ by one character, and the #newest word ($sword) is greater then 3 characters, pass $sword #and $p-1 (index of array of words with one less character then #aforementioned word) to word2(). When word2() exits, exit WO #and return to word(). If the newest word is equal to three #characters in length, push that word into the array of #add-a-grams and exit WO to word() to restart process #### sub word1 { my ($p, @a, %wordpl, $l, $sword, @b, %seen, @aonly, $item, @addw, +$oword); $p=$_[0]; @a=split(//,$_[1]); %wordpl=$_[2]; $l=$_[3]; $oword=$_[4]; @addw=$_[5]; WO: foreach $sword ( @{ $wordpl{$p} } ) { @b=split(//,$sword); %seen = (); @aonly = (); @seen{@b}=(); foreach $item (@a) { push (@aonly, $item) unless exists $seen{$item}; } if (length(@aonly)==1) { if ($p==3) { push @addw, $oword; last WO; } $p--; word2($p, $sword, %wordpl, $l, $oword, @addw); last WO; } } } #### #Split $sword from sub word1 into an @a, do the same for the word #picked by WT. If the two words differ by one character, and the #newest word ($sword) is greater then 3 characters, pass $sword #and $p-1 (index of array of words with one less character then #aforementioned word) to word1(). When word1() exits, exit WT #and return to word(). If the newest word is equal to three #characters in length, push that word into the array of #add-a-grams and exit WT to word() to restart process #### sub word2 { my ($p, @a, %wordpl, $l, $sword, @b, %seen, @aonly, $item, @addw, +$oword); $p=$_[0]; @a=split(//,$_[1]); %wordpl=$_[2]; $l=$_[3]; $oword=$_[4]; @addw=$_[5]; WT: foreach $sword ( @{ $wordpl{$p} } ) { @b=split(//,$sword); %seen = (); @aonly = (); @seen{@b}=(); foreach $item (@a) { push (@aonly, $item) unless exists $seen{$item}; } if (length(@aonly)==1) { if ($p==3) { push @addw, $oword; last WT; } $p--; word2($p, $sword, %wordpl, $l, $oword, @addw); last WT; } } } #### #determine the longest add-a-gram and print it and the #others to a file #### $lo=""; foreach $i (@addw) { if ( length($lo)<length($i) ) { $lo=$i; } } open (ADD, $adda) or die ("Cant open $adda: $!\n"); foreach $i (@addw) { if ($i ne $lo) { print ADD "$i\n"; } else { print ADD "longest: $i\n"; } } close (ADD);

Log In?
Username:
Password:

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

How do I use this?Last hourOther CB clients
Other Users?
Others admiring the Monastery: (3)
As of 2024-04-20 14:10 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found