Re: Re: small puzzle programming
- To: mathgroup at smc.vnet.net
- Subject: [mg53908] Re: [mg53869] Re: [mg53857] small puzzle programming
- From: DrBob <drbob at bigfoot.com>
- Date: Fri, 4 Feb 2005 04:11:02 -0500 (EST)
- References: <E1CwOBX-0000XR-00@smtp13.eresmas.com>
- Reply-to: drbob at bigfoot.com
- Sender: owner-wri-mathgroup at wolfram.com
I must have failed to practice what I preach, and use the "Copy as InputForm" palette!
The code could be simpler, because there are really only two rules needed:
1) Always take the sheep if you can, but...
2) Never take back what you just brought.
Bobby
On Wed, 2 Feb 2005 18:19:34 +0100, E. Martin-Serrano <EmilioMartin-Serrano at wanadoo.es> wrote:
> Bobby,
>
> It works for me.
>
> But for some reason I got some misspellings. (See the weird characters "â�"
> inside multiple round brackets below). For those who got the same
> misspelling, change it into "!=". That works fine.
>
> next@{history_List, left_List, right_List} /; MemberQ[right, shepherd] :=
> Module[{result},
> Catch@Scan[
> (history[[-1]](((((((( â�)))))))) # &&
> (result = {Union[left, {#, shepherd}],
> Complement[right, {#, shepherd}]};
> compatible @@ result[[-1]]) && Throw@Prepend[result,
> Append[
> history, #]]) &,
> Reverse@right]
> ]
>
> The same in:
>
> next[done : {_, {}, _}] := done
> next@{history_List, left_List, right_List} /; MemberQ[left, shepherd] :=
> Module[{result},
> Catch@Scan[
> ((history == {} ||
> history[[-1]] ((((((â�))))) #) && (result = {Complement[left, {#,
> shepherd}], Union[
> right, {#, shepherd}]};
> compatible @@ result[[1]]) &&
> Throw@Prepend[result, Append[history, #]]) &,
> left]
> ]
>
>
>
> -----Original Message-----
> From: DrBob [mailto:drbob at bigfoot.com]
To: mathgroup at smc.vnet.net
> Sent: Tuesday, February 01, 2005 10:08 AM
> To: mathgroup at smc.vnet.net
> Subject: [mg53908] [mg53869] Re: [mg53857] small puzzle programming
>
> SURELY there's a less involved solution, but here's a way to do it, anyway:
>
> The shepherd's choices at each step are to transport the wolf, sheep, or
> grass -- or else take the boat alone.
>
> The state vector will consist of three lists: a history of moves already
> made and the objects on each bank (including the shepherd). Numerical values
> are given to the symbols in order to order them a certain way. The values
> could be very different, so long as (a) they are four distinct values, and
> (b) the shepherd's value is greater than the others.
>
> {wolf, sheep, grass, shepherd} = Range@4;
> initial = {{}, {wolf, sheep, grass, shepherd}, {}};
>
> The "interpret" function will translate a final solution into English (more
> or less). This may make more sense later.
>
> interpret = TableForm@Transpose@{PadRight[{}, Length@#, {"->
> ", "<-"}], #} /. Thread[Range@4 -> {"with the wolf", "with the
> sheep
> ", "with the grass", "alone"}] &;
>
> Empty sets, singletons, sets that include the shepherd, and the {wolf,
> grass} combination are compatible. All others are incompatible. (As it
> happens, sets that include the shepherd will never be tested, so that rule
> could be omitted.)
>
> Clear@compatible
> Attributes[compatible] = {Orderless};
> compatible[shepherd, ___] = True;
> compatible[wolf, grass] = True;
> compatible[_] = True;
> compatible[] = True;
> compatible[__] = False;
>
> The "next" function chooses the first legal move it finds, since the
> shepherd actually has NO CHOICE how to do this (aside from cycling).
> Available choices are determined by the objects on the bank where the
> shepherd stands.
>
> But the order of those choices is important. When moving forward, going
> alone is the last choice examined. When moving backward, going alone is the
> first choice a shepherd should think of.
>
> If he stands on the left bank, each object on that bank is examined in
> order. An object is disqualified if (a) it was transported in the previous
> move, or (b) taking that object will leave behind an incompatible
> combination. (The opposite bank is guaranteed compatible, because the
> shepherd will be there.)
>
> The FIRST rule listed must be the one that says, "If everybody is on the far
> bank, STOP."
>
> Clear@next
> next[done : {_, {}, _}] := done
> next@{history_List, left_List, right_List} /; MemberQ[left, shepherd] :=
> Module[{result},
> Catch@Scan[
> ((history == {} ||
> history[[-1]] �#) && (result = {Complement[left, {#, shepherd}],
> Union[
> right, {#, shepherd}]};
> compatible @@ result[[1]]) &&
> Throw@Prepend[result, Append[history, #]]) &,
> left]
> ]
>
> Code for backward moves is symmetric with that for forward moves except that
> (a) choices are considered in reverse order, and (b) "history" is known to
> be non-empty.
>
> next@{history_List, left_List, right_List} /; MemberQ[right, shepherd] :=
> Module[{result},
> Catch@Scan[
> (history[[-1]] �# &&
> (result = {Union[left, {#, shepherd}],
> Complement[right, {#, shepherd}]};
> compatible @@ result[[-1]]) && Throw@Prepend[result,
> Append[
> history, #]]) &,
> Reverse@right]
> ]
>
> interpret@First@FixedPoint[next, initial]
>
> TableForm[
> {{"->", "with the sheep"},
> {"<-", "alone"},
> {"->", "with the wolf"},
> {"<-", "with the sheep"},
> {"->", "with the grass"},
> {"<-", "alone"},
> {"->", "with the sheep"}}]
>
> If the shepherd had real choices, this would be (I think) a good bit harder.
>
> Somebody will probably prove me wrong.
>
> Bobby
>
> On Sun, 30 Jan 2005 03:18:21 -0500 (EST), zak <chocolatez at gmail.com> wrote:
>
>> how to code the following puzzle in mathematica programming language:
>> the shepherd who want to cross a river aboard a boat taking with him
>> one of the following items (wolf,sheep,grass) one per time,
>> lst ={S,w,g,p} may describe the group on one side of the river
>> lst2={} may describe the the current state of the other side of the
> river.
>> the pairs {{w,p} ,{p,g}} are not allowed
>> of course the solution is:
>> ((S,p),(S,w),(S,p),(S,g),(S,p))
>>
>> but how to code this or may be other ideas.
>>
>> zak
>>
>>
>>
>>
>
>
>
--
DrBob at bigfoot.com
www.eclecticdreams.net