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

Sorry about all the problems, I really am a newbie. I reformatted the code and the comments, I hope this helps. I didn't think I was using any globals besides $l, and I hadn't planed to, but didnt want to pass it every time i jumped between subroutines. I dont really understand what you mean by single element arrays slices, if you would go into a litttle more detail that would be great. Here is the updated code (mostly superfical updates): 
use Strict;
$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) {
    word();
}

####
#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;
    foreach $word ( @{ $wordpl{$l} } ) {
        $oword=$word; #define original word
        my $p=$l-1;
        word1($p, $word);
    }
}

####
#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=@_[0];
    my @a=split(//,@_[1]);
    my $sword;
    WO: foreach $sword ( @{ $wordpl{$p} } ) {
        my @b=split(//,$sword);
        my %seen = ();
        my @aonly = ();
        my $item;
        @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);
            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=@_[0];
    my @a=split(//,@_[1]);
    my $sword;
    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--;
            word1($p, $sword);
            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);

[download]

Replies are listed 'Best First'.
Re: Re: Re: Add-A-Gram Performance
by grep (Monsignor) on Feb 05, 2002 at 06:31 UTC
    a single element array slice is my @a=split(//,@_[1]);. @_[1] should be written $_[1]. This is spelled out when you use warnings or (-w).

    Just putting use strict; (not Strict, leading upper case is generally used for modules, 'strict' is a pragma) at the top does not make your script run under 'use strict;'. The script you just posted will not even compile.

    Please turn on warnings ('-w' on the shebang or 'use warnings;') and 'use strict;'. Then go through your code make it run without giving a warnings. If you have a problem, grab the section you are having a problem with and post the snippet here and ask for help.

    I apoligize for not answering all of your questions outright, but you'll do much better in the long run if you go though these things yourself instead of me answering them for you. Hope you understand.

    Some nodes to help you out:
  • On asking for help
  • How to ReadTheFineManual


    • Update: also chipmunk posted some good code and one of the best things to do is take some good code like chipmunk's and go through it until you understand it. (I get to thank merlyn for letting me do that to his code :) )

    grep
    grep> chown linux:users /world
[reply]
[d/l]
[select]
      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);

      [download]
[reply]
[d/l]

In Section Seekers of Perl Wisdom