Hi,
I couldn’t think of any good search criteria for finding info on this Wikipedia article:
http://en.wikipedia.org/wiki/Fox,_goose_and_bag_of_beans_puzzle
Has anyone ever posted a script to solve this?
Thanks,
kel
Hi,
Making a script that solves this kind of puzzle is harder than I thought it would be. I think I need to cheat with set operations.
Think I have the plan now. Got this so far to find if a set is legal:
--set g1 to {missing value, missing value, missing value, missing value}
--set g1 to {"man", "fox", "goose", "beans"}
--set g1 to {"fox", "goose", "beans"}
set g1 to {"fox", "goose"}
--set g1 to {"goose", "beans"}
--set g1 to {"fox", "beans"}
--set g1 to {"goose"}
--set g1 to {"beans"}
--set g2 to {missing value, missing value, missing value, missing value}
set bad_sets to {{"fox", "goose"}, {"goose", "beans"}}
-- check if g1 is legal
if "man" is in g1 then
set is_legal to true
else
set c to count bad_sets
-- assume count bad_sets > 0
repeat with i from 1 to c
set this_set to item i of bad_sets
set num_items to count this_set
repeat with j from 1 to num_items
set this_item to item j of this_set
if this_item is in g1 then
set is_legal to false
else
set is_legal to true
exit repeat
end if
end repeat
if is_legal is false then exit repeat
end repeat
end if
is_legal
Then, we check the two sets. Then, get a move with the man. First check if the move is legal. Then check if the move is in the list of moves. Then add it to the list. Make the move.
Think, I’ve got it. But if anyone knows a better way …
Edited: oops. Didn’t check if fox and goose was legal. Modified the script.
Edited: found a better way to check if the list is a bad list:
--set g1 to {missing value, missing value, missing value, missing value}
--set g1 to {"man", "fox", "goose", "beans"}
set g1 to {missing value, "fox", "goose", missing value}
--set g2 to {missing value, missing value, missing value, missing value}
set bad_sets to {{missing value, "fox", "goose", missing value}, {missing value, missing value, "goose", "beans"}}
{g1} is in bad_sets
Now I think that’s it.
Thanks anyway,
kel
Hello kel.
I guess you could use the isSubsetOf handler I wrote to figure out if the subset is illegal, if that is something for you then.
You check if the illegal sets are subsets of the current set.
-- Copyright ® 2013 Nigel Garvey
use AppleScript version "2.3"
use scripting additions
-- http://macscripter.net/viewtopic.php?pid=168715#p168715
-- Return a list of the items in setA which aren't in setB.
on difference(setA, setB)
-- Nigel Garvey
set astid to text item delimiters
set text item delimiters to return & return
set setA to return & setA & return
set text item delimiters to return & linefeed & return
set setB to return & setB & return
set text item delimiters to linefeed
set text item delimiters to setB's text items
set setA to setA's text items
set text item delimiters to ""
set setA to setA as text
if ((count setA) > 0) then
set text item delimiters to return & return
set setA to text items of text 2 thru -2 of setA
else
set setA to {}
end if
set text item delimiters to astid
return setA
end difference
-- returns the intersection, the elements that are
-- common in two sets.
on intersection(setA, setB)
local tmp1, tmp2
set tmp1 to difference(setA, setB)
set tmp2 to difference(setB, setA)
return (tmp1 & tmp2)
end intersection
-- returns true if aSet is a subset of the other
-- that is, all the elements must be present,
-- order is not considered.
on isSubset of Universe for aSet
-- Stolen from Nigel Garvey
if aSet = {} then return true
-- the empty set is a member of every set.
set astid to text item delimiters
set text item delimiters to return & return
set aSet to return & aSet & return
set text item delimiters to return & linefeed & return
set Universe to return & Universe & return
set text item delimiters to linefeed
set text item delimiters to Universe's text items
set aSet to aSet's text items
set text item delimiters to ""
set aSet to aSet as text
set text item delimiters to astid
return ((length of aSet) = 0)
end isSubset
I’d really want to make the three set operations into a library and post it as such, but I have plundered Nigel’s Garage so many times by now, and this is really his library. 
Well you have to make a script that can move objects matching certain conditions.
In this case we need 3 containers and 4 objects and 4 type of movements.
3 containers:
- side 1 (left)
- side 2 (right)
- boat (center)
4 objects:
- man (1)
- fox (2)
- goose (4)
- beans (8)
the center container is only allowed to hold values
- man (1)
- man + fox (3)
- man + goose (5)
- man + beans (9)
the side containers are allowed to contain values
- man (1)
- man + fox (3)
- man + fox + goose (7)
- man + fox + goose + beans (15)
- man + fox + beans (13)
- man + goose (5)
- man + goose + beans (11)
- man + beans (9)
- fox (2)
- fox + beans (10)
- goose (4)
- beans (8)
This seems a bit complex and can be simplified by using masks (see mask numbers above between parentheses) and bitwise operations. This way you can add and subtract values to add and remove objects from an to containers where eventually value 15 needs to moved from the left container to the right container.
Hello.
I posted the whole library above, I think you’ll need it if you should later step up onto the “The Tiger Puzzle”. 
The reason i didn’t choose to use lists but rather choosing masks is that you don’t need such kind of handlers. An equal comparison will do just fine. Adding and subtracting number is equal to handlers that will add items.
For instance, the first time you load in the boat with the man and the goose you simply add 5 (1 + 4) to the boat and subtract 5 from the left side. Saves you a lot of complex handling.
Hi,
Yes, doing it with bitwise operations looks a whole lot easier. This is the path I took just to make the first move 
set g1 to {"man", "fox", "goose", "beans"}
set g2 to {missing value, missing value, missing value, missing value}
set bad_lists to {{missing value, "fox", "goose", missing value}, {missing value, missing value, "goose", "beans"}, {missing value, "fox", "goose", "beans"}}
set moves_list to {}
copy g1 to end of moves_list
-- move the man
if g1 contains "man" then
set item 1 of g1 to missing value
set item 1 of g2 to "man"
-- check if g1 is legal
if {g1} is in bad_lists or {g1} is in moves_list then
set is_legal to false
else
set is_legal to true
end if
end if
if not is_legal then
beep 1
-- find the item
copy g1 to temp_list
repeat with i from 2 to 4
if item i of temp_list is not missing value then
set item i of temp_list to missing value
-- check temp_list
if {temp_list} is in bad_lists or {temp_list} is in moves_list then
-- reset
set item i of temp_list to item i of g1
else
-- found
exit repeat
end if
end if
end repeat
-- move the item
set item i of g2 to item i of g1
set item i of g1 to missing value
end if
copy g1 to end of moves_list
{g1, g2, moves_list}
I’m not sure if the boat is really needed, just what the man left behind.
Starting to get a headache.
Thanks,
kel
property boatValues : {1, 3, 5, 9}
property sideValues : {0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 13, 15}
startMoving(15, 0, {}, 0, false)
on startMoving(sideA, sideB, moves, lastMove, backwards)
if sideB is equal to 0 and backwards then return moves
repeat with x from 1 to count boatValues
repeat 1 times
set boat to item x of my boatValues
if lastMove is boat then exit repeat
if backwards then
set theMove to "R" & sideA & ":" & boat & ":" & sideB as string
else
set theMove to sideA & ":" & boat & ":" & sideB as string
end if
if theMove is in moves then exit repeat
if (sideB + boat) is not in sideValues then exit repeat
if (sideA - boat) is not in sideValues then exit repeat
if bwAND(sideA, boat) is not boat then exit repeat
set m to startMoving(sideB + boat, sideA - boat, moves & theMove, boat, not backwards)
if m is not false then return m
end repeat
end repeat
return false
end startMoving
on bwAND(n1, n2)
repeat 8 times
set n1 to (n1 + n1 * n2 mod 2 * 255) div 2
set n2 to n2 div 2
end repeat
return n1
end bwAND
Here something to start with and maybe unclear, but what’s clear is that the code doesn’t look for the most shortest way, only for the first valid. In our example works great because there is only one way to solve this puzzle.
The resulting moves: first integer is the mask of side A, the second integer is the mask of the boat and the last integer is the mask of side B. The R indicates movement backwards because here side A and B are flipped.
The result is: {“15:5:0”, “R5:1:10”, “11:3:4”, “R7:5:8”, “13:9:2”, “R11:1:4”, “5:5:10”}
meaning
move from A to B man + goose
move from B to A man only
move from A to B man + fox
move from B to A man + goose
move from A to B man + beans
move from B to A man only
move from A to B man + goose
edit: with human readable results
property boatValues : {1, 3, 5, 9}
property sideValues : {0, 1, 2, 3, 4, 5, 7, 8, 9, 10, 11, 13, 15}
set moveCodes to startMoving(15, 0, {}, 0, false)
createDialogForMoveCodes(moveCodes, {"man", "fox", "goose", "beans"})
on startMoving(sideA, sideB, moves, lastMove, backwards)
if sideB is equal to 0 and backwards then return moves
repeat with x from 1 to count boatValues
repeat 1 times
set boat to item x of my boatValues
if lastMove is boat then exit repeat
if backwards then
set theMove to "R" & sideA & ":" & boat & ":" & sideB as string
else
set theMove to sideA & ":" & boat & ":" & sideB as string
end if
if theMove is in moves then exit repeat
if (sideB + boat) is not in sideValues then exit repeat
if (sideA - boat) is not in sideValues then exit repeat
if bwAND(sideA, boat) is not boat then exit repeat
set m to startMoving(sideB + boat, sideA - boat, moves & theMove, boat, not backwards)
if m is not false then return m
end repeat
end repeat
return false
end startMoving
on bwAND(n1, n2)
repeat 8 times
set n1 to (n1 + n1 * n2 mod 2 * 255) div 2
set n2 to n2 div 2
end repeat
return n1
end bwAND
on createDialogForMoveCodes(moveCodes, names)
set theLines to {}
repeat with mCode in moveCodes
set theLine to "Move from "
if contents of mCode begins with "R" then
set theLine to theLine & "B to A "
else
set theLine to theLine & "A to B "
end if
set {oldTID, AppleScript's text item delimiters} to {AppleScript's text item delimiters, ":"}
set movement to text item 2 of mCode
set AppleScript's text item delimiters to oldTID
set members to {}
repeat with x from 1 to count names
if bwAND(movement as integer, 2 ^ (x - 1)) = 2 ^ (x - 1) then set end of members to item x of names
end repeat
set {oldTID, AppleScript's text item delimiters} to {AppleScript's text item delimiters, " and "}
set members to members as string
set AppleScript's text item delimiters to oldTID
set theLine to theLine & members
set end of theLines to theLine
end repeat
set {oldTID, AppleScript's text item delimiters} to {AppleScript's text item delimiters, linefeed}
set theText to theLines as string
set AppleScript's text item delimiters to oldTID
return theText
end createDialogForMoveCodes
Hi DJ,
You win the prize! 
I’m wondering how you got the third move. Because, with the path I took, there were two legal choices, fox or beans. But only one is the solution. 
Edited: I meant fox or beans.
Thanks a lot,
kel
Nice one, DJ!
The ‘repeat 1 times’ trick isn’t necessary with a bit of restructuring:
on startMoving(sideA, sideB, moves, lastMove, backwards)
if sideB is equal to 0 and backwards then return moves
repeat with x from 1 to count boatValues
set boat to item x of my boatValues
if lastMove is not boat then
if backwards then
set theMove to "R" & sideA & ":" & boat & ":" & sideB as string
else
set theMove to sideA & ":" & boat & ":" & sideB as string
end if
if theMove is not in moves and (sideB + boat) is in sideValues and (sideA - boat) is in sideValues and bwAND(sideA, boat) is boat then
set m to startMoving(sideB + boat, sideA - boat, moves & theMove, boat, not backwards)
if m is not false then return m
end if
end if
end repeat
return false
end startMoving
It’s just a brute force way of checking every move. It means it tests every path until every object has moved to the other side.
Thanks. Yeah I know, but I did it to make it better readable by simulating the missing continue command.
Hi McUser,
Thanks for showing me the library. I wanted near vanilla set functions not too long ago. I’ll put it in MathLib.
kel
No. They both work. The only imperative is not to leave the goose alone with either the fox or the beans. It doesn’t matter which order the fox and the beans are taken over.
Hi Nigel,
Later on I found that out, but with the list of lists method, I would still need another list for the nodes. The bitwise method is much better.
Good day,
kel
The problem with this problem is that it’s so easy to work out the sequence in one’s head, it’s difficult to decide what to leave to a script! At its simplest, there could just be a random choice between the two possible solutions!
return some item of {"Ferry the goose from bank 1 to bank 2.
Return empty from bank 2 to bank 1.
Ferry the fox from bank 1 to bank 2.
Ferry the goose from bank 2 to bank 1.
Ferry the beans from bank 1 to bank 2.
Return empty from bank 2 to bank 1.
Ferry the goose from bank 1 to bank 2.", "Ferry the goose from bank 1 to bank 2.
Return empty from bank 2 to bank 1.
Ferry the beans from bank 1 to bank 2.
Ferry the goose from bank 2 to bank 1.
Ferry the fox from bank 1 to bank 2.
Return empty from bank 2 to bank 1.
Ferry the goose from bank 1 to bank 2."}
The following is somewhere between DJ’s solution and the one above. The man is understood to be at the point of action.
set {beans, goose, fox} to {1, 2, 4}
set actions to {"Return empty", "Ferry the beans", "Ferry the goose", missing value, "Ferry the fox"}
set bankloads to {fox + goose + beans, 0}
set otherBank to 1
set ferrySequence to ""
repeat until (item 2 of bankloads is fox + goose + beans)
set thisBank to otherBank
set otherBank to thisBank mod 2 + 1
set waiting to (item thisBank of bankloads)
if (thisBank is 1) then
if (fox + goose + beans is waiting) then
set boatload to goose
else if (fox + beans is waiting) then
set boatload to some item of {fox, beans}
else -- Either fox or beans waiting and goose returning or goose waiting and boat empty.
set boatload to waiting - boatload
end if
else if (waiting mod 3 is 0) then -- Fox or beans arriving at bank 2 and goose already there.
set boatload to goose
else
set boatload to 0
end if
set item thisBank of bankloads to (item thisBank of bankloads) - boatload
set item otherBank of bankloads to (item otherBank of bankloads) + boatload
set ferrySequence to ferrySequence & item (boatload + 1) of actions & " from bank " & thisBank & " to bank " & otherBank & "." & linefeed
end repeat
Hi Nigel,
The script looks awesome at a glance. I need to look into it further.
I was thinking that. That there needs to be a stipulation, that the solution is the shortest route.
Then, there’s the other case where a route leads to a dead end. Then you need to go back to the node of that branch and take the other route. But I think you said something about the man being the center, so I’d better read your post again.
Have a good day,
kel
That’s not how Nigel’s solution works. Mine is the brute force attemp while Nigel has an small AI fitted in his if statements. That means depending on the bank values a new moves is decided. Mine just tries a new move with no regards what the side/bank values are, only if that value is allowed or not.
Hi Dj,
Yes, I need to look at Nigel’s script more deeply.
It’s hard to say what I’m thinking , but something like this. Here’s a combination that I am thinking about when I say dead end.
The tabs didn’t hold.
At this point, no matter what legal move the man makes, he’ll repeat himself.
If you look at every move that the man can make in order to find the shortest route. Then, you could go into an infinite loop. It’s a strange puzzle.
Have a good day,
kel