http://qs321.pair.com?node_id=1068370

slinky773 has asked for the wisdom of the Perl Monks concerning the following question:

OK, here goes:

I'm making this final exam study guide program for my Geometry Honors class in perl as a command line script because I'm too lazy to figure out how to make a GUI. I was on Unit 3, which is logic. We had a lot of assignments where you had to use the chain rule and law of detachment (take all the contrapositives of the statements, basically) to take, say, 4 statements like '~c->~f', 'g->b', 'p->f', and 'c->~b' and you had to derive that ultimately 'p->~g' was the correct conclusion. So I typed this subroutine up in a module:

sub LHCC {
    DECISION: print "
    Hi. This is the Lee-Hardy Conclusion Calculator.\n
    Given a series of statements using the syntax\n
    'p -> q', I will deduce the correct conclusion\n
    to be made using basic logic and the chain rule.\n
    Type 'ready' when you are ready to input your statements.\n
    Type 'quit' to exit the LHCC.\n\n";
    my $decision = <STDIN>;
    chomp $decision;
    if($decision =~ /quit/i) {if(! &Unit3()) {return 0;}}
    elsif($decision =~ /ready/i) {}
    else {print "\nCould not interpret, try again.\n"; goto DECISION;}
    print "\nHow many statements will be used?\n\n";
    my $NumberOfStatements = <STDIN>;
    chomp $NumberOfStatements;
    if($NumberOfStatements !~ /^-?\d+\.?\d*$/) {print "\nCould not int
+erpret, try again.\n"; goto DECISION;}
    print "\nOnly a hypen will be accepted for 'not'.\n
BTW, with many statements with syntax p -> q, you can't\n
have duplicate q's. Sorry. Hey, I only had a week to make\n
this thing.\n\n";
    print "Given the statements ";
    my $StatementNumber = 0;
    my $P = 0;
    my $Q = 0;
    my %Statements = ();
    for $StatementNumber (1..$NumberOfStatements)
    {
        if ($StatementNumber != $NumberOfStatements) {print "P$Stateme
+ntNumber -> Q$StatementNumber, ";}
        elsif ($StatementNumber == $NumberOfStatements) {print "and P$
+StatementNumber -> Q$StatementNumber,\n\n";}
        else {die "Whut? Something weird just happened, you aren't sup
+posed to be able to see this. Run again and if the error persists, em
+ail me at yflee7\@students.d125.org.\n";}
    }
    for $StatementNumber (1..($NumberOfStatements*2))
    {
        if($StatementNumber % 2 == 0)
        {
            my $TrueStatementNumber = $StatementNumber/2;
            print "Q$TrueStatementNumber = ";
            $Q = <STDIN>;
            chomp $Q;
            if (! $Q) {print "\nCould not interpret, try again\n"; got
+o DECISION;}
            print "\n";
            $Statements{"Q$TrueStatementNumber"} = $Q;
        }
        elsif($StatementNumber % 2 != 0)
        {
            my $TrueStatementNumber = int($StatementNumber/2) + 1;
            print "P$TrueStatementNumber = ";
            $P = <STDIN>;
            chomp $P;
            if (! $P) {print "\nCould not interpret, try again\n"; got
+o DECISION;}
            print "\n";
            $Statements{"P$TrueStatementNumber"} = $P;
        }
        else {die "Whut? Something weird just happened, you aren't sup
+posed to be able to see this. Run again and if the error persists, em
+ail me at yflee7\@students.d125.org.\n";}
    }
    my %Contrapositives = ();
    for $StatementNumber (1..$NumberOfStatements)
    {
        $Contrapositives{"P$StatementNumber"} = $Statements{"Q$Stateme
+ntNumber"};
        $Contrapositives{"Q$StatementNumber"} = $Statements{"P$Stateme
+ntNumber"};
    }
    my @ContrapositivesKeys = keys %Contrapositives;
    for my $Element (@ContrapositivesKeys)
    {
        my $ToTildeOrNotToTilde = substr $Contrapositives{$Element}, 0
+, 1;
        my $RestOfStatement = substr $Contrapositives{$Element}, 1;
        if($ToTildeOrNotToTilde eq '-')
        {
            $Contrapositives{$Element} = $RestOfStatement;
        }
        elsif($ToTildeOrNotToTilde ne '-')
        {
            $Contrapositives{$Element} = "-" . $Contrapositives{$Eleme
+nt};
        }
        else {die "Whut? Something weird just happened, you aren't sup
+posed to be able to see this. Run again and if the error persists, em
+ail me at yflee7\@students.d125.org.\n";}
    }
    @ContrapositivesKeys = keys %Contrapositives;
    my @StatementsKeys = keys %Statements;
    for my $Element (1..$NumberOfStatements)
    {
        $Statements{$Statements{"P$Element"}} = $Statements{"Q$Element
+"};
        delete $Statements{"Q$Element"};
        delete $Statements{"P$Element"};
    }
    for my $Element (1..$NumberOfStatements)
    {
        $Contrapositives{$Contrapositives{"P$Element"}} = $Contraposit
+ives{"Q$Element"};
        delete $Contrapositives{"Q$Element"};
        delete $Contrapositives{"P$Element"};
    }
    my @Conclusion = ();
    my @OtherConclusion = ();
    my $KeyValueToCheck = 0;
    my $key = 0;
    foreach $KeyValueToCheck (keys %Statements)
    {
        if(!$KeyValueToCheck) {die "Whut? Something weird just happene
+d.";}
        my @PossibleConclusion = ($KeyValueToCheck, $Statements{$KeyVa
+lueToCheck});
        CHECKPOINT: foreach $key (keys %Statements)
        {
            if(!$key) {die "Whut? Something weird just happened.";}
            if($key eq $Statements{$KeyValueToCheck})
            {
                push @PossibleConclusion, $Statements{$key};
                $KeyValueToCheck = $key;
            }
            elsif($key ne $Statements{$KeyValueToCheck}) {}
            else {die "Whut? Something weird just happened, you aren't
+ supposed to be able to see this. Run again and if the error persists
+, email me at yflee7\@students.d125.org.\n";}
        }
        foreach $key (keys %Contrapositives)
        {
            if($key eq $Statements{$KeyValueToCheck})
            {
                push @PossibleConclusion, $Statements{$key};
                $KeyValueToCheck = $key;
                goto CHECKPOINT;
            }
            elsif($key ne $Statements{$KeyValueToCheck}) {}
            else {die "Whut? Something weird just happened, you aren't
+ supposed to be able to see this. Run again and if the error persists
+, email me at yflee7\@students.d125.org.\n";}
        }
        if (scalar @PossibleConclusion > scalar @Conclusion) {@Conclus
+ion = @PossibleConclusion;}
        elsif (scalar @PossibleConclusion == scalar @Conclusion) {@Oth
+erConclusion = @PossibleConclusion;}
        elsif (scalar @PossibleConclusion < scalar @Conclusion) {}
        else {die "Whut? Something weird just happened, you aren't sup
+posed to be able to see this. Run again and if the error persists, em
+ail me at yflee7\@students.d125.org.\n";}
    }
    foreach $KeyValueToCheck (keys %Contrapositives)
    {
        if(!$KeyValueToCheck) {die "Whut? Something weird just happene
+d.";}
        my @PossibleConclusion = ($KeyValueToCheck, $Statements{$KeyVa
+lueToCheck});
        CHECKPOINT2: foreach $key (keys %Statements)
        {
            if($key eq $Contrapositives{$KeyValueToCheck})
            {
                if(!$key) {die "Whut? Something weird just happened.";
+}
                push @PossibleConclusion, $Statements{$key};
                $KeyValueToCheck = $key;
            }
            elsif($key ne $Contrapositives{$KeyValueToCheck}) {}
            else {die "Whut? Something weird just happened, you aren't
+ supposed to be able to see this. Run again and if the error persists
+, email me at yflee7\@students.d125.org.\n";}
        }
        foreach $key (keys %Contrapositives)
        {
            if($key eq $Contrapositives{$KeyValueToCheck})
            {
                if(!$key) {die "Whut? Something weird just happened.";
+}
                push @PossibleConclusion, $Statements{$key};
                $KeyValueToCheck = $key;
                goto CHECKPOINT2;
            }
            elsif($key ne $Contrapositives{$KeyValueToCheck}) {}
            else {die "Whut? Something weird just happened, you aren't
+ supposed to be able to see this. Run again and if the error persists
+, email me at yflee7\@students.d125.org.\n";}
        }
        if (scalar @PossibleConclusion > scalar @Conclusion) {@Conclus
+ion = @PossibleConclusion;}
        elsif (scalar @PossibleConclusion == scalar @Conclusion) {@Oth
+erConclusion = @PossibleConclusion;}
        elsif (scalar @PossibleConclusion < scalar @Conclusion) {}
        else {die "Whut? Something weird just happened, you aren't sup
+posed to be able to see this. Run again and if the error persists, em
+ail me at yflee7\@students.d125.org.\n";}
    }
    foreach my $ScalarNumber (0..((scalar @Conclusion)-1))
    {
        if ($ScalarNumber != scalar @Conclusion) {print "$Conclusion[$
+ScalarNumber] => ";}
        elsif ($ScalarNumber == scalar @Conclusion) {print "$Conclusio
+n[$ScalarNumber]";}
        else {die "Whut? Something weird just happened, you aren't sup
+posed to be able to see this. Run again and if the error persists, em
+ail me at yflee7\@students.d125.org.\n";}
    }
    print "\n\nor \n\n";
    foreach my $ScalarNumber (0..((scalar @OtherConclusion)-1))
    {
        if ($ScalarNumber != (scalar @OtherConclusion)-1) {print "$Oth
+erConclusion[$ScalarNumber] => ";}
        elsif ($ScalarNumber == (scalar @OtherConclusion)-1) {print "$
+OtherConclusion[$ScalarNumber]";}
        else {die "Whut? Something weird just happened, you aren't sup
+posed to be able to see this. Run again and if the error persists, em
+ail me at yflee7\@students.d125.org.\n";}
    }
    print "\n\nIn other words, " . $Conclusion[0] . " => " . $Conclusi
+on[(scalar @Conclusion)-1] . " or " . $OtherConclusion[0] . " => " . 
+$OtherConclusion[(scalar @Conclusion)-1] . "\n";
    goto DECISION;
}

[download]

It's a lot of foreach $scalar (keys %Hash) sort of stuff, but that's the best way I could think of to do this. However, every time I run it, I always get an error akin to this: 

Use of uninitialized value in print at Unit3.pm line 142, <STDIN> line
+ 12.
Use of uninitialized value in string eq at Unit3.pm line 144, <STDIN> 
+line 12.
Use of uninitialized value in string ne at Unit3.pm line 149, <STDIN> 
+line 12.
Use of uninitialized value in print at Unit3.pm line 142, <STDIN> line
+ 12.
Use of uninitialized value in string eq at Unit3.pm line 144, <STDIN> 
+line 12.
Use of uninitialized value in string ne at Unit3.pm line 149, <STDIN> 
+line 12.

[download]

and that generally drags on for, say, 75 lines or so. The errors start around when my CHECKPOINT label shows up. Every time I try something and I think I've fixed it, this always changes a tiny bit, but still shows up. To make matters worse, it doesn't even work at the end:

Use of uninitialized value $Conclusion[2] in concatenation (.) or stri
+ng at Unit3.pm line 203, <STDIN> line 12.
c => -b =>  => 

or 

Use of uninitialized value $OtherConclusion[1] in concatenation (.) or
+ string at Unit3.pm line 210, <STDIN> line 12.
Use of uninitialized value $Conclusion[2] in concatenation (.) or stri
+ng at Unit3.pm line 214, <STDIN> line 12.
f =>  => -b

In other words, c =>  or f => -b

[download]

Which is… pretty bad. Any help would be appreciated. I stayed up till 5 last night trying to figure this out, and I think I may get ulcers!

Replies are listed 'Best First'.
Re: Hash Uninitialized Values Error
by GrandFather (Saint) on Dec 26, 2013 at 01:45 UTC

    Over 200 lines of spaghetti code with input parsing stirred in amongst everything else in one sub. No wonder you are having trouble debugging this puppy! Some hints that may help clean things up:

    1. Refactor your code to move all the input parsing out of the LHCC sub then pass the parsed data into the sub. That lets you write and debug the sub without having to get the input data parsing right to start with.
    2. Don't use goto
    3. Don't use empty {} in if/elsif/else statements - they obscure the fail conditions
    4. Don't repeat blocks of code - use a sub. That includes the large number of places where your code dies with a long and meaningless error message. Use a sub and pass a context to be included in the message. That will both clean up the code and help with debugging logic errors.
    5. Don't code for stuff that can't happen (n % 2 can only be 0 or 1) to avoid cluttering the code and obscuring the logic
    6. Use next to "early exit" loops. That avoids nesting code and makes it easier to understand.
    7. Check $key (and die) before using it.
    8. Why my @StatementsKeys = keys %Statements; when @StatementsKeys is not used anywhere?

    I'll follow up with a somewhat tided version of your code in due course, but there are a lot of lines to delete and it's taking a while! ;).

    True laziness is hard work
[reply]
[d/l]
[select]
Re: Hash Uninitialized Values Error
by GrandFather (Saint) on Dec 26, 2013 at 04:19 UTC

    I've lightly refactored your code to move input code out of the main sub, remove dead code and add logic sanity checking using die statements for bad logic or data (I can't tell where the error is, but you may).

    Read more... (5 kB)

    Given "-c->-f" "g->b" "p->f" "c->-b" as input the following error is generated:

    No statement -b at test.pl line 72.

    [download]

    Points of interest:

    1. the script parses statements entered on the command line to avoid an extended and error prone Q&A session
    2. unreachable and empty statements removed
    3. use of join to generate result lists
    4. use of heredoc (perlop - Quote Like Operators look for <<EOF) for most multiple line print statements

    I haven't fixed the processing logic because after a quick look I can't figure out what it's trying to do. However I suspect a recursive routine would be clearer, avoid the gotos and be shorter.

    True laziness is hard work
[reply]
[d/l]
[select]
      Thanks so much, man. Someday I'm going to go to my school's "lab" (it's just a library but I always go there to code) and sit down and really fix my bad habits, using this as a first exercise.
[reply]
Re: Hash Uninitialized Values Error
by Anonymous Monk on Dec 26, 2013 at 00:30 UTC
    Well, I've run that code through perltidy to see what I can see, and that looks very much like something called spaghetti code ... its to hard to read for humans, to hard to fix for humans, me included

    So my advice, if you want to solve your warning, start rewriting the program to work without goto

    See Text Based Perl Game and especially the responses (and links in responses) for specifics

    So in the end you write something like, something short, where the control-flow is easy to seee (birds eye view), no gotos :) no spaghetti 

    
sub LHCC {
  DECISION:
    while( 1 ) {
        WelcomeMsg();
        my $decision = GetDecision();
        if( $decision =~ /quit/ ) {
            last DECISION;
        } elsif( $decision =~ /ready/ ) {
            GoDoReadyDecision();
        } else {
            TryAgainMessage();
        }
    }
} ## end sub LHCC

sub GoDoReadyDecision {
    my $no_statements = GetNoStatements();
    ...;
    GetQPStatements( \%Statements );
    ...;
    my( $conclusions, $o_conclusions ) =
      ConcludeConclusions( \%Statements, \%Contrapositives ... );

    return $conclusions, $o_conclusions;
} ## end sub GoDoReadyDecision

sub ConcludeConclusions {
    my( $Statements, $Contrapositives ) = @_;
    while( my( $key, $value ) = each %$Statements ) {
        ...;
    }
    for my $key ( keys %$Contrapositives ) {
        my $value = $Contrapositives->{$key};
        ...;
    }
    ...;
    return \@Conclusion, \@OtherConclusion;
} ## end sub ConcludeConclusions

    [download]

    And when you get "use of unitialized ..." you can focus only on one small subroutine, you Data::Dump::dd( \@_ ) and can debug only this one small part

    Good luck

[reply]
[d/l]
      Thank you for the advice. Actually, I… kind of didn't realize how bad my code was getting. I was just focused on the end product, since I was supposed to finish it by Christmas. Now I'll go back and make everything into subroutines, like I should have originally. Thanks.
[reply]
Re: Hash Uninitialized Values Error
by GrandFather (Saint) on Dec 26, 2013 at 11:22 UTC

    Ok, I looked at the code up, down and sideways, then started refactoring common code and realised that half the logic vanishes if the two sets of statements are stored in one structure. I also noticed a bunch of make work creating a transient numbered set of data so I eliminated that. Then the code seemed to simplify down to the point where I could see what was going on. Here's the result:

    use strict;
use warnings;

if (!@ARGV) {
    print <<HELP;
    Hi. This is the Lee-Hardy Conclusion Calculator.
    Given a list of statements on the command line using the syntax "p
+ -> q" I
    will deduce the correct conclusion to be made using basic logic an
+d the
    chain rule.
    
    - may be used for negation
    q's can not be duplicated
HELP
    exit;
}

LHCC(parse(@ARGV));


sub LHCC {
    my (%all) = @_;
    my @Conclusion;
    my @alternate;

    foreach my $testKey (keys %all) {
        my @candidate = ($testKey);
        my $nextKey = $testKey;

        while ($nextKey) {
            $nextKey = $all{$nextKey};
            push @candidate, $nextKey;
            
            last if ! exists $all{$nextKey};
        }

        if (scalar @candidate > scalar @Conclusion) {
            @Conclusion = @candidate;
        } elsif (scalar @candidate == scalar @Conclusion) {
            @alternate = @candidate;
        }
    }

    print join ' => ', @Conclusion;
    print "\nor\n";
    print join ' => ', @alternate;
    print <<RESULT;

In other words: $Conclusion[0] => $Conclusion[-1]
            or: $alternate[0] => $alternate[-1]
RESULT
}


sub parse {
    my %all;

    for my $statement (@_) {
        my ($p, $q) = $statement =~ /(\S+)\s*->\s*(\S+)/;
        $all{$p} = $q;
        $_ = /^-(.*)/ ? $1 : "-$_" for $p, $q;
        $all{$q} = $p;
    }

    return %all;
}

    [download]

    Given "-c->-f" "g->b" "p->f" "c->-b" on the command line it prints:

    p => f => c => -b => -g
or
g => b => -c => -f => -p
In other words: p => -g
            or: g => -p

    [download]

    The code is not robust against bad data, but it does at least generate what seems to be the right result with the sample data.

    True laziness is hard work
[reply]
[d/l]
[select]
Re: Hash Uninitialized Values Error
by Khen1950fx (Canon) on Dec 25, 2013 at 23:31 UTC
    FWIW, the DECISION heredoc wasn't printing out. I believe that it has something to do with heredocs needing to be flush with the left margin. As a quick workaround, I used Filter::Indent::HereDoc. Here's a simplified example: 
    #!/usr/bin/perl

use strict;
use warnings;
use Filter::Indent::HereDoc;

DECISION:
{
  {
    print <<EOF;
    Hi. This is the Lee-Hardy Conclusion Calculator.
    Given a series of statements using the syntax
    'p -> q', I will deduce the correct conclusion
    to be made using basic logic and the chain rule.
    Type 'ready' when you are ready to input your statements.
    Type 'quit' to exit the LHCC.
    EOF  
  }
}

    [download]
[reply]
[d/l]
[select]

      DECISION: is a statement label. There are multiple places where goto is used to go to the label. Misguided programming style I know, but allowed.

      True laziness is hard work
[reply]
[d/l]
      There is no DECISION heredoc, the OP doesn't need a source filter to solve a nonexistent problem
[reply]
        It would not print on my system. There is a problem there. You're full of it.
[reply]
Re: Hash Uninitialized Values Error
by GrandFather (Saint) on Dec 27, 2013 at 10:28 UTC

    and here's a version that uses recursion and allows duplicate q's:

    use strict;
use warnings;

my @statements = qw(
    ~c->~f
    g->b
    p->f
    c->~b
    p->b
    d->p
    );

LHCC(parse(@statements));


sub LHCC {
    my (%all) = @_;
    my @arguments = sort {@$a <=> @$b} buildArguments(\%all, keys %all
+);
    my $longest = @{$arguments[-1]};

    @arguments = map {[join (' => ', @$_), $_->[0], $_->[-1]]}
        grep {$longest == @$_} @arguments;

    print "   ", join "or ", map {"$_->[0]\n"} @arguments;
    print "Syllogism(s)\n    ", join "and ",
        map {"$_->[1] => $_->[2]\n"} @arguments;
}


sub buildArguments {
    my ($options, @keys) = @_;
    my @arguments;

    for my $key (@keys) {
        next if !exists $options->{$key};

        my @qKeys = @{$options->{$key}};
        my $remaining = deepCopy($options, $key);
        
        my @tails = buildArguments($remaining, @qKeys);
        push @arguments, [$key, @$_] for @tails;
    }

    @arguments = map {[$_]} @keys if ! @arguments;
    return @arguments;
}


sub deepCopy {
    my ($part, @exclude) = @_;
    my %copy;

    if ('ARRAY' eq ref $part) {
        return [map {deepCopy($_)} @$part];
    } elsif ('HASH' eq ref $part) {
        my %copy = map {$_ => deepCopy($part->{$_})} keys %$part;

        delete $copy{$_} for @exclude;
        return \%copy;
    }

    return $part;
}


sub parse {
    my %all;

    for my $statement (@_) {
        my ($p, $q) = $statement =~ /(\S+)\s*->\s*(\S+)/;
        push @{$all{$p}}, $q;
        $_ = /^~(.*)/ ? $1 : "~$_" for $p, $q;
        push @{$all{$q}}, $p;
    }

    return %all;
}

    [download]

    Prints:

       d => p => f => c => ~b => ~p => ~d
or d => p => b => ~c => ~f => ~p => ~d
Syllogism(s)
    d => ~d
and d => ~d

    [download]

    Note that this version has the statement data built in, but replacing @statements with @ARGV allows the command line parsing to be used instead of the test data.

    I've switched to using ~ for negation instead of - too.

    This version is a little more Perlish than the previous code. Use Perl documentation to look up functions and syntax you've not encountered before. You'll notice I've not bothered to suppress duplicate results - that's left as an exercise for the reader ;).

    True laziness is hard work
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom