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 (%statements) = @_;
    my $NumberOfStatements = keys (%statements) / 2;
    my %Contrapositives;

    for my $StatementNumber (1 .. $NumberOfStatements) {
        $Contrapositives{"P$StatementNumber"} =
            $statements{"Q$StatementNumber"};
        $Contrapositives{"Q$StatementNumber"} =
            $statements{"P$StatementNumber"};
    }

    for my $Element (keys %Contrapositives) {
        if ('-' eq substr $Contrapositives{$Element}, 0, 1) {
            $Contrapositives{$Element} = substr $Contrapositives{$Elem
+ent}, 1;
        } else {
            $Contrapositives{$Element} = "-$Contrapositives{$Element}"
+;
        }
    }

    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"}} =
            $Contrapositives{"Q$Element"};
        delete $Contrapositives{"Q$Element"};
        delete $Contrapositives{"P$Element"};
    }

    my @Conclusion;
    my @OtherConclusion;

    foreach my $checkKey (keys %statements) {
        my @PossibleConclusion = ($checkKey, $statements{$checkKey});

    CHECKPOINT:
        foreach my $key (keys %statements) {
            if (exists $statements{$checkKey} && $key eq $statements{$
+checkKey})
            {
                die "No statement $key" if ! exists $statements{$key};

                push @PossibleConclusion, $statements{$key};
                $checkKey = $key;
            }
        }

        foreach my $key (keys %Contrapositives) {
            if (exists $statements{$checkKey} && $key eq $statements{$
+checkKey}) {
                die "No statement $key" if ! exists $statements{$key};

                push @PossibleConclusion, $statements{$key};
                $checkKey = $key;
                goto CHECKPOINT;
            }
        }

        if (scalar @PossibleConclusion > scalar @Conclusion) {
            @Conclusion = @PossibleConclusion;
        } elsif (scalar @PossibleConclusion == scalar @Conclusion) {
            @OtherConclusion = @PossibleConclusion;
        }
    }

    foreach my $checkKey (keys %Contrapositives) {
        die "No statement $checkKey" if ! exists $statements{$checkKey
+};

        my @PossibleConclusion = ($checkKey, $statements{$checkKey});

    CHECKPOINT2:
        foreach my $key (keys %statements) {
            next if $key ne $Contrapositives{$checkKey};

            die "No statement $key" if ! exists $statements{$key};
            push @PossibleConclusion, $statements{$key};
            $checkKey = $key;
        }

        foreach my $key (keys %Contrapositives) {
            next if $key ne $Contrapositives{$checkKey};

            die "No statement $key" if ! exists $statements{$key};
            push @PossibleConclusion, $statements{$key};
            $checkKey = $key;
            goto CHECKPOINT2;
        }

        if (scalar @PossibleConclusion > scalar @Conclusion) {
            @Conclusion = @PossibleConclusion;
        } elsif (scalar @PossibleConclusion == scalar @Conclusion) {
            @OtherConclusion = @PossibleConclusion;
        }
    }

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

In other words, $Conclusion[0] => $Conclusion[(scalar @Conclusion) - 1
+]
            or $OtherConclusion[0] => $OtherConclusion[(scalar @Conclu
+sion) - 1]
RESULT
}


sub parse {
    my %statements;
    my $n = 1;

    for my $statement (@_) {
        my ($p, $q) = $statement =~ /(\S+)\s*->\s*(\S+)/;
        $statements{"P$n"} = $p;
        $statements{"Q$n"} = $q;
        ++$n;
    }

    return %statements;
}
[download]