The stupid question is the question not asked PerlMonks

Re: Golf: Cabbage, Goat, Wolf

by Athanasius (Archbishop)
 on Jan 06, 2014 at 02:06 UTC ( #1069442=note: print w/replies, xml ) Need Help??

in reply to Golf: Cabbage, Goat, Wolf

Hello educated_foo,

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;
}

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 noise1 ;-)

```\$_=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

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

Cheers,

1 “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.
2 See Re^4: 2014 Code Golf Challenge.

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

Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1069442]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others meditating upon the Monastery: (6)
As of 2022-01-22 21:12 GMT
Sections?
Information?
Find Nodes?
Leftovers?
Voting Booth?
In 2022, my preferred method to securely store passwords is:

Results (63 votes). Check out past polls.

Notices?