comment on

Thanks for this, it’s an interesting exercise! I wrote my own backtracking solution:

#! perl
use strict;
use warnings;
use feature 'state';

use constant DEBUG => 0;

use constant
{
    NONE        => 0b0000,                      # 0
    CABBAGE     => 0b0001,                      # 1
    GOAT        => 0b0010,                      # 2
    WOLF        => 0b0100,                      # 4
};

use constant
{
    EAT_CABBAGE => GOAT | CABBAGE,              # 3
    EAT_GOAT    => WOLF | GOAT,                 # 6
    ALL         => WOLF | GOAT | CABBAGE,       # 7
};

my @history  = ( [ ALL, NONE ] );
my @solution = ();

if (carry(ALL, NONE))
{
    for (@solution)
    {
        s/0/nothing    /;
        s/1/the cabbage/;
        s/2/the goat   /;
        s/4/the wolf   /;
    }

    my $step = 1;
    print "\n";
    printf("%d. $_", $step++) for @solution;
}
else
{
    print "\nNo solution found\n";
}

sub carry
{
    my   ($left_bank, $right_bank) = @_;
    state $call = 0                                                   
+          if DEBUG;
    printf "Enter carry(), call %d. (%03b | %03b)\n",
            ++$call, $left_bank, $right_bank                          
+          if DEBUG;

    # Carry right

    for my $passenger_1 (NONE, CABBAGE, GOAT, WOLF)
    {
        printf "move (call %d) %03b right (%03b | %03b)\n",
                $call, $passenger_1, $left_bank, $right_bank          
+          if DEBUG;

        if ($passenger_1 && !($left_bank & $passenger_1))
        {
            printf "abort move right because %03b missing from %03b\n"
+,
                    $passenger_1, $left_bank                          
+          if DEBUG;
            next;
        }

        $left_bank  -= $passenger_1;
        $right_bank += $passenger_1;
        printf "Move right made: %03b | %03b\n", $left_bank, $right_ba
+nk        if DEBUG;

        if ($right_bank == ALL)
        {
            printf "Done: %03b | %03b\n", $left_bank, $right_bank     
+          if DEBUG;
            $left_bank == NONE or die "Error: $!";
            push @solution, "carry $passenger_1 right\n";
            return 1;
        }

        if ($left_bank == EAT_CABBAGE ||
            $left_bank == EAT_GOAT)
        {
            $left_bank  += $passenger_1;
            $right_bank -= $passenger_1;
            printf "Move right undone because EAT (%03b | %03b)\n",
                    $left_bank, $right_bank                           
+          if DEBUG;
            next;
        }

        push @solution, "carry $passenger_1 right\n";

        # Carry left

        LEFT: for my $passenger_2 (NONE, CABBAGE, GOAT, WOLF)
        {
            printf "move %03b left\n", $passenger_2                   
+          if DEBUG;

            if ($passenger_2 && !($right_bank & $passenger_2))
            {
                printf "abort move left because %03b missing from %03b
+\n",
                        $passenger_2, $right_bank                     
+          if DEBUG;
                next;
            }

            $left_bank  += $passenger_2;
            $right_bank -= $passenger_2;

            printf "Move left made: %03b | %03b\n", $left_bank, $right
+_bank     if DEBUG;

            for (@history)
            {
                if (($_->[0] == $left_bank) &&
                    ($_->[1] == $right_bank))
                {
                    $left_bank  -= $passenger_2;
                    $right_bank += $passenger_2;
                    printf "Move left undone because REPEAT (%03b | %0
+3b)\n",
                            $left_bank, $right_bank                   
+          if DEBUG;
                    next LEFT;
                }
            }

            push @history, [ $left_bank, $right_bank ];

            if ($right_bank == EAT_CABBAGE || $right_bank == EAT_GOAT)
            {
                $left_bank  -= $passenger_2;
                $right_bank += $passenger_2;
                pop @history;
                printf "Move left undone because EAT (%03b | %03b)\n",
                        $left_bank, $right_bank                       
+          if DEBUG;
                next;
            }

            push @solution, "carry $passenger_2 left\n";

            printf "About to call carry(%03b, %03b)\n", $left_bank, $r
+ight_bank if DEBUG;

            if (carry($left_bank, $right_bank))
            {
                return 1;
            }
            else
            {
                $left_bank  -= $passenger_2;
                $right_bank += $passenger_2;
                pop @solution;
                printf "Move left undone because call to carry() faile
+d (%03b | %03b)\n",
                        $left_bank, $right_bank                       
+          if DEBUG;
            }
        }

        printf "Completed moves left (%03b | %03b)\n", $left_bank, $ri
+ght_bank  if DEBUG;

        $left_bank  += $passenger_1;
        $right_bank -= $passenger_1;
        pop @solution;
    }

    printf "Completed moves right (%03b | %03b)\n", $left_bank, $right
+_bank     if DEBUG;
    return 0;
}
[download]

Notes:

Encoded the cabbage, goat, and wolf using different bits in an integer (+ “no passenger” as 0). This makes it easier to do comparisons and store history.
The output shows what (if anything) is ferried across the river on each journey, alternating from right to left.
The implementation took a lot longer to debug than it did to write! So I’ve left the debugging code in place.

Obfuscation was a challenge. I ended up with something that looks pleasingly like line noise¹ ;-)

$_=q*H=([7,0]);c(7,0);y`0-4`-cgw`,say FV;sub c{(P,R)=@_;%OPP-=O;R+=O;i
+f(R==
7){ZV,O;return 1}if(P==3|P==6){WY}ZV,O;l:%QRP+=Q;R-=Q;F(H){if($_->[0]=
+=P&$_
->[1]==R){XYl}}ZH,[P,R];if(R==3|R==6){XpopH;Y}ZV,Q;c(P,R)&&return 1;Xp
+opV}W
popV}}*;s=%(.)(.)=F$1(0..2,4){Yif$1&&!($2&$1);=g;s~F~for~g;s!W!P+=O;R-
+=O;!g
;s^X^P-=Q;R+=Q;^g;s+Y+next +g;s#Z#push#g;s@([O-S])@\$$1@g;s&(H|V)&\@$1
+&g;eval
[download]

377 characters when run with perl -M5.010². Developed and tested on Strawberry Perl v5.18.1.

Cheers,

¹ “Yes, sometimes Perl looks like line noise to the uninitiated, but to the seasoned Perl programmer, it looks like checksummed line noise with a mission in life.” — merlyn, quoted in Wikipedia’s article on Perl.
² See Re^4: 2014 Code Golf Challenge.

Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

In reply to Re: Golf: Cabbage, Goat, Wolf by Athanasius
in thread Golf: Cabbage, Goat, Wolf by educated_foo

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


"be consistent"
	PerlMonks