Zebra puzzle
(Redirected from Einstein Logic Puzzle)
You are encouraged to solve this task according to the task description, using any language you may know.
The Zebra puzzle, a.k.a. Einstein's Riddle, is a logic puzzle which is to be solved programmatically.
It has several variants, one of them this:
- There are five houses.
- The English man lives in the red house.
- The Swede has a dog.
- The Dane drinks tea.
- The green house is immediately to the left of the white house.
- They drink coffee in the green house.
- The man who smokes Pall Mall has a bird.
- In the yellow house they smoke Dunhill.
- In the middle house they drink milk.
- The Norwegian lives in the first house.
- The Blend-smoker lives in the house next to the house with a cat.
- In a house next to the house with a horse, they smoke Dunhill.
- The man who smokes Blue Master drinks beer.
- The German smokes Prince.
- The Norwegian lives next to the blue house.
- They drink water in a house next to the house where they smoke Blend.
The question is, who owns the zebra? For clarity, each of the five houses is painted a different color, and their inhabitants are of different nationalities, own different pets, drink different beverages and smoke different brands of cigarettes.
Additionally, list the solution for all the houses.
Optionally, show the solution is unique.
- Related tasks
Ada
Not the prettiest Ada, but it's simple and very fast. Similar to my Dinesman's code; uses enums to keep things readable.
with Ada.Text_IO; use Ada.Text_IO;
procedure Zebra is
type Content is (Beer, Coffee, Milk, Tea, Water,
Danish, English, German, Norwegian, Swedish,
Blue, Green, Red, White, Yellow,
Blend, BlueMaster, Dunhill, PallMall, Prince,
Bird, Cat, Dog, Horse, Zebra);
type Test is (Drink, Person, Color, Smoke, Pet);
type House is (One, Two, Three, Four, Five);
type Street is array (Test'Range, House'Range) of Content;
type Alley is access all Street;
procedure Print (mat : Alley) is begin
for H in House'Range loop
Put(H'Img&": ");
for T in Test'Range loop
Put(T'Img&"="&mat(T,H)'Img&" ");
end loop; New_Line; end loop;
end Print;
function FinalChecks (mat : Alley) return Boolean is
function Diff (A, B : Content; CA , CB : Test) return Integer is begin
for H1 in House'Range loop for H2 in House'Range loop
if mat(CA,H1) = A and mat(CB,H2) = B then
return House'Pos(H1) - House'Pos(H2);
end if;
end loop; end loop;
end Diff;
begin
if abs(Diff(Norwegian, Blue, Person, Color)) = 1
and Diff(Green, White, Color, Color) = -1
and abs(Diff(Horse, Dunhill, Pet, Smoke)) = 1
and abs(Diff(Water, Blend, Drink, Smoke)) = 1
and abs(Diff(Blend, Cat, Smoke, Pet)) = 1
then return True;
end if;
return False;
end FinalChecks;
function Constrained (mat : Alley; atest : Natural) return Boolean is begin
-- Tests seperated into levels for speed, not strictly necessary
-- As such, the program finishes in around ~0.02s
case Test'Val (atest) is
when Drink => -- Drink
if mat (Drink, Three) /= Milk then return False; end if;
return True;
when Person => -- Drink+Person
for H in House'Range loop
if (mat(Person,H) = Norwegian and H /= One)
or (mat(Person,H) = Danish and mat(Drink,H) /= Tea)
then return False; end if;
end loop;
return True;
when Color => -- Drink+People+Color
for H in House'Range loop
if (mat(Person,H) = English and mat(Color,H) /= Red)
or (mat(Drink,H) = Coffee and mat(Color,H) /= Green)
then return False; end if;
end loop;
return True;
when Smoke => -- Drink+People+Color+Smoke
for H in House'Range loop
if (mat(Color,H) = Yellow and mat(Smoke,H) /= Dunhill)
or (mat(Smoke,H) = BlueMaster and mat(Drink,H) /= Beer)
or (mat(Person,H) = German and mat(Smoke,H) /= Prince)
then return False; end if;
end loop;
return True;
when Pet => -- Drink+People+Color+Smoke+Pet
for H in House'Range loop
if (mat(Person,H) = Swedish and mat(Pet,H) /= Dog)
or (mat(Smoke,H) = PallMall and mat(Pet,H) /= Bird)
then return False; end if;
end loop;
return FinalChecks(mat); -- Do the next-to checks
end case;
end Constrained;
procedure Solve (mat : Alley; t, n : Natural) is
procedure Swap (I, J : Natural) is
temp : constant Content := mat (Test'Val (t), House'Val (J));
begin
mat (Test'Val (t), House'Val (J)) := mat (Test'Val (t), House'Val (I));
mat (Test'Val (t), House'Val (I)) := temp;
end Swap;
begin
if n = 1 and Constrained (mat, t) then -- test t passed
if t < 4 then Solve (mat, t + 1, 5); -- Onto next test
else Print (mat); return; -- Passed and t=4 means a solution
end if;
end if;
for i in 0 .. n - 1 loop -- The permutations part
Solve (mat, t, n - 1);
if n mod 2 = 1 then Swap (0, n - 1);
else Swap (i, n - 1); end if;
end loop;
end Solve;
myStreet : aliased Street;
myAlley : constant Alley := myStreet'Access;
begin
for i in Test'Range loop for j in House'Range loop -- Init Matrix
myStreet (i,j) := Content'Val(Test'Pos(i)*5 + House'Pos(j));
end loop; end loop;
Solve (myAlley, 0, 5); -- start at test 0 with 5 options
end Zebra;
- Output:
ONE: DRINK=WATER PERSON=NORWEGIAN COLOR=YELLOW SMOKE=DUNHILL PET=CAT TWO: DRINK=TEA PERSON=DANISH COLOR=BLUE SMOKE=BLEND PET=HORSE THREE: DRINK=MILK PERSON=ENGLISH COLOR=RED SMOKE=PALLMALL PET=BIRD FOUR: DRINK=COFFEE PERSON=GERMAN COLOR=GREEN SMOKE=PRINCE PET=ZEBRA FIVE: DRINK=BEER PERSON=SWEDISH COLOR=WHITE SMOKE=BLUEMASTER PET=DOG
ALGOL 68
Attempts to find solutions using the rules.
BEGIN
# attempt to solve Einstein's Riddle - the Zebra puzzle #
INT unknown = 0, same = -1;
INT english = 1, swede = 2, dane = 3, norwegian = 4, german = 5;
INT dog = 1, birds = 2, cats = 3, horse = 4, zebra = 5;
INT red = 1, green = 2, white = 3, yellow = 4, blue = 5;
INT tea = 1, coffee = 2, milk = 3, beer = 4, water = 5;
INT pall mall = 1, dunhill = 2, blend = 3, blue master = 4, prince = 5;
[]STRING nationality = ( "unknown", "english", "swede", "dane", "norwegian", "german" );
[]STRING animal = ( "unknown", "dog", "birds", "cats", "horse", "ZEBRA" );
[]STRING colour = ( "unknown", "red", "green", "white", "yellow", "blue" );
[]STRING drink = ( "unknown", "tea", "coffee", "milk", "beer", "water" );
[]STRING smoke = ( "unknown", "pall mall", "dunhill", "blend", "blue master", "prince" );
MODE HOUSE = STRUCT( INT nationality, animal, colour, drink, smoke );
# returns TRUE if a field in a house could be set to value, FALSE otherwise #
PROC can set = ( INT field, INT value )BOOL: field = unknown OR value = same;
# returns TRUE if the fields of house h could be set to those of #
# suggestion s, FALSE otherwise #
OP XOR = ( HOUSE h, HOUSE s )BOOL:
( can set( nationality OF h, nationality OF s ) AND can set( animal OF h, animal OF s )
AND can set( colour OF h, colour OF s ) AND can set( drink OF h, drink OF s )
AND can set( smoke OF h, smoke OF s )
) # XOR # ;
# sets a field in a house to value if it is unknown #
PROC setf = ( REF INT field, INT value )VOID:
IF field = unknown AND value /= same THEN field := value FI;
# sets the unknown fields in house h to the non-same fields of suggestion s #
OP +:= = ( REF HOUSE h, HOUSE s )VOID:
( setf( nationality OF h, nationality OF s ); setf( animal OF h, animal OF s )
; setf( colour OF h, colour OF s ); setf( drink OF h, drink OF s )
; setf( smoke OF h, smoke OF s )
) # +:= # ;
# sets a field in a house to unknown if the value is not same #
PROC resetf = ( REF INT field, INT value )VOID: IF value /= same THEN field := unknown FI;
# sets fields in house h to unknown if the suggestion s is not same #
OP -:= = ( REF HOUSE h, HOUSE s )VOID:
( resetf( nationality OF h, nationality OF s ); resetf( animal OF h, animal OF s )
; resetf( colour OF h, colour OF s ); resetf( drink OF h, drink OF s )
; resetf( smoke OF h, smoke OF s )
) # -:= # ;
# attempts a partial solution for the house at pos #
PROC try = ( INT pos, HOUSE suggestion, PROC VOID continue )VOID:
IF pos >= LWB house AND pos <= UPB house THEN
IF house[ pos ] XOR suggestion THEN
house[ pos ] +:= suggestion; continue; house[ pos ] -:= suggestion
FI
FI # try # ;
# attempts a partial solution for the neighbours of a house #
PROC left or right = ( INT pos, BOOL left, BOOL right, HOUSE neighbour suggestion
, PROC VOID continue )VOID:
( IF left THEN try( pos - 1, neighbour suggestion, continue ) FI
; IF right THEN try( pos + 1, neighbour suggestion, continue ) FI
) # left or right # ;
# attempts a partial solution for all houses and possibly their neighbours #
PROC any2 = ( REF INT number, HOUSE suggestion
, BOOL left, BOOL right, HOUSE neighbour suggestion
, PROC VOID continue )VOID:
FOR pos TO UPB house DO
IF house[ pos ] XOR suggestion THEN
number := pos;
house[ number ] +:= suggestion;
IF NOT left AND NOT right THEN # neighbours not involved #
continue
ELSE # try one or both neighbours #
left or right( pos, left, right, neighbour suggestion, continue )
FI;
house[ number ] -:= suggestion
FI
OD # any2 # ;
# attempts a partial solution for all houses #
PROC any = ( HOUSE suggestion, PROC VOID continue )VOID:
any2( LOC INT, suggestion, FALSE, FALSE, SKIP, continue );
# find solution(s) #
INT blend pos;
INT solutions := 0;
# There are five houses. #
[ 1 : 5 ]HOUSE house;
FOR h TO UPB house DO house[ h ] := ( unknown, unknown, unknown, unknown, unknown ) OD;
# In the middle house they drink milk. #
drink OF house[ 3 ] := milk;
# The Norwegian lives in the first house. #
nationality OF house[ 1 ] := norwegian;
# The Norwegian lives next to the blue house. #
colour OF house[ 2 ] := blue;
# They drink coffee in the green house. #
# The green house is immediately to the left of the white house. #
any2( LOC INT, ( same, same, green, coffee, same )
, FALSE, TRUE, ( same, same, white, same, same ), VOID:
# In a house next to the house where they have a horse, #
# they smoke Dunhill. #
# In the yellow house they smoke Dunhill. #
any2( LOC INT, ( same, horse, same, same, same )
, TRUE, TRUE, ( same, same, yellow, same, dunhill ), VOID:
# The English man lives in the red house. #
any( ( english, same, red, same, same ), VOID:
# The man who smokes Blend lives in the house next to the #
# house with cats. #
any2( blend pos, ( same, same, same, same, blend )
, TRUE, TRUE, ( same, cats, same, same, same ), VOID:
# They drink water in a house next to the house where #
# they smoke Blend. #
left or right( blend pos, TRUE, TRUE, ( same, same, same, water, same ), VOID:
# The Dane drinks tea. #
any( ( dane, same, same, tea, same ), VOID:
# The man who smokes Blue Master drinks beer. #
any( ( same, same, same, beer, blue master ), VOID:
# The Swede has a dog. #
any( ( swede, dog, same, same, same ), VOID:
# The German smokes Prince. #
any( ( german, same, same, same, prince ), VOID:
# The man who smokes Pall Mall has birds. #
any( ( same, birds, same, same, pall mall ), VOID:
# if we can place the zebra, we have a solution #
any( ( same, zebra, same, same, same ), VOID:
( solutions +:= 1;
FOR h TO UPB house DO
print( ( whole( h, 0 )
, " ", nationality[ 1 + nationality OF house[ h ] ]
, ", ", animal [ 1 + animal OF house[ h ] ]
, ", ", colour [ 1 + colour OF house[ h ] ]
, ", ", drink [ 1 + drink OF house[ h ] ]
, ", ", smoke [ 1 + smoke OF house[ h ] ]
, newline
)
)
OD;
print( ( newline ) )
)
) # zebra #
) # pall mall #
) # german #
) # swede #
) # beer #
) # dane #
) # blend L/R #
) # blend #
) # red #
) # horse #
) # green # ;
print( ( "solutions: ", whole( solutions, 0 ), newline ) )
END- Output:
1 norwegian, cats, yellow, water, dunhill 2 dane, horse, blue, tea, blend 3 english, birds, red, milk, pall mall 4 german, ZEBRA, green, coffee, prince 5 swede, dog, white, beer, blue master solutions: 1
AppleScript
on zebraPuzzle()
-- From statement 10, the Norwegian lives in the first house,
-- so from statement 15, the blue house must be the second one.
-- From these and statements 5, 6, and 9, the green and white houses can only be the 4th & 5th,
-- and the Englishman's red house (statement 2) must be the middle one, where (9) they drink
-- milk. This only leaves the first house to claim the yellow colour and the Dunhill smokers
-- (statement 8), which means the second house must have the the horse (statement 12).
-- Initialise the house data accordingly.
set mv to missing value
set streetTemplate to {¬
{resident:"Norwegian", colour:"yellow", pet:mv, drink:mv, smoke:"Dunhill"}, ¬
{resident:mv, colour:"blue", pet:"horse", drink:mv, smoke:mv}, ¬
{resident:"Englishman", colour:"red", pet:mv, drink:"milk", smoke:mv}, ¬
{resident:mv, colour:"green", pet:mv, drink:"coffee", smoke:mv}, ¬
{resident:mv, colour:"white", pet:mv, drink:mv, smoke:mv} ¬
}
-- Test all permutations of the remaining values.
set solutions to {}
set drinkPermutations to {{"beer", "water"}, {"water", "beer"}}
set residentPermutations to {{"Swede", "Dane", "German"}, {"Swede", "German", "Dane"}, ¬
{"Dane", "German", "Swede"}, {"Dane", "Swede", "German"}, ¬
{"German", "Swede", "Dane"}, {"German", "Dane", "Swede"}}
set petPermutations to {{"birds", "cats", "ZEBRA"}, {"birds", "ZEBRA", "cats"}, ¬
{"cats", "ZEBRA", "birds"}, {"cats", "birds", "ZEBRA"}, ¬
{"ZEBRA", "birds", "cats"}, {"ZEBRA", "cats", "birds"}}
set smokePermutations to {{"Pall Mall", "Blend", "Blue Master"}, {"Pall Mall", "Blue Master", "Blend"}, ¬
{"Blend", "Blue Master", "Pall Mall"}, {"Blend", "Pall Mall", "Blue Master"}, ¬
{"Blue Master", "Pall Mall", "Blend"}, {"Blue Master", "Blend", "Pall Mall"}}
repeat with residentPerm in residentPermutations
-- Properties associated with resident.
copy streetTemplate to sTemplate2
set {r, OK} to {0, true}
repeat with h in {2, 4, 5} -- House numbers with unknown residents.
set thisHouse to sTemplate2's item h
set r to r + 1
set thisResident to residentPerm's item r
if (thisResident is "Swede") then
if (thisHouse's pet is not mv) then
set OK to false
exit repeat
end if
set thisHouse's pet to "dog"
else if (thisResident is "Dane") then
if (thisHouse's drink is not mv) then
set OK to false
exit repeat
end if
set thisHouse's drink to "tea"
else
set thisHouse's smoke to "Prince"
end if
set thisHouse's resident to thisResident
end repeat
-- Properties associated with cigarette brand.
if (OK) then
repeat with smokePerm in smokePermutations
-- Fit in this permutation of smokes.
copy sTemplate2 to sTemplate3
set s to 0
repeat with thisHouse in sTemplate3
if (thisHouse's smoke is mv) then
set s to s + 1
set thisHouse's smoke to smokePerm's item s
end if
end repeat
repeat with drinkPerm in drinkPermutations
-- Try to fit this permutation of drinks.
copy sTemplate3 to sTemplate4
set {d, OK} to {0, true}
repeat with h from 1 to 5
set thisHouse to sTemplate4's item h
if (thisHouse's drink is mv) then
set d to d + 1
set thisDrink to drinkPerm's item d
if (((thisDrink is "beer") and (thisHouse's smoke is not "Blue Master")) or ¬
((thisDrink is "water") and not ¬
(((h > 1) and (sTemplate4's item (h - 1)'s smoke is "Blend")) or ¬
((h < 5) and (sTemplate4's item (h + 1)'s smoke is "Blend"))))) then
set OK to false
exit repeat
end if
set thisHouse's drink to thisDrink
end if
end repeat
if (OK) then
repeat with petPerm in petPermutations
-- Try to fit this permutation of pets.
copy sTemplate4 to sTemplate5
set {p, OK} to {0, true}
repeat with h from 1 to 5
set thisHouse to sTemplate5's item h
if (thisHouse's pet is mv) then
set p to p + 1
set thisPet to petPerm's item p
if ((thisPet is "birds") and (thisHouse's smoke is not "Pall Mall")) or ¬
((thisPet is "cats") and not ¬
(((h > 1) and (sTemplate5's item (h - 1)'s smoke is "Blend")) or ¬
((h < 5) and (sTemplate5's item (h + 1)'s smoke is "Blend")))) then
set OK to false
exit repeat
end if
set thisHouse's pet to thisPet
end if
end repeat
if (OK) then set end of solutions to sTemplate5
end repeat
end if
end repeat
end repeat
end if
end repeat
set solutionCount to (count solutions)
set owners to {}
repeat with thisSolution in solutions
repeat with thisHouse in thisSolution
if (thisHouse's pet is "zebra") then
set owners's end to thisHouse's resident
exit repeat
end if
end repeat
end repeat
return {zebraOwners:owners, numberOfSolutions:solutionCount, solutions:solutions}
end zebraPuzzle
zebraPuzzle()
- Output:
{zebraOwners:{"German"}, numberOfSolutions:1, solutions:{{{resident:"Norwegian", colour:"yellow", pet:"cats", drink:"water", smoke:"Dunhill"}, {resident:"Dane", colour:"blue", pet:"horse", drink:"tea", smoke:"Blend"}, {resident:"Englishman", colour:"red", pet:"birds", drink:"milk", smoke:"Pall Mall"}, {resident:"German", colour:"green", pet:"ZEBRA", drink:"coffee", smoke:"Prince"}, {resident:"Swede", colour:"white", pet:"dog", drink:"beer", smoke:"Blue Master"}}}}
AutoHotkey
See Dinesman's multiple-dwelling problem/AutoHotkey.
BBC BASIC
REM The names (only used for printing the results):
DIM Drink$(4), Nation$(4), Colr$(4), Smoke$(4), Animal$(4)
Drink$() = "Beer", "Coffee", "Milk", "Tea", "Water"
Nation$() = "Denmark", "England", "Germany", "Norway", "Sweden"
Colr$() = "Blue", "Green", "Red", "White", "Yellow"
Smoke$() = "Blend", "BlueMaster", "Dunhill", "PallMall", "Prince"
Animal$() = "Birds", "Cats", "Dog", "Horse", "Zebra"
REM Some single-character tags:
a$ = "A" : b$ = "B" : c$ = "C" : d$ = "D" : e$ = "E"
REM BBC BASIC Doesn't have enumerations!
Beer$=a$ : Coffee$=b$ : Milk$=c$ : Tea$=d$ : Water$=e$
Denmark$=a$ : England$=b$ : Germany$=c$ : Norway$=d$ : Sweden$=e$
Blue$=a$ : Green$=b$ : Red$=c$ : White$=d$ : Yellow$=e$
Blend$=a$ : BlueMaster$=b$ : Dunhill$=c$ : PallMall$=d$ : Prince$=e$
Birds$=a$ : Cats$=b$ : Dog$=c$ : Horse$=d$ : Zebra$=e$
REM Create the 120 permutations of 5 objects:
DIM perm$(120), x$(4) : x$() = a$, b$, c$, d$, e$
REPEAT
p% += 1
perm$(p%) = x$(0)+x$(1)+x$(2)+x$(3)+x$(4)
UNTIL NOT FNperm(x$())
REM Express the statements as conditional expressions:
ex2$ = "INSTR(Nation$,England$) = INSTR(Colr$,Red$)"
ex3$ = "INSTR(Nation$,Sweden$) = INSTR(Animal$,Dog$)"
ex4$ = "INSTR(Nation$,Denmark$) = INSTR(Drink$,Tea$)"
ex5$ = "INSTR(Colr$,Green$+White$) <> 0"
ex6$ = "INSTR(Drink$,Coffee$) = INSTR(Colr$,Green$)"
ex7$ = "INSTR(Smoke$,PallMall$) = INSTR(Animal$,Birds$)"
ex8$ = "INSTR(Smoke$,Dunhill$) = INSTR(Colr$,Yellow$)"
ex9$ = "MID$(Drink$,3,1) = Milk$"
ex10$ = "LEFT$(Nation$,1) = Norway$"
ex11$ = "ABS(INSTR(Smoke$,Blend$)-INSTR(Animal$,Cats$)) = 1"
ex12$ = "ABS(INSTR(Smoke$,Dunhill$)-INSTR(Animal$,Horse$)) = 1"
ex13$ = "INSTR(Smoke$,BlueMaster$) = INSTR(Drink$,Beer$)"
ex14$ = "INSTR(Nation$,Germany$) = INSTR(Smoke$,Prince$)"
ex15$ = "ABS(INSTR(Nation$,Norway$)-INSTR(Colr$,Blue$)) = 1"
ex16$ = "ABS(INSTR(Smoke$,Blend$)-INSTR(Drink$,Water$)) = 1"
REM Solve:
solutions% = 0
TIME = 0
FOR nation% = 1 TO 120
Nation$ = perm$(nation%)
IF EVAL(ex10$) THEN
FOR colr% = 1 TO 120
Colr$ = perm$(colr%)
IF EVAL(ex5$) IF EVAL(ex2$) IF EVAL(ex15$) THEN
FOR drink% = 1 TO 120
Drink$ = perm$(drink%)
IF EVAL(ex9$) IF EVAL(ex4$) IF EVAL(ex6$) THEN
FOR smoke% = 1 TO 120
Smoke$ = perm$(smoke%)
IF EVAL(ex14$) IF EVAL(ex13$) IF EVAL(ex16$) IF EVAL(ex8$) THEN
FOR animal% = 1 TO 120
Animal$ = perm$(animal%)
IF EVAL(ex3$) IF EVAL(ex7$) IF EVAL(ex11$) IF EVAL(ex12$) THEN
PRINT "House Drink Nation Colour Smoke Animal"
FOR house% = 1 TO 5
PRINT ; house% ,;
PRINT Drink$(ASCMID$(Drink$,house%)-65),;
PRINT Nation$(ASCMID$(Nation$,house%)-65),;
PRINT Colr$(ASCMID$(Colr$,house%)-65),;
PRINT Smoke$(ASCMID$(Smoke$,house%)-65),;
PRINT Animal$(ASCMID$(Animal$,house%)-65)
NEXT
solutions% += 1
ENDIF
NEXT animal%
ENDIF
NEXT smoke%
ENDIF
NEXT drink%
ENDIF
NEXT colr%
ENDIF
NEXT nation%
PRINT '"Number of solutions = "; solutions%
PRINT "Solved in " ; TIME/100 " seconds"
END
DEF FNperm(x$())
LOCAL i%, j%
FOR i% = DIM(x$(),1)-1 TO 0 STEP -1
IF x$(i%) < x$(i%+1) EXIT FOR
NEXT
IF i% < 0 THEN = FALSE
j% = DIM(x$(),1)
WHILE x$(j%) <= x$(i%) j% -= 1 : ENDWHILE
SWAP x$(i%), x$(j%)
i% += 1
j% = DIM(x$(),1)
WHILE i% < j%
SWAP x$(i%), x$(j%)
i% += 1
j% -= 1
ENDWHILE
= TRUE
Output:
House Drink Nation Colour Smoke Animal 1 Water Norway Yellow Dunhill Cats 2 Tea Denmark Blue Blend Horse 3 Milk England Red PallMall Birds 4 Coffee Germany Green Prince Zebra 5 Beer Sweden White BlueMasterDog Number of solutions = 1 Solved in 0.12 seconds
Bracmat
( (English Swede Dane Norwegian German,)
(red green white yellow blue,(red.English.))
(dog birds cats horse zebra,(dog.?.Swede.))
( tea coffee milk beer water
, (tea.?.?.Dane.) (coffee.?.green.?.)
)
( "Pall Mall" Dunhill Blend "Blue Master" Prince
, ("Blue Master".beer.?.?.?.)
("Pall Mall".?.birds.?.?.)
(Dunhill.?.?.yellow.?.)
(Prince.?.?.?.German.)
)
( 1 2 3 4 5
, (3.?.milk.?.?.?.) (1.?.?.?.?.Norwegian.)
)
: ?properties
& ( relations
= next leftOf
. ( next
= a b A B
. !arg:(?S,?A,?B)
& !S:? (?a.!A) ?:? (?b.!B) ?
& (!a+1:!b|!b+1:!a)
)
& ( leftOf
= a b A B
. !arg:(?S,?A,?B)
& !S:? (?a.!A) ?:? (?b.!B) ?
& !a+1:!b
)
& leftOf
$ (!arg,(?.?.?.green.?.),(?.?.?.white.?.))
& next$(!arg,(Blend.?.?.?.?.),(?.?.cats.?.?.))
& next
$ (!arg,(?.?.horse.?.?.),(Dunhill.?.?.?.?.))
& next
$ (!arg,(?.?.?.?.Norwegian.),(?.?.?.blue.?.))
& next$(!arg,(?.water.?.?.?.),(Blend.?.?.?.?.))
)
& ( props
= a constraint constraints house houses
, remainingToDo shavedToDo toDo value values z
. !arg:(?toDo.?shavedToDo.?house.?houses)
& ( !toDo:(?values,?constraints) ?remainingToDo
& !values
: ( ?a
( %@?value
& !constraints
: ( ?
( !value
. ?constraint
& !house:!constraint
)
?
| ~( ?
( ?
. ?constraint
& !house:!constraint
)
?
| ? (!value.?) ?
)
)
)
( ?z
& props
$ ( !remainingToDo
. !shavedToDo (!a !z,!constraints)
. (!value.!house)
. !houses
)
)
|
& relations$!houses
& out$(Solution !houses)
)
| !toDo:
& props$(!shavedToDo...!house !houses)
)
)
& props$(!properties...)
& done
);Output:
Solution
(4.Prince.coffee.zebra.green.German.)
(1.Dunhill.water.cats.yellow.Norwegian.)
(2.Blend.tea.horse.blue.Dane.)
(5.Blue Master.beer.dog.white.Swede.)
(3.Pall Mall.milk.birds.red.English.)
{!} done
C
#include <stdio.h>
#include <string.h>
enum HouseStatus { Invalid, Underfull, Valid };
enum Attrib { C, M, D, A, S };
// Unfilled attributes are represented by -1
enum Colors { Red, Green, White, Yellow, Blue };
enum Mans { English, Swede, Dane, German, Norwegian };
enum Drinks { Tea, Coffee, Milk, Beer, Water };
enum Animals { Dog, Birds, Cats, Horse, Zebra };
enum Smokes { PallMall, Dunhill, Blend, BlueMaster, Prince };
void printHouses(int ha[5][5]) {
const char *color[] = { "Red", "Green", "White", "Yellow", "Blue" };
const char *man[] = { "English", "Swede", "Dane", "German", "Norwegian" };
const char *drink[] = { "Tea", "Coffee", "Milk", "Beer", "Water" };
const char *animal[] = { "Dog", "Birds", "Cats", "Horse", "Zebra" };
const char *smoke[] = { "PallMall", "Dunhill", "Blend", "BlueMaster", "Prince" };
printf("%-10.10s%-10.10s%-10.10s%-10.10s%-10.10s%-10.10s\n",
"House", "Color", "Man", "Drink", "Animal", "Smoke");
for (int i = 0; i < 5; i++) {
printf("%-10d", i);
if (ha[i][C] >= 0)
printf("%-10.10s", color[ha[i][C]]);
else
printf("%-10.10s", "-");
if (ha[i][M] >= 0)
printf("%-10.10s", man[ha[i][M]]);
else
printf("%-10.10s", "-");
if (ha[i][D] >= 0)
printf("%-10.10s", drink[ha[i][D]]);
else
printf("%-10.10s", "-");
if (ha[i][A] >= 0)
printf("%-10.10s", animal[ha[i][A]]);
else
printf("%-10.10s", "-");
if (ha[i][S] >= 0)
printf("%-10.10s\n", smoke[ha[i][S]]);
else
printf("-\n");
}
}
int checkHouses(int ha[5][5]) {
int c_add = 0, c_or = 0;
int m_add = 0, m_or = 0;
int d_add = 0, d_or = 0;
int a_add = 0, a_or = 0;
int s_add = 0, s_or = 0;
// Cond 9: In the middle house they drink milk.
if (ha[2][D] >= 0 && ha[2][D] != Milk)
return Invalid;
// Cond 10: The Norwegian lives in the first house.
if (ha[0][M] >= 0 && ha[0][M] != Norwegian)
return Invalid;
for (int i = 0; i < 5; i++) {
// Uniqueness tests.
if (ha[i][C] >= 0) {
c_add += (1 << ha[i][C]);
c_or |= (1 << ha[i][C]);
}
if (ha[i][M] >= 0) {
m_add += (1 << ha[i][M]);
m_or |= (1 << ha[i][M]);
}
if (ha[i][D] >= 0) {
d_add += (1 << ha[i][D]);
d_or |= (1 << ha[i][D]);
}
if (ha[i][A] >= 0) {
a_add += (1 << ha[i][A]);
a_or |= (1 << ha[i][A]);
}
if (ha[i][S] >= 0) {
s_add += (1 << ha[i][S]);
s_or |= (1 << ha[i][S]);
}
// Cond 2: The English man lives in the red house.
if ((ha[i][M] >= 0 && ha[i][C] >= 0) &&
((ha[i][M] == English && ha[i][C] != Red) || // Checking both
(ha[i][M] != English && ha[i][C] == Red))) // to make things quicker.
return Invalid;
// Cond 3: The Swede has a dog.
if ((ha[i][M] >= 0 && ha[i][A] >= 0) &&
((ha[i][M] == Swede && ha[i][A] != Dog) ||
(ha[i][M] != Swede && ha[i][A] == Dog)))
return Invalid;
// Cond 4: The Dane drinks tea.
if ((ha[i][M] >= 0 && ha[i][D] >= 0) &&
((ha[i][M] == Dane && ha[i][D] != Tea) ||
(ha[i][M] != Dane && ha[i][D] == Tea)))
return Invalid;
// Cond 5: The green house is immediately to the left of the white house.
if ((i > 0 && ha[i][C] >= 0 /*&& ha[i-1][C] >= 0 */ ) &&
((ha[i - 1][C] == Green && ha[i][C] != White) ||
(ha[i - 1][C] != Green && ha[i][C] == White)))
return Invalid;
// Cond 6: drink coffee in the green house.
if ((ha[i][C] >= 0 && ha[i][D] >= 0) &&
((ha[i][C] == Green && ha[i][D] != Coffee) ||
(ha[i][C] != Green && ha[i][D] == Coffee)))
return Invalid;
// Cond 7: The man who smokes Pall Mall has birds.
if ((ha[i][S] >= 0 && ha[i][A] >= 0) &&
((ha[i][S] == PallMall && ha[i][A] != Birds) ||
(ha[i][S] != PallMall && ha[i][A] == Birds)))
return Invalid;
// Cond 8: In the yellow house they smoke Dunhill.
if ((ha[i][S] >= 0 && ha[i][C] >= 0) &&
((ha[i][S] == Dunhill && ha[i][C] != Yellow) ||
(ha[i][S] != Dunhill && ha[i][C] == Yellow)))
return Invalid;
// Cond 11: The man who smokes Blend lives in the house next to the house with cats.
if (ha[i][S] == Blend) {
if (i == 0 && ha[i + 1][A] >= 0 && ha[i + 1][A] != Cats)
return Invalid;
else if (i == 4 && ha[i - 1][A] != Cats)
return Invalid;
else if (ha[i + 1][A] >= 0 && ha[i + 1][A] != Cats && ha[i - 1][A] != Cats)
return Invalid;
}
// Cond 12: In a house next to the house where they have a horse, they smoke Dunhill.
if (ha[i][S] == Dunhill) {
if (i == 0 && ha[i + 1][A] >= 0 && ha[i + 1][A] != Horse)
return Invalid;
else if (i == 4 && ha[i - 1][A] != Horse)
return Invalid;
else if (ha[i + 1][A] >= 0 && ha[i + 1][A] != Horse && ha[i - 1][A] != Horse)
return Invalid;
}
// Cond 13: The man who smokes Blue Master drinks beer.
if ((ha[i][S] >= 0 && ha[i][D] >= 0) &&
((ha[i][S] == BlueMaster && ha[i][D] != Beer) ||
(ha[i][S] != BlueMaster && ha[i][D] == Beer)))
return Invalid;
// Cond 14: The German smokes Prince
if ((ha[i][M] >= 0 && ha[i][S] >= 0) &&
((ha[i][M] == German && ha[i][S] != Prince) ||
(ha[i][M] != German && ha[i][S] == Prince)))
return Invalid;
// Cond 15: The Norwegian lives next to the blue house.
if (ha[i][M] == Norwegian &&
((i < 4 && ha[i + 1][C] >= 0 && ha[i + 1][C] != Blue) ||
(i > 0 && ha[i - 1][C] != Blue)))
return Invalid;
// Cond 16: They drink water in a house next to the house where they smoke Blend.
if (ha[i][S] == Blend) {
if (i == 0 && ha[i + 1][D] >= 0 && ha[i + 1][D] != Water)
return Invalid;
else if (i == 4 && ha[i - 1][D] != Water)
return Invalid;
else if (ha[i + 1][D] >= 0 && ha[i + 1][D] != Water && ha[i - 1][D] != Water)
return Invalid;
}
}
if ((c_add != c_or) || (m_add != m_or) || (d_add != d_or)
|| (a_add != a_or) || (s_add != s_or)) {
return Invalid;
}
if ((c_add != 0b11111) || (m_add != 0b11111) || (d_add != 0b11111)
|| (a_add != 0b11111) || (s_add != 0b11111)) {
return Underfull;
}
return Valid;
}
int bruteFill(int ha[5][5], int hno, int attr) {
int stat = checkHouses(ha);
if ((stat == Valid) || (stat == Invalid))
return stat;
int hb[5][5];
memcpy(hb, ha, sizeof(int) * 5 * 5);
for (int i = 0; i < 5; i++) {
hb[hno][attr] = i;
stat = checkHouses(hb);
if (stat != Invalid) {
int nexthno, nextattr;
if (attr < 4) {
nextattr = attr + 1;
nexthno = hno;
} else {
nextattr = 0;
nexthno = hno + 1;
}
stat = bruteFill(hb, nexthno, nextattr);
if (stat != Invalid) {
memcpy(ha, hb, sizeof(int) * 5 * 5);
return stat;
}
}
}
// We only come here if none of the attr values assigned were valid.
return Invalid;
}
int main() {
int ha[5][5] = {{-1, -1, -1, -1, -1}, {-1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1}, {-1, -1, -1, -1, -1},
{-1, -1, -1, -1, -1}};
bruteFill(ha, 0, 0);
printHouses(ha);
return 0;
}
- Output:
% gcc -Wall -O3 -std=c99 zebra.c -o zebra && time ./zebra House Color Man Drink Animal Smoke 0 Yellow Norwegian Water Cats Dunhill 1 Blue Dane Tea Horse Blend 2 Red English Milk Birds PallMall 3 Green German Coffee Zebra Prince 4 White Swede Beer Dog BlueMaster ./zebra 0.00s user 0.00s system 0% cpu 0.002 total
The execution time is too small to be reliably measured on my machine.
C Generated from Perl
I'll be the first to admit the following doesn't quite look like a C program. It's in fact in Perl, which outputs a C source, which in turn solves the puzzle. If you think this is long, wait till you see the C it writes.
#!/usr/bin/perl
use utf8;
no strict;
my (%props, %name, @pre, @conds, @works, $find_all_solutions);
sub do_consts {
local $";
for my $p (keys %props) {
my @s = @{ $props{$p} };
$" = ", ";
print "enum { ${p}_none = 0, @s };\n";
$" = '", "';
print "const char *string_$p [] = { \"###\", \"@s\" };\n\n";
}
print "#define FIND_BY(p) \\
int find_by_##p(int v) { \\
int i; \\
for (i = 0; i < N_ITEMS; i++) \\
if (house[i].p == v) return i; \\
return -1; }\n";
print "FIND_BY($_)" for (keys %props);
local $" = ", ";
my @k = keys %props;
my $sl = 0;
for (keys %name) {
if (length > $sl) { $sl = length }
}
my $fmt = ("%".($sl + 1)."s ") x @k;
my @arg = map { "string_$_"."[house[i].$_]" } @k;
print << "SNIPPET";
int work0(void) {
int i;
for (i = 0; i < N_ITEMS; i++)
printf("%d $fmt\\n", i, @arg);
puts(\"\");
return 1;
}
SNIPPET
}
sub setprops {
%props = @_;
my $l = 0;
my @k = keys %props;
for my $p (@k) {
my @s = @{ $props{$p} };
if ($l && $l != @s) {
die "bad length @s";
}
$l = @s;
$name{$_} = $p for @s;
}
local $" = ", ";
print "#include <stdio.h>
#define N_ITEMS $l
struct item_t { int @k; } house[N_ITEMS] = {{0}};\n";
}
sub pair {NB. h =.~.&> compose&.>~/y,<h
my ($c1, $c2, $diff) = @_;
$diff //= [0];
$diff = [$diff] unless ref $diff;
push @conds, [$c1, $c2, $diff];
}
sub make_conditions {
my $idx = 0;
my $return1 = $find_all_solutions ? "" : "return 1";
print "
#define TRY(a, b, c, d, p, n) \\
if ((b = a d) >= 0 && b < N_ITEMS) { \\
if (!house[b].p) { \\
house[b].p = c; \\
if (n()) $return1; \\
house[b].p = 0; \\
}}
";
while (@conds) {
my ($c1, $c2, $diff) = @{ pop @conds };
my $p2 = $name{$c2} or die "bad prop $c2";
if ($c1 =~ /^\d+$/) {
push @pre, "house[$c1].$p2 = $c2;";
next;
}
my $p1 = $name{$c1} or die "bad prop $c1";
my $next = "work$idx";
my $this = "work".++$idx;
print "
/* condition pair($c1, $c2, [@$diff]) */
int $this(void) {
int a = find_by_$p1($c1);
int b = find_by_$p2($c2);
if (a != -1 && b != -1) {
switch(b - a) {
";
print "case $_: " for @$diff;
print "return $next(); default: return 0; }\n } if (a != -1) {";
print "TRY(a, b, $c2, +($_), $p2, $next);" for @$diff;
print " return 0; } if (b != -1) {";
print "TRY(b, a, $c1, -($_), $p1, $next);" for @$diff;
print "
return 0; }
/* neither condition is set; try all possibles */
for (a = 0; a < N_ITEMS; a++) {
if (house[a].$p1) continue;
house[a].$p1 = $c1;
";
print "TRY(a, b, $c2, +($_), $p2, $next);" for @$diff;
print " house[a].$p1 = 0; } return 0; }";
}
print "int main() { @pre return !work$idx(); }";
}
sub make_c {
do_consts;
make_conditions;
}
# ---- above should be generic for all similar puzzles ---- #
# ---- below: per puzzle setup ---- #
# property names and values
setprops (
'nationality' # Svensk n. a Swede, not a swede (kålrot).
# AEnglisk (from middle Viking "Æŋløsåksen") n. a Brit.
=> [ qw(Deutsch Svensk Norske Danske AEnglisk) ],
'pet' => [ qw(birds dog horse zebra cats) ],
'drink' => [ qw(water tea milk beer coffee) ],
'smoke' => [ qw(dunhill blue_master prince blend pall_mall) ],
'color' => [ qw(red green yellow white blue) ]
);
# constraints
pair(AEnglisk, red);
pair(Svensk, dog);
pair(Danske, tea);
pair(green, white, 1); # "to the left of" can mean either 1 or -1: ambiguous
pair(coffee, green);
pair(pall_mall, birds);
pair(yellow, dunhill);
pair(2, milk);
pair(0, Norske);
pair(blend, cats, [-1, 1]);
pair(horse, dunhill, [-1, 1]);
pair(blue_master, beer); # Nicht das Deutsche Bier trinken? Huh.
pair(Deutsch, prince);
pair(Norske, blue, [-1, 1]);
pair(water, blend, [-1, 1]);
# "zebra lives *somewhere* relative to the Brit". It has no effect on
# the logic. It's here just to make sure the code will insert a zebra
# somewhere in the table (after all other conditions are met) so the
# final print-out shows it. (the C code can be better structured, but
# meh, I ain't reading it, so who cares).
pair(zebra, AEnglisk, [ -4 .. 4 ]);
# write C code. If it's ugly to you: I didn't write; Perl did.
make_c;
output (ran as perl test.pl | gcc -Wall -x c -; ./a.out):
0 dunhill cats yellow water Norske 1 blend horse blue tea Danske 2 pall_mall birds red milk AEnglisk 3 prince zebra green coffee Deutsch 4 blue_master dog white beer Svensk
C#
"Manual" solution (Norvig-style)
This is adapted from a solution to a similar problem by Peter Norvig in his Udacity course CS212, originally written in Python. This is translated from example python solution on exercism. This is a Generate-and-Prune Constraint Programming algorithm written with Linq. (See Benchmarks below)
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using static System.Console;
public enum Colour { Red, Green, White, Yellow, Blue }
public enum Nationality { Englishman, Swede, Dane, Norwegian,German }
public enum Pet { Dog, Birds, Cats, Horse, Zebra }
public enum Drink { Coffee, Tea, Milk, Beer, Water }
public enum Smoke { PallMall, Dunhill, Blend, BlueMaster, Prince}
public static class ZebraPuzzle
{
private static (Colour[] colours, Drink[] drinks, Smoke[] smokes, Pet[] pets, Nationality[] nations) _solved;
static ZebraPuzzle()
{
var solve = from colours in Permute<Colour>() //r1 5 range
where (colours,Colour.White).IsRightOf(colours, Colour.Green) // r5
from nations in Permute<Nationality>()
where nations[0] == Nationality.Norwegian // r10
where (nations, Nationality.Englishman).IsSameIndex(colours, Colour.Red) //r2
where (nations,Nationality.Norwegian).IsNextTo(colours,Colour.Blue) // r15
from drinks in Permute<Drink>()
where drinks[2] == Drink.Milk //r9
where (drinks, Drink.Coffee).IsSameIndex(colours, Colour.Green) // r6
where (drinks, Drink.Tea).IsSameIndex(nations, Nationality.Dane) //r4
from pets in Permute<Pet>()
where (pets, Pet.Dog).IsSameIndex(nations, Nationality.Swede) // r3
from smokes in Permute<Smoke>()
where (smokes, Smoke.PallMall).IsSameIndex(pets, Pet.Birds) // r7
where (smokes, Smoke.Dunhill).IsSameIndex(colours, Colour.Yellow) // r8
where (smokes, Smoke.Blend).IsNextTo(pets, Pet.Cats) // r11
where (smokes, Smoke.Dunhill).IsNextTo(pets, Pet.Horse) //r12
where (smokes, Smoke.BlueMaster).IsSameIndex(drinks, Drink.Beer) //r13
where (smokes, Smoke.Prince).IsSameIndex(nations, Nationality.German) // r14
where (drinks,Drink.Water).IsNextTo(smokes,Smoke.Blend) // r16
select (colours, drinks, smokes, pets, nations);
_solved = solve.First();
}
private static int IndexOf<T>(this T[] arr, T obj) => Array.IndexOf(arr, obj);
private static bool IsRightOf<T, U>(this (T[] a, T v) right, U[] a, U v) => right.a.IndexOf(right.v) == a.IndexOf(v) + 1;
private static bool IsSameIndex<T, U>(this (T[] a, T v)x, U[] a, U v) => x.a.IndexOf(x.v) == a.IndexOf(v);
private static bool IsNextTo<T, U>(this (T[] a, T v)x, U[] a, U v) => (x.a,x.v).IsRightOf(a, v) || (a,v).IsRightOf(x.a,x.v);
// made more generic from https://codereview.stackexchange.com/questions/91808/permutations-in-c
public static IEnumerable<IEnumerable<T>> Permutations<T>(this IEnumerable<T> values)
{
if (values.Count() == 1)
return values.ToSingleton();
return values.SelectMany(v => Permutations(values.Except(v.ToSingleton())),(v, p) => p.Prepend(v));
}
public static IEnumerable<T[]> Permute<T>() => ToEnumerable<T>().Permutations().Select(p=>p.ToArray());
private static IEnumerable<T> ToSingleton<T>(this T item){ yield return item; }
private static IEnumerable<T> ToEnumerable<T>() => Enum.GetValues(typeof(T)).Cast<T>();
public static new String ToString()
{
var sb = new StringBuilder();
sb.AppendLine("House Colour Drink Nationality Smokes Pet");
sb.AppendLine("───── ────── ──────── ─────────── ────────── ─────");
var (colours, drinks, smokes, pets, nations) = _solved;
for (var i = 0; i < 5; i++)
sb.AppendLine($"{i+1,5} {colours[i],-6} {drinks[i],-8} {nations[i],-11} {smokes[i],-10} {pets[i],-10}");
return sb.ToString();
}
public static void Main(string[] arguments)
{
var owner = _solved.nations[_solved.pets.IndexOf(Pet.Zebra)];
WriteLine($"The zebra owner is {owner}");
Write(ToString());
Read();
}
}
Produces:
The zebra owner is German
House Colour Drink Nationality Smokes Pet
───── ────── ──────── ─────────── ────────── ─────
1 Yellow Water Norwegian Dunhill Cats
2 Blue Tea Dane Blend Horse
3 Red Milk Englishman PallMall Birds
4 Green Coffee German Prince Zebra
5 White Beer Swede BlueMaster Dog
"Manual" solution (Combining Houses)
This is similar to the Scala solution although there are differences in how the rules are calculated and it keeps all the original constraints/rules rather than does any simplification of them.
This is a different type of generate-and-prune compared to Norvig. The Norvig solution generates each attribute for 5 houses, then prunes and repeats with the next attribute. Here all houses with possible attributes are first generated and pruned to 78 candidates. The second phase proceeds over the combination of 5 houses from that 78, generating and pruning 1 house at a time. (See Benchmarks below)
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using static System.Console;
namespace ZebraPuzzleSolver
{
public enum Colour { Red, Green, White, Yellow, Blue }
public enum Nationality { Englishman, Swede, Dane, Norwegian, German }
public enum Pet { Dog, Birds, Cats, Horse, Zebra }
public enum Drink { Coffee, Tea, Milk, Beer, Water }
public enum Smoke { PallMall, Dunhill, Blend, BlueMaster, Prince }
public struct House
{
public Drink D { get; }
public Colour C { get; }
public Pet P { get; }
public Nationality N { get; }
public Smoke S { get; }
House(Drink d, Colour c, Pet p, Nationality n, Smoke s) => (D, C, P, N, S) = (d, c, p, n, s);
public static House Create(Drink d, Colour c, Pet p, Nationality n, Smoke s) => new House(d, c, p, n, s);
public bool AllUnequal(House other) => D != other.D && C != other.C && P != other.P && N != other.N && S != other.S;
public override string ToString() =>$"{C,-6} {D,-8} {N,-11} {S,-10} {P,-10}";
}
public static class LinqNoPerm
{
public static IEnumerable<T> ToEnumerable<T>() => Enum.GetValues(typeof(T)).Cast<T>();
public static IEnumerable<House> FreeCandidates(this IEnumerable<House> houses, IEnumerable<House> picked) =>
houses.Where(house => picked.All(house.AllUnequal));
static Dictionary<Type, Func<House, dynamic, bool>> _eFn = new Dictionary<Type, Func<House, dynamic, bool>>
{ {typeof(Drink),(h,e)=>h.D==e},
{typeof(Nationality),(h,e)=>h.N==e},
{typeof(Colour),(h,e)=>h.C==e},
{typeof(Pet),(h,e)=>h.P==e},
{typeof(Smoke),(h, e)=>h.S==e}
};
public static bool IsNextTo<T, U>(this IEnumerable<House> hs,T t, U u) => hs.IsLeftOf(t,u) || hs.IsLeftOf(u, t);
public static bool IsLeftOf<T, U>(this IEnumerable<House> hs, T left, U right) =>
hs.Zip(hs.Skip(1), (l, r) => (_eFn[left.GetType()](l, left) && _eFn[right.GetType()](r, right))).Any(l => l);
static House[] _solved;
static LinqNoPerm()
{
var candidates =
from colours in ToEnumerable<Colour>()
from nations in ToEnumerable<Nationality>()
from drinks in ToEnumerable<Drink>()
from pets in ToEnumerable<Pet>()
from smokes in ToEnumerable<Smoke>()
where (colours == Colour.Red) == (nations == Nationality.Englishman) //r2
where (nations == Nationality.Swede) == (pets == Pet.Dog) //r3
where (nations == Nationality.Dane) == (drinks == Drink.Tea) //r4
where (colours == Colour.Green) == (drinks == Drink.Coffee) //r6
where (smokes == Smoke.PallMall) == (pets == Pet.Birds) //r7
where (smokes == Smoke.Dunhill) == (colours == Colour.Yellow) // r8
where (smokes == Smoke.BlueMaster) == (drinks == Drink.Beer) //r13
where (smokes == Smoke.Prince) == (nations == Nationality.German) // r14
select House.Create(drinks,colours,pets,nations, smokes);
var members =
from h1 in candidates
where h1.N == Nationality.Norwegian //r10
from h3 in candidates.FreeCandidates(new[] { h1 })
where h3.D == Drink.Milk //r9
from h2 in candidates.FreeCandidates(new[] { h1, h3 })
let h123 = new[] { h1, h2, h3 }
where h123.IsNextTo(Nationality.Norwegian, Colour.Blue) //r15
where h123.IsNextTo(Smoke.Blend, Pet.Cats)//r11
where h123.IsNextTo(Smoke.Dunhill, Pet.Horse) //r12
from h4 in candidates.FreeCandidates(h123)
from h5 in candidates.FreeCandidates(new[] { h1, h3, h2, h4 })
let houses = new[] { h1, h2, h3, h4, h5 }
where houses.IsLeftOf(Colour.Green, Colour.White) //r5
select houses;
_solved = members.First();
}
public static new String ToString()
{
var sb = new StringBuilder();
sb.AppendLine("House Colour Drink Nationality Smokes Pet");
sb.AppendLine("───── ────── ──────── ─────────── ────────── ─────");
for (var i = 0; i < 5; i++)
sb.AppendLine($"{i + 1,5} {_solved[i].ToString()}");
return sb.ToString();
}
public static void Main(string[] arguments)
{
var owner = _solved.Where(h=>h.P==Pet.Zebra).Single().N;
WriteLine($"The zebra owner is {owner}");
Write(ToString());
Read();
}
}
}
Produces
The zebra owner is German
House Colour Drink Nationality Smokes Pet
───── ────── ──────── ─────────── ────────── ─────
1 Yellow Water Norwegian Dunhill Cats
2 Blue Tea Dane Blend Horse
3 Red Milk Englishman PallMall Birds
4 Green Coffee German Prince Zebra
5 White Beer Swede BlueMaster Dog
"Amb" solution
This uses the second version of the Amb C# class in the Amb challenge
using Amb;
using System;
using System.Collections.Generic;
using System.Linq;
using static System.Console;
static class ZebraProgram
{
public static void Main()
{
var amb = new Amb.Amb();
var domain = new[] { 1, 2, 3, 4, 5 };
var terms = new Dictionary<IValue<int>, string>();
IValue<int> Term(string name)
{
var x = amb.Choose(domain);
terms.Add(x, name);
return x;
};
void IsUnequal(params IValue<int>[] values) =>amb.Require(() => values.Select(v => v.Value).Distinct().Count() == 5);
void IsSame(IValue<int> left, IValue<int> right) => amb.Require(() => left.Value == right.Value);
void IsLeftOf(IValue<int> left, IValue<int> right) => amb.Require(() => right.Value - left.Value == 1);
void IsIn(IValue<int> attrib, int house) => amb.Require(() => attrib.Value == house);
void IsNextTo(IValue<int> left, IValue<int> right) => amb.Require(() => Math.Abs(left.Value - right.Value) == 1);
IValue<int> english = Term("Englishman"), swede = Term("Swede"), dane = Term("Dane"), norwegian = Term("Norwegian"), german = Term("German");
IsIn(norwegian, 1);
IsUnequal(english, swede, german, dane, norwegian);
IValue<int> red = Term("red"), green = Term("green"), white = Term("white"), blue = Term("blue"), yellow = Term("yellow");
IsUnequal(red, green, white, blue, yellow);
IsNextTo(norwegian, blue);
IsLeftOf(green, white);
IsSame(english, red);
IValue<int> tea = Term("tea"), coffee = Term("coffee"), milk = Term("milk"), beer = Term("beer"), water = Term("water");
IsIn(milk, 3);
IsUnequal(tea, coffee, milk, beer, water);
IsSame(dane, tea);
IsSame(green, coffee);
IValue<int> dog = Term("dog"), birds = Term("birds"), cats = Term("cats"), horse = Term("horse"), zebra = Term("zebra");
IsUnequal(dog, cats, birds, horse, zebra);
IsSame(swede, dog);
IValue<int> pallmall = Term("pallmall"), dunhill = Term("dunhill"), blend = Term("blend"), bluemaster = Term("bluemaster"),prince = Term("prince");
IsUnequal(pallmall, dunhill, bluemaster, prince, blend);
IsSame(pallmall, birds);
IsSame(dunhill, yellow);
IsNextTo(blend, cats);
IsNextTo(horse, dunhill);
IsSame(bluemaster, beer);
IsSame(german, prince);
IsNextTo(water, blend);
if (!amb.Disambiguate())
{
WriteLine("No solution found.");
Read();
return;
}
var h = new List<string>[5];
for (int i = 0; i < 5; i++)
h[i] = new List<string>();
foreach (var (key, value) in terms.Select(kvp => (kvp.Key, kvp.Value)))
{
h[key.Value - 1].Add(value);
}
var owner = String.Concat(h.Where(l => l.Contains("zebra")).Select(l => l[0]));
WriteLine($"The {owner} owns the zebra");
foreach (var house in h)
{
Write("|");
foreach (var attrib in house)
Write($"{attrib,-10}|");
Write("\n");
}
Read();
}
}
Produces
The zebra owner is German
House Colour Drink Nationality Smokes Pet
───── ────── ──────── ─────────── ────────── ─────
1 Yellow Water Norwegian Dunhill Cats
2 Blue Tea Dane Blend Horse
3 Red Milk Englishman PallMall Birds
4 Green Coffee German Prince Zebra
5 White Beer Swede BlueMaster Dog
"Automatic" solution
using System;
using System.Collections.Generic;
using System.Linq;
using System.Text;
using Microsoft.SolverFoundation.Solvers;
using static System.Console;
static class ZebraProgram
{
static ConstraintSystem _solver;
static CspTerm IsLeftOf(this CspTerm left, CspTerm right) => _solver.Equal(1, right - left);
static CspTerm IsInSameHouseAs(this CspTerm left, CspTerm right) => _solver.Equal(left, right);
static CspTerm IsNextTo(this CspTerm left, CspTerm right) => _solver.Equal(1,_solver.Abs(left-right));
static CspTerm IsInHouse(this CspTerm @this, int i) => _solver.Equal(i, @this);
static (ConstraintSystem, Dictionary<CspTerm, string>) BuildSolver()
{
var solver = ConstraintSystem.CreateSolver();
_solver = solver;
var terms = new Dictionary<CspTerm, string>();
CspTerm Term(string name)
{
CspTerm x = solver.CreateVariable(solver.CreateIntegerInterval(1, 5), name);
terms.Add(x, name);
return x;
};
CspTerm red = Term("red"), green = Term("green"), white = Term("white"), blue = Term("blue"), yellow = Term("yellow");
CspTerm tea = Term("tea"), coffee = Term("coffee"), milk = Term("milk"), beer = Term("beer"), water = Term("water");
CspTerm english = Term("Englishman"), swede = Term("Swede"), dane = Term("Dane"), norwegian = Term("Norwegian"),
german = Term("German");
CspTerm dog = Term("dog"), birds = Term("birds"), cats = Term("cats"), horse = Term("horse"), zebra = Term("zebra");
CspTerm pallmall = Term("pallmall"), dunhill = Term("dunhill"), blend = Term("blend"), bluemaster = Term("bluemaster"),
prince = Term("prince");
solver.AddConstraints(
solver.Unequal(english, swede, german, dane, norwegian),
solver.Unequal(red, green, white, blue, yellow),
solver.Unequal(dog, cats, birds, horse, zebra),
solver.Unequal(pallmall, dunhill, bluemaster, prince, blend),
solver.Unequal(tea, coffee, milk, beer, water),
english.IsInSameHouseAs(red), //r2
swede.IsInSameHouseAs(dog), //r3
dane.IsInSameHouseAs(tea), //r4
green.IsLeftOf(white), //r5
green.IsInSameHouseAs(coffee), //r6
pallmall.IsInSameHouseAs(birds), //r7
dunhill.IsInSameHouseAs(yellow), //r8
milk.IsInHouse(3), //r9
norwegian.IsInHouse(1), //r10
blend.IsNextTo(cats), //r11
horse.IsNextTo(dunhill),// r12
bluemaster.IsInSameHouseAs(beer), // r13
german.IsInSameHouseAs(prince), // r14
norwegian.IsNextTo(blue), //r15
water.IsNextTo(blend) //r16
);
return (solver, terms);
}
static List<string>[] TermsToString(ConstraintSolverSolution solved, Dictionary<CspTerm, string> terms)
{
var h = new List<string>[5];
for (int i = 0; i < 5; i++)
h[i] = new List<string>();
foreach (var (key, value) in terms.Select(kvp => (kvp.Key, kvp.Value)))
{
if (!solved.TryGetValue(key, out object house))
throw new InvalidProgramException("Can't find a term - {value} - in the solution");
h[(int)house - 1].Add(value);
}
return h;
}
static new string ToString(List<string>[] houses)
{
var sb = new StringBuilder();
foreach (var house in houses)
{
sb.Append("|");
foreach (var attrib in house)
sb.Append($"{attrib,-10}|");
sb.Append("\n");
}
return sb.ToString();
}
public static void Main()
{
var (solver, terms) = BuildSolver();
var solved = solver.Solve();
if (solved.HasFoundSolution)
{
var h = TermsToString(solved, terms);
var owner = String.Concat(h.Where(l => l.Contains("zebra")).Select(l => l[2]));
WriteLine($"The {owner} owns the zebra");
WriteLine();
Write(ToString(h));
}
else
WriteLine("No solution found.");
Read();
}
}
Produces:
The German owns the zebra |yellow |water |Norwegian |cats |dunhill | |blue |tea |Dane |horse |blend | |red |milk |Englishman|birds |pallmall | |green |coffee |German |zebra |prince | |white |beer |Swede |dog |bluemaster|
Benchmarking the 3 solutions:
BenchmarkDotNet=v0.10.12, OS=Windows 10 Redstone 3 [1709, Fall Creators Update] (10.0.16299.192) Intel Core i7-7500U CPU 2.70GHz (Kaby Lake), 1 CPU, 4 logical cores and 2 physical cores Frequency=2835943 Hz, Resolution=352.6164 ns, Timer=TSC DefaultJob : .NET Framework 4.6.1 (CLR 4.0.30319.42000), 64bit RyuJIT-v4.7.2600.0 Method Mean Error StdDev Norvig 65.32 ms 1.241 ms 1.328 ms Combin 93.62 ms 1.792 ms 1.918 ms Solver 148.7 us 2.962 us 6.248 us
I think that it is Enums (not the use of dynamic in a dictionary, which is only called 8 times in Combine), and Linq query comprehensions (versus for loops) slow down the 2 non_solver solutions. A non-type-safe non-Enum int version of Combine (not posted here) runs at ~21ms, which is a nearly 5x speed up for that algo. (Not tried with Norvig). Regardless, learning and using the Solver class (and that solution already uses ints rather than enums) provides a dramatic x 100 + performance increase compared to the best manual solutions.
C++
This is a modification of the C submission that uses rule classes and reduces the number of permutations evaluated.
#include <stdio.h>
#include <string.h>
#define defenum(name, val0, val1, val2, val3, val4) \
enum name { val0, val1, val2, val3, val4 }; \
const char *name ## _str[] = { # val0, # val1, # val2, # val3, # val4 }
defenum( Attrib, Color, Man, Drink, Animal, Smoke );
defenum( Colors, Red, Green, White, Yellow, Blue );
defenum( Mans, English, Swede, Dane, German, Norwegian );
defenum( Drinks, Tea, Coffee, Milk, Beer, Water );
defenum( Animals, Dog, Birds, Cats, Horse, Zebra );
defenum( Smokes, PallMall, Dunhill, Blend, BlueMaster, Prince );
void printHouses(int ha[5][5]) {
const char **attr_names[5] = {Colors_str, Mans_str, Drinks_str, Animals_str, Smokes_str};
printf("%-10s", "House");
for (const char *name : Attrib_str) printf("%-10s", name);
printf("\n");
for (int i = 0; i < 5; i++) {
printf("%-10d", i);
for (int j = 0; j < 5; j++) printf("%-10s", attr_names[j][ha[i][j]]);
printf("\n");
}
}
struct HouseNoRule {
int houseno;
Attrib a; int v;
} housenos[] = {
{2, Drink, Milk}, // Cond 9: In the middle house they drink milk.
{0, Man, Norwegian} // Cond 10: The Norwegian lives in the first house.
};
struct AttrPairRule {
Attrib a1; int v1;
Attrib a2; int v2;
bool invalid(int ha[5][5], int i) {
return (ha[i][a1] >= 0 && ha[i][a2] >= 0) &&
((ha[i][a1] == v1 && ha[i][a2] != v2) ||
(ha[i][a1] != v1 && ha[i][a2] == v2));
}
} pairs[] = {
{Man, English, Color, Red}, // Cond 2: The English man lives in the red house.
{Man, Swede, Animal, Dog}, // Cond 3: The Swede has a dog.
{Man, Dane, Drink, Tea}, // Cond 4: The Dane drinks tea.
{Color, Green, Drink, Coffee}, // Cond 6: drink coffee in the green house.
{Smoke, PallMall, Animal, Birds}, // Cond 7: The man who smokes Pall Mall has birds.
{Smoke, Dunhill, Color, Yellow}, // Cond 8: In the yellow house they smoke Dunhill.
{Smoke, BlueMaster, Drink, Beer}, // Cond 13: The man who smokes Blue Master drinks beer.
{Man, German, Smoke, Prince} // Cond 14: The German smokes Prince
};
struct NextToRule {
Attrib a1; int v1;
Attrib a2; int v2;
bool invalid(int ha[5][5], int i) {
return (ha[i][a1] == v1) &&
((i == 0 && ha[i + 1][a2] >= 0 && ha[i + 1][a2] != v2) ||
(i == 4 && ha[i - 1][a2] != v2) ||
(ha[i + 1][a2] >= 0 && ha[i + 1][a2] != v2 && ha[i - 1][a2] != v2));
}
} nexttos[] = {
{Smoke, Blend, Animal, Cats}, // Cond 11: The man who smokes Blend lives in the house next to the house with cats.
{Smoke, Dunhill, Animal, Horse}, // Cond 12: In a house next to the house where they have a horse, they smoke Dunhill.
{Man, Norwegian, Color, Blue}, // Cond 15: The Norwegian lives next to the blue house.
{Smoke, Blend, Drink, Water} // Cond 16: They drink water in a house next to the house where they smoke Blend.
};
struct LeftOfRule {
Attrib a1; int v1;
Attrib a2; int v2;
bool invalid(int ha[5][5]) {
return (ha[0][a2] == v2) || (ha[4][a1] == v1);
}
bool invalid(int ha[5][5], int i) {
return ((i > 0 && ha[i][a1] >= 0) &&
((ha[i - 1][a1] == v1 && ha[i][a2] != v2) ||
(ha[i - 1][a1] != v1 && ha[i][a2] == v2)));
}
} leftofs[] = {
{Color, Green, Color, White} // Cond 5: The green house is immediately to the left of the white house.
};
bool invalid(int ha[5][5]) {
for (auto &rule : leftofs) if (rule.invalid(ha)) return true;
for (int i = 0; i < 5; i++) {
#define eval_rules(rules) for (auto &rule : rules) if (rule.invalid(ha, i)) return true;
eval_rules(pairs);
eval_rules(nexttos);
eval_rules(leftofs);
}
return false;
}
void search(bool used[5][5], int ha[5][5], const int hno, const int attr) {
int nexthno, nextattr;
if (attr < 4) {
nextattr = attr + 1;
nexthno = hno;
} else {
nextattr = 0;
nexthno = hno + 1;
}
if (ha[hno][attr] != -1) {
search(used, ha, nexthno, nextattr);
} else {
for (int i = 0; i < 5; i++) {
if (used[attr][i]) continue;
used[attr][i] = true;
ha[hno][attr] = i;
if (!invalid(ha)) {
if ((hno == 4) && (attr == 4)) {
printHouses(ha);
} else {
search(used, ha, nexthno, nextattr);
}
}
used[attr][i] = false;
}
ha[hno][attr] = -1;
}
}
int main() {
bool used[5][5] = {};
int ha[5][5]; memset(ha, -1, sizeof(ha));
for (auto &rule : housenos) {
ha[rule.houseno][rule.a] = rule.v;
used[rule.a][rule.v] = true;
}
search(used, ha, 0, 0);
return 0;
}
- Output:
$ g++ -O3 -std=c++11 zebra.cpp -o zebracpp && time ./zebracpp House Color Man Drink Animal Smoke 0 Yellow Norwegian Water Cats Dunhill 1 Blue Dane Tea Horse Blend 2 Red English Milk Birds PallMall 3 Green German Coffee Zebra Prince 4 White Swede Beer Dog BlueMaster real 0m0.003s user 0m0.000s sys 0m0.000s
My measured time is slower than that posted for the original C code, but on my machine this C++ code is faster than the original C code.
Clojure
This solution uses the contributed package clojure.core.logic (with clojure.tools.macro), a mini-Kanren based logic solver. The solution is basically the one in Swannodette's logic tutorial, adapted to the problem statement here.
(ns zebra.core
(:refer-clojure :exclude [==])
(:use [clojure.core.logic]
[clojure.tools.macro :as macro]))
(defne lefto [x y l]
([_ _ [x y . ?r]])
([_ _ [_ . ?r]] (lefto x y ?r)))
(defn nexto [x y l]
(conde
((lefto x y l))
((lefto y x l))))
(defn zebrao [hs]
(macro/symbol-macrolet [_ (lvar)]
(all
(== [_ _ _ _ _] hs)
(membero ['englishman _ _ _ 'red] hs)
(membero ['swede _ _ 'dog _] hs)
(membero ['dane _ 'tea _ _] hs)
(lefto [_ _ _ _ 'green] [_ _ _ _ 'white] hs)
(membero [_ _ 'coffee _ 'green] hs)
(membero [_ 'pallmall _ 'birds _] hs)
(membero [_ 'dunhill _ _ 'yellow] hs)
(== [_ _ [_ _ 'milk _ _] _ _ ] hs)
(firsto hs ['norwegian _ _ _ _])
(nexto [_ 'blend _ _ _] [_ _ _ 'cats _ ] hs)
(nexto [_ _ _ 'horse _] [_ 'dunhill _ _ _] hs)
(membero [_ 'bluemaster 'beer _ _] hs)
(membero ['german 'prince _ _ _] hs)
(nexto ['norwegian _ _ _ _] [_ _ _ _ 'blue] hs)
(nexto [_ _ 'water _ _] [_ 'blend _ _ _] hs)
(membero [_ _ _ 'zebra _] hs))))
(let [solns (run* [q] (zebrao q))
soln (first solns)
zebra-owner (->> soln (filter #(= 'zebra (% 3))) first (#(% 0)))]
(println "solution count:" (count solns))
(println "zebra owner is the" zebra-owner)
(println "full solution (in house order):")
(doseq [h soln] (println " " h)))
- Output:
solution count: 1 zebra owner is the german full solution (in house order): [norwegian dunhill water cats yellow] [dane blend tea horse blue] [englishman pallmall milk birds red] [german prince coffee zebra green] [swede bluemaster beer dog white]
Alternate solution (Norvig-style)
This is adapted from a solution to a similar problem by Peter Norvig in his Udacity course CS212, originally written in Python but equally applicable in any language with for-comprehensions.
(ns zebra
(:require [clojure.math.combinatorics :as c]))
(defn solve []
(let [arrangements (c/permutations (range 5))
before? #(= (inc %1) %2)
after? #(= (dec %1) %2)
next-to? #(or (before? %1 %2) (after? %1 %2))]
(for [[english swede dane norwegian german :as persons] arrangements
:when (zero? norwegian)
[red green white yellow blue :as colors] arrangements
:when (before? green white)
:when (= english red)
:when (after? blue norwegian)
[tea coffee milk beer water :as drinks] arrangements
:when (= 2 milk)
:when (= dane tea)
:when (= coffee green)
[pall-mall dunhill blend blue-master prince :as cigs] arrangements
:when (= german prince)
:when (= yellow dunhill)
:when (= blue-master beer)
:when (after? blend water)
[dog birds cats horse zebra :as pets] arrangements
:when (= swede dog)
:when (= pall-mall birds)
:when (next-to? blend cats)
:when (after? horse dunhill)]
(->> [[:english :swede :dane :norwegian :german]
[:red :green :white :yellow :blue]
[:tea :coffee :milk :beer :water]
[:pall-mall :dunhill :blend :blue-master :prince]
[:dog :birds :cats :horse :zebra]]
(map zipmap [persons colors drinks cigs pets])))))
(defn -main [& _]
(doseq [[[persons _ _ _ pets :as solution] i]
(map vector (solve) (iterate inc 1))
:let [zebra-house (some #(when (= :zebra (val %)) (key %)) pets)]]
(println "solution" i)
(println "The" (persons zebra-house) "owns the zebra.")
(println "house nationality color drink cig pet")
(println "----- ----------- ------- ------- ------------ ------")
(dotimes [i 5]
(println (apply format "%5s %-11s %-7s %-7s %-12s %-6s"
(map #(% i) (cons inc solution)))))))
- Output:
user=> (time (zebra/-main))
solution 1
The :german owns the zebra.
house nationality color drink cig pet
----- ----------- ------- ------- ------------ ------
1 :norwegian :yellow :water :dunhill :cats
2 :dane :blue :tea :blend :horse
3 :english :red :milk :pall-mall :birds
4 :german :green :coffee :prince :zebra
5 :swede :white :beer :blue-master :dog
"Elapsed time: 10.555482 msecs"
nil
Crystal
CONTENT = {House: [""],
Nationality: %i[English Swedish Danish Norwegian German],
Colour: %i[Red Green White Blue Yellow],
Pet: %i[Dog Birds Cats Horse Zebra],
Drink: %i[Tea Coffee Milk Beer Water],
Smoke: %i[PallMall Dunhill BlueMaster Prince Blend]}
def adjacent?(n, i, g, e)
(0..3).any? { |x| (n[x] == i && g[x + 1] == e) || (n[x + 1] == i && g[x] == e) }
end
def leftof?(n, i, g, e)
(0..3).any? { |x| n[x] == i && g[x + 1] == e }
end
def coincident?(n, i, g, e)
n.each_index.any? { |x| n[x] == i && g[x] == e }
end
def solve_zebra_puzzle
CONTENT[:Nationality].each_permutation { |nation|
next unless nation.first == :Norwegian # 10
CONTENT[:Colour].each_permutation { |colour|
next unless leftof?(colour, :Green, colour, :White) # 5
next unless coincident?(nation, :English, colour, :Red) # 2
next unless adjacent?(nation, :Norwegian, colour, :Blue) # 15
CONTENT[:Pet].each_permutation { |pet|
next unless coincident?(nation, :Swedish, pet, :Dog) # 3
CONTENT[:Drink].each_permutation { |drink|
next unless drink[2] == :Milk # 9
next unless coincident?(nation, :Danish, drink, :Tea) # 4
next unless coincident?(colour, :Green, drink, :Coffee) # 6
CONTENT[:Smoke].each_permutation { |smoke|
next unless coincident?(smoke, :PallMall, pet, :Birds) # 7
next unless coincident?(smoke, :Dunhill, colour, :Yellow) # 8
next unless coincident?(smoke, :BlueMaster, drink, :Beer) # 13
next unless coincident?(smoke, :Prince, nation, :German) # 14
next unless adjacent?(smoke, :Blend, pet, :Cats) # 11
next unless adjacent?(smoke, :Blend, drink, :Water) # 16
next unless adjacent?(smoke, :Dunhill, pet, :Horse) # 12
print_out(nation, colour, pet, drink, smoke)
}
}
}
}
}
end
def print_out(nation, colour, pet, drink, smoke)
width = CONTENT.map { |k, v| {k.to_s.size, v.max_of { |y| y.to_s.size }}.max }
fmt = width.map { |w| "%-#{w}s" }.join(" ")
national = nation[pet.index(:Zebra).not_nil!]
puts "The Zebra is owned by the man who is #{national}", ""
puts fmt % CONTENT.keys, fmt % width.map { |w| "-" * w }
[nation, colour, pet, drink, smoke].transpose.each.with_index(1) { |x, n| puts fmt % ([n] + x) }
end
solve_zebra_puzzle
Curry
import Constraint (allC, anyC)
import Findall (findall)
data House = H Color Man Pet Drink Smoke
data Color = Red | Green | Blue | Yellow | White
data Man = Eng | Swe | Dan | Nor | Ger
data Pet = Dog | Birds | Cats | Horse | Zebra
data Drink = Coffee | Tea | Milk | Beer | Water
data Smoke = PM | DH | Blend | BM | Prince
houses :: [House] -> Success
houses hs@[H1,_,H3,_,_] = -- 1
H _ _ _ Milk _ =:= H3 -- 9
& H _ Nor _ _ _ =:= H1 -- 10
& allC (`member` hs)
[ H Red Eng _ _ _ -- 2
, H _ Swe Dog _ _ -- 3
, H _ Dan _ Tea _ -- 4
, H Green _ _ Coffee _ -- 6
, H _ _ Birds _ PM -- 7
, H Yellow _ _ _ DH -- 8
, H _ _ _ Beer BM -- 13
, H _ Ger _ _ Prince -- 14
]
& H Green _ _ _ _ `leftTo` H White _ _ _ _ -- 5
& H _ _ _ _ Blend `nextTo` H _ _ Cats _ _ -- 11
& H _ _ Horse _ _ `nextTo` H _ _ _ _ DH -- 12
& H _ Nor _ _ _ `nextTo` H Blue _ _ _ _ -- 15
& H _ _ _ Water _ `nextTo` H _ _ _ _ Blend -- 16
where
x `leftTo` y = _ ++ [x,y] ++ _ =:= hs
x `nextTo` y = x `leftTo` y
? y `leftTo` x
member :: a -> [a] -> Success
member = anyC . (=:=)
main = findall $ \(hs,who) -> houses hs & H _ who Zebra _ _ `member` hs- Output:
Using web interface.
Execution time: 180 msec. / elapsed: 180 msec. [([H Yellow Nor Cats Water DH,H Blue Dan Horse Tea Blend,H Red Eng Birds Milk PM,H Green Ger Zebra Coffee Prince,H White Swe Dog Beer BM],Ger)]
D
Most foreach loops in this program are static.
import std.stdio, std.traits, std.algorithm, std.math;
enum Content { Beer, Coffee, Milk, Tea, Water,
Danish, English, German, Norwegian, Swedish,
Blue, Green, Red, White, Yellow,
Blend, BlueMaster, Dunhill, PallMall, Prince,
Bird, Cat, Dog, Horse, Zebra }
enum Test { Drink, Person, Color, Smoke, Pet }
enum House { One, Two, Three, Four, Five }
alias TM = Content[EnumMembers!Test.length][EnumMembers!House.length];
bool finalChecks(in ref TM M) pure nothrow @safe @nogc {
int diff(in Content a, in Content b, in Test ca, in Test cb)
nothrow @safe @nogc {
foreach (immutable h1; EnumMembers!House)
foreach (immutable h2; EnumMembers!House)
if (M[ca][h1] == a && M[cb][h2] == b)
return h1 - h2;
assert(0); // Useless but required.
}
with (Content) with (Test)
return abs(diff(Norwegian, Blue, Person, Color)) == 1 &&
diff(Green, White, Color, Color) == -1 &&
abs(diff(Horse, Dunhill, Pet, Smoke)) == 1 &&
abs(diff(Water, Blend, Drink, Smoke)) == 1 &&
abs(diff(Blend, Cat, Smoke, Pet)) == 1;
}
bool constrained(in ref TM M, in Test atest) pure nothrow @safe @nogc {
with (Content) with (Test) with (House)
final switch (atest) {
case Drink:
return M[Drink][Three] == Milk;
case Person:
foreach (immutable h; EnumMembers!House)
if ((M[Person][h] == Norwegian && h != One) ||
(M[Person][h] == Danish && M[Drink][h] != Tea))
return false;
return true;
case Color:
foreach (immutable h; EnumMembers!House)
if ((M[Person][h] == English && M[Color][h] != Red) ||
(M[Drink][h] == Coffee && M[Color][h] != Green))
return false;
return true;
case Smoke:
foreach (immutable h; EnumMembers!House)
if ((M[Color][h] == Yellow && M[Smoke][h] != Dunhill) ||
(M[Smoke][h] == BlueMaster && M[Drink][h] != Beer) ||
(M[Person][h] == German && M[Smoke][h] != Prince))
return false;
return true;
case Pet:
foreach (immutable h; EnumMembers!House)
if ((M[Person][h] == Swedish && M[Pet][h] != Dog) ||
(M[Smoke][h] == PallMall && M[Pet][h] != Bird))
return false;
return finalChecks(M);
}
}
void show(in ref TM M) {
foreach (h; EnumMembers!House) {
writef("%5s: ", h);
foreach (immutable t; EnumMembers!Test)
writef("%10s ", M[t][h]);
writeln;
}
}
void solve(ref TM M, in Test t, in size_t n) {
if (n == 1 && constrained(M, t)) {
if (t < 4) {
solve(M, [EnumMembers!Test][t + 1], 5);
} else {
show(M);
return;
}
}
foreach (immutable i; 0 .. n) {
solve(M, t, n - 1);
swap(M[t][n % 2 ? 0 : i], M[t][n - 1]);
}
}
void main() {
TM M;
foreach (immutable t; EnumMembers!Test)
foreach (immutable h; EnumMembers!House)
M[t][h] = EnumMembers!Content[t * 5 + h];
solve(M, Test.Drink, 5);
}
- Output:
One: Water Norwegian Yellow Dunhill Cat Two: Tea Danish Blue Blend Horse Three: Milk English Red PallMall Bird Four: Coffee German Green Prince Zebra Five: Beer Swedish White BlueMaster Dog
Run-time about 0.04 seconds.
Alternative Version
This requires the module of the first D entry from the Permutations Task.
import std.stdio, std.math, std.traits, std.typecons, std.typetuple, permutations1;
uint factorial(in uint n) pure nothrow @nogc @safe
in {
assert(n <= 12);
} body {
uint result = 1;
foreach (immutable i; 1 .. n + 1)
result *= i;
return result;
}
enum Number { One, Two, Three, Four, Five }
enum Color { Red, Green, Blue, White, Yellow }
enum Drink { Milk, Coffee, Water, Beer, Tea }
enum Smoke { PallMall, Dunhill, Blend, BlueMaster, Prince }
enum Pet { Dog, Cat, Zebra, Horse, Bird }
enum Nation { British, Swedish, Danish, Norvegian, German }
enum size_t M = EnumMembers!Number.length;
auto nullableRef(T)(ref T item) pure nothrow @nogc {
return NullableRef!T(&item);
}
bool isPossible(NullableRef!(immutable Number[M]) number,
NullableRef!(immutable Color[M]) color=null,
NullableRef!(immutable Drink[M]) drink=null,
NullableRef!(immutable Smoke[M]) smoke=null,
NullableRef!(immutable Pet[M]) pet=null) pure nothrow @safe @nogc {
if ((!number.isNull && number[Nation.Norvegian] != Number.One) ||
(!color.isNull && color[Nation.British] != Color.Red) ||
(!drink.isNull && drink[Nation.Danish] != Drink.Tea) ||
(!smoke.isNull && smoke[Nation.German] != Smoke.Prince) ||
(!pet.isNull && pet[Nation.Swedish] != Pet.Dog))
return false;
if (number.isNull || color.isNull || drink.isNull || smoke.isNull ||
pet.isNull)
return true;
foreach (immutable i; 0 .. M) {
if ((color[i] == Color.Green && drink[i] != Drink.Coffee) ||
(smoke[i] == Smoke.PallMall && pet[i] != Pet.Bird) ||
(color[i] == Color.Yellow && smoke[i] != Smoke.Dunhill) ||
(number[i] == Number.Three && drink[i] != Drink.Milk) ||
(smoke[i] == Smoke.BlueMaster && drink[i] != Drink.Beer)||
(color[i] == Color.Blue && number[i] != Number.Two))
return false;
foreach (immutable j; 0 .. M) {
if (color[i] == Color.Green && color[j] == Color.White &&
number[j] - number[i] != 1)
return false;
immutable diff = abs(number[i] - number[j]);
if ((smoke[i] == Smoke.Blend && pet[j] == Pet.Cat && diff != 1) ||
(pet[i] == Pet.Horse && smoke[j] == Smoke.Dunhill && diff != 1) ||
(smoke[i] == Smoke.Blend && drink[j] == Drink.Water && diff != 1))
return false;
}
}
return true;
}
alias N = nullableRef; // At module level scope to be used with UFCS.
void main() {
enum size_t FM = M.factorial;
static immutable Number[M][FM] numberPerms = [EnumMembers!Number].permutations;
static immutable Color[M][FM] colorPerms = [EnumMembers!Color].permutations;
static immutable Drink[M][FM] drinkPerms = [EnumMembers!Drink].permutations;
static immutable Smoke[M][FM] smokePerms = [EnumMembers!Smoke].permutations;
static immutable Pet[M][FM] petPerms = [EnumMembers!Pet].permutations;
// You can reduce the compile-time computations using four casts like this:
// static colorPerms = cast(immutable Color[M][FM])numberPerms;
static immutable Nation[M] nation = [EnumMembers!Nation];
foreach (immutable ref number; numberPerms)
if (isPossible(number.N))
foreach (immutable ref color; colorPerms)
if (isPossible(number.N, color.N))
foreach (immutable ref drink; drinkPerms)
if (isPossible(number.N, color.N, drink.N))
foreach (immutable ref smoke; smokePerms)
if (isPossible(number.N, color.N, drink.N, smoke.N))
foreach (immutable ref pet; petPerms)
if (isPossible(number.N, color.N, drink.N, smoke.N, pet.N)) {
writeln("Found a solution:");
foreach (x; TypeTuple!(nation, number, color, drink, smoke, pet))
writefln("%6s: %12s%12s%12s%12s%12s",
(Unqual!(typeof(x[0]))).stringof,
x[0], x[1], x[2], x[3], x[4]);
writeln;
}
}
- Output:
Found a solution: Nation: British Swedish Danish Norvegian German Number: Three Five Two One Four Color: Red White Blue Yellow Green Drink: Milk Beer Tea Water Coffee Smoke: PallMall BlueMaster Blend Dunhill Prince Pet: Bird Dog Horse Cat Zebra
Run-time about 0.76 seconds with the dmd compiler.
Short Version
This requires the module of the second D entry from the Permutations Task.
void main() {
import std.stdio, std.algorithm, permutations2;
enum E { Red, Green, Blue, White, Yellow,
Milk, Coffee, Water, Beer, Tea,
PallMall, Dunhill, Blend, BlueMaster, Prince,
Dog, Cat, Zebra, Horse, Birds,
British, Swedish, Danish, Norvegian, German }
enum has = (E[] a, E x, E[] b, E y) => a.countUntil(x) == b.countUntil(y);
enum leftOf = (E[] a, E x, E[] b, E y) => a.countUntil(x) == b.countUntil(y) + 1;
enum nextTo = (E[] a, E x, E[] b, E y) => leftOf(a, x, b, y) || leftOf(b, y, a, x);
with (E) foreach (houses; [Red, Blue, Green, Yellow, White].permutations)
if (leftOf(houses, White, houses, Green))
foreach (persons; [Norvegian, British, Swedish, German, Danish].permutations)
if (has(persons, British, houses, Red) && persons[0] == Norvegian &&
nextTo(persons, Norvegian, houses, Blue))
foreach (drinks; [Tea, Coffee, Milk, Beer, Water].permutations)
if (has(drinks, Tea, persons, Danish) &&
has(drinks, Coffee, houses, Green) && drinks[$ / 2] == Milk)
foreach (pets; [Dog, Birds, Cat, Horse, Zebra].permutations)
if (has(pets, Dog, persons, Swedish))
foreach (smokes; [PallMall, Dunhill, Blend, BlueMaster, Prince].permutations)
if (has(smokes, PallMall, pets, Birds) &&
has(smokes, Dunhill, houses, Yellow) &&
nextTo(smokes, Blend, pets, Cat) &&
nextTo(smokes, Dunhill, pets, Horse) &&
has(smokes, BlueMaster, drinks, Beer) &&
has(smokes, Prince, persons, German) &&
nextTo(drinks, Water, smokes, Blend))
writefln("%(%10s\n%)\n", [houses, persons, drinks, pets, smokes]);
}
- Output:
[ Yellow, Blue, Red, Green, White] [ Norvegian, Danish, British, German, Swedish] [ Water, Tea, Milk, Coffee, Beer] [ Cat, Horse, Birds, Zebra, Dog] [ Dunhill, Blend, PallMall, Prince, BlueMaster]
The run-time is 0.03 seconds or less.
EchoLisp
We use the amb library to solve the puzzle. The number of tries - calls to zebra-puzzle - is only 1900, before finding all solutions. Note that there are no declarations for things (cats, tea, ..) or categories (animals, drinks, ..) which are discovered when reading the constraints.
(lib 'hash)
(lib 'amb)
;; return #f or house# for thing/category
;; houses := (0 1 2 3 4)
(define (house-get H category thing houses)
(for/or ((i houses)) #:continue (!equal? (hash-ref (vector-ref H i) category) thing)
i))
;; return house # for thing (eg cat) in category (eq animals)
;; add thing if not already here
(define-syntax-rule (house-set thing category)
(or
(house-get H 'category 'thing houses)
(dispatch H 'category 'thing context houses )))
;; we know that thing/category is in a given house
(define-syntax-rule (house-force thing category house)
(dispatch H 'category 'thing context houses house))
;; return house# or fail if impossible
(define (dispatch H category thing context houses (forced #f))
(define house (or forced (amb context houses))) ;; get a house number
(when (hash-ref (vector-ref H house) category) (amb-fail)) ;; fail if occupied
(hash-set (vector-ref H house) category thing) ;; else remember house contents
house)
(define (house-next h1 h2)
(amb-require (or (= h1 (1+ h2)) (= h1 (1- h2)))))
(define (zebra-puzzle context houses )
(define H (build-vector 5 make-hash)) ;; house[i] := hash(category) -> thing
; In the middle house they drink milk.
(house-force milk drinks 2)
;The Norwegian lives in the first house.
(house-force norvegian people 0)
; The English man lives in the red house.
(house-force red colors(house-set english people))
; The Swede has a dog.
(house-force dog animals (house-set swede people))
; The Dane drinks tea.
(house-force tea drinks (house-set dane people))
; The green house is immediately to the left of the white house.
(amb-require (= (house-set green colors) (1- (house-set white colors))))
; They drink coffee in the green house.
(house-force coffee drinks (house-set green colors))
; The man who smokes Pall Mall has birds.
(house-force birds animals (house-set pallmall smoke))
; In the yellow house they smoke Dunhill.
(house-force dunhill smoke (house-set yellow colors))
; The Norwegian lives next to the blue house.
(house-next (house-set norvegian people) (house-set blue colors))
; The man who smokes Blend lives in the house next to the house with cats.
(house-next (house-set blend smoke) (house-set cats animals))
; In a house next to the house where they have a horse, they smoke Dunhill.
(house-next (house-set horse animals) (house-set dunhill smoke))
; The man who smokes Blue Master drinks beer.
(house-force beer drinks (house-set bluemaster smoke))
; The German smokes Prince.
(house-force prince smoke (house-set german people))
; They drink water in a house next to the house where they smoke Blend.
(house-next (house-set water drinks) (house-set blend smoke))
;; Finally .... the zebra 🐴
(house-set 🐴 animals)
(for ((i houses))
(writeln i (hash-values (vector-ref H i))))
(writeln '----------)
(amb-fail) ;; will ensure ALL solutions are printed
)
- Output:
(define (task)
(amb-run zebra-puzzle (amb-make-context) (iota 5)))
(task)
→
0 (norvegian yellow dunhill cats water)
1 (dane tea blue blend horse)
2 (milk english red pallmall birds)
3 (green coffee german prince 🐴)
4 (swede dog white bluemaster beer)
----------
→ #f
Elixir
defmodule ZebraPuzzle do
defp adjacent?(n,i,g,e) do
Enum.any?(0..3, fn x ->
(Enum.at(n,x)==i and Enum.at(g,x+1)==e) or (Enum.at(n,x+1)==i and Enum.at(g,x)==e)
end)
end
defp leftof?(n,i,g,e) do
Enum.any?(0..3, fn x -> Enum.at(n,x)==i and Enum.at(g,x+1)==e end)
end
defp coincident?(n,i,g,e) do
Enum.with_index(n) |> Enum.any?(fn {x,idx} -> x==i and Enum.at(g,idx)==e end)
end
def solve(content) do
colours = permutation(content[:Colour])
pets = permutation(content[:Pet])
drinks = permutation(content[:Drink])
smokes = permutation(content[:Smoke])
Enum.each(permutation(content[:Nationality]), fn nation ->
if hd(nation) == :Norwegian, do: # 10
Enum.each(colours, fn colour ->
if leftof?(colour, :Green, colour, :White) and # 5
coincident?(nation, :English, colour, :Red) and # 2
adjacent?(nation, :Norwegian, colour, :Blue), do: # 15
Enum.each(pets, fn pet ->
if coincident?(nation, :Swedish, pet, :Dog), do: # 3
Enum.each(drinks, fn drink ->
if Enum.at(drink,2) == :Milk and # 9
coincident?(nation, :Danish, drink, :Tea) and # 4
coincident?(colour, :Green, drink, :Coffee), do: # 6
Enum.each(smokes, fn smoke ->
if coincident?(smoke, :PallMall, pet, :Birds) and # 7
coincident?(smoke, :Dunhill, colour, :Yellow) and # 8
coincident?(smoke, :BlueMaster, drink, :Beer) and # 13
coincident?(smoke, :Prince, nation, :German) and # 14
adjacent?(smoke, :Blend, pet, :Cats) and # 11
adjacent?(smoke, :Blend, drink, :Water) and # 16
adjacent?(smoke, :Dunhill, pet, :Horse), do: # 12
print_out(content, transpose([nation, colour, pet, drink, smoke]))
end)end)end)end)end)
end
defp permutation([]), do: [[]]
defp permutation(list) do
for x <- list, y <- permutation(list -- [x]), do: [x|y]
end
defp transpose(lists) do
List.zip(lists) |> Enum.map(&Tuple.to_list/1)
end
defp print_out(content, result) do
width = for {k,v}<-content, do: Enum.map([k|v], &length(to_char_list &1)) |> Enum.max
fmt = Enum.map_join(width, " ", fn w -> "~-#{w}s" end) <> "~n"
nation = Enum.find(result, fn x -> :Zebra in x end) |> hd
IO.puts "The Zebra is owned by the man who is #{nation}\n"
:io.format fmt, Keyword.keys(content)
:io.format fmt, Enum.map(width, fn w -> String.duplicate("-", w) end)
fmt2 = String.replace(fmt, "s", "w", global: false)
Enum.with_index(result)
|> Enum.each(fn {x,i} -> :io.format fmt2, [i+1 | x] end)
end
end
content = [ House: '',
Nationality: ~w[English Swedish Danish Norwegian German]a,
Colour: ~w[Red Green White Blue Yellow]a,
Pet: ~w[Dog Birds Cats Horse Zebra]a,
Drink: ~w[Tea Coffee Milk Beer Water]a,
Smoke: ~w[PallMall Dunhill BlueMaster Prince Blend]a ]
ZebraPuzzle.solve(content)
- Output:
The Zebra is owned by the man who is German House Nationality Colour Pet Drink Smoke ----- ----------- ------ ----- ------ ---------- 1 Norwegian Yellow Cats Water Dunhill 2 Danish Blue Horse Tea Blend 3 English Red Birds Milk PallMall 4 German Green Zebra Coffee Prince 5 Swedish White Dog Beer BlueMaster
Erlang
This solution generates all houses that fits the rules for single houses, then it checks multi-house rules. It would be faster to check multi-house rules while generating the houses. I have not added this complexity since the current program takes just a few seconds.
-module( zebra_puzzle ).
-export( [task/0] ).
-record( house, {colour, drink, nationality, number, pet, smoke} ).
-record( sorted_houses, {house_1s=[], house_2s=[], house_3s=[], house_4s=[], house_5s=[]} ).
task() ->
Houses = [#house{colour=C, drink=D, nationality=N, number=Nr, pet=P, smoke=S} || C <- all_colours(), D <- all_drinks(), N <- all_nationalities(), Nr <- all_numbers(), P <- all_pets(), S <- all_smokes(), is_all_single_house_rules_ok(C, D, N, Nr, P, S)],
Sorted_houses = lists:foldl( fun house_number_sort/2, #sorted_houses{}, Houses ),
Streets = [[H1, H2, H3, H4, H5] || H1 <- Sorted_houses#sorted_houses.house_1s, H2 <- Sorted_houses#sorted_houses.house_2s, H3 <- Sorted_houses#sorted_houses.house_3s, H4 <- Sorted_houses#sorted_houses.house_4s, H5 <- Sorted_houses#sorted_houses.house_5s, is_all_multi_house_rules_ok(H1, H2, H3, H4, H5)],
[Nationality] = [N || #house{nationality=N, pet=zebra} <- lists:flatten(Streets)],
io:fwrite( "~p owns the zebra~n", [Nationality] ),
io:fwrite( "All solutions ~p~n", [Streets] ),
io:fwrite( "Number of solutions ~p~n", [erlang:length(Streets)] ).
all_colours() -> [blue, green, red, white, yellow].
all_drinks() -> [beer, coffe, milk, tea, water].
all_nationalities() -> [danish, english, german, norveigan, swedish].
all_numbers() -> [1, 2, 3, 4, 5].
all_pets() -> [birds, cats, dog, horse, zebra].
all_smokes() -> [blend, 'blue master', dunhill, 'pall mall', prince].
house_number_sort( #house{number=1}=House, #sorted_houses{house_1s=Houses_1s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_1s=[House | Houses_1s]};
house_number_sort( #house{number=2}=House, #sorted_houses{house_2s=Houses_2s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_2s=[House | Houses_2s]};
house_number_sort( #house{number=3}=House, #sorted_houses{house_3s=Houses_3s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_3s=[House | Houses_3s]};
house_number_sort( #house{number=4}=House, #sorted_houses{house_4s=Houses_4s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_4s=[House | Houses_4s]};
house_number_sort( #house{number=5}=House, #sorted_houses{house_5s=Houses_5s}=Sorted_houses ) -> Sorted_houses#sorted_houses{house_5s=[House | Houses_5s]}.
is_all_different( [_H] ) -> true;
is_all_different( [H | T] ) -> not lists:member( H, T ) andalso is_all_different( T ).
is_all_multi_house_rules_ok( House1, House2, House3, House4, House5 ) ->
is_rule_1_ok( House1, House2, House3, House4, House5 )
andalso is_rule_5_ok( House1, House2, House3, House4, House5 )
andalso is_rule_11_ok( House1, House2, House3, House4, House5 )
andalso is_rule_12_ok( House1, House2, House3, House4, House5 )
andalso is_rule_15_ok( House1, House2, House3, House4, House5 )
andalso is_rule_16_ok( House1, House2, House3, House4, House5 ).
is_all_single_house_rules_ok( Colour, Drink, Nationality, Number, Pet, Smoke ) ->
is_rule_ok( {rule_number, 2}, {Nationality, english}, {Colour, red})
andalso is_rule_ok( {rule_number, 3}, {Nationality, swedish}, {Pet, dog})
andalso is_rule_ok( {rule_number, 4}, {Nationality, danish}, {Drink, tea})
andalso is_rule_ok( {rule_number, 6}, {Drink, coffe}, {Colour, green})
andalso is_rule_ok( {rule_number, 7}, {Smoke, 'pall mall'}, {Pet, birds})
andalso is_rule_ok( {rule_number, 8}, {Colour, yellow}, {Smoke, dunhill})
andalso is_rule_ok( {rule_number, 9}, {Number, 3}, {Drink, milk})
andalso is_rule_ok( {rule_number, 10}, {Nationality, norveigan}, {Number, 1})
andalso is_rule_ok( {rule_number, 13}, {Smoke, 'blue master'}, {Drink, beer})
andalso is_rule_ok( {rule_number, 14}, {Nationality, german}, {Smoke, prince}).
is_rule_ok( _Rule_number, {A, A}, {B, B} ) -> true;
is_rule_ok( _Rule_number, _A, {B, B} ) -> false;
is_rule_ok( _Rule_number, {A, A}, _B ) -> false;
is_rule_ok( _Rule_number, _A, _B ) -> true.
is_rule_1_ok( #house{number=1}=H1, #house{number=2}=H2, #house{number=3}=H3, #house{number=4}=H4, #house{number=5}=H5 ) ->
is_all_different( [H1#house.colour, H2#house.colour, H3#house.colour, H4#house.colour, H5#house.colour] )
andalso is_all_different( [H1#house.drink, H2#house.drink, H3#house.drink, H4#house.drink, H5#house.drink] )
andalso is_all_different( [H1#house.nationality, H2#house.nationality, H3#house.nationality, H4#house.nationality, H5#house.nationality] )
andalso is_all_different( [H1#house.pet, H2#house.pet, H3#house.pet, H4#house.pet, H5#house.pet] )
andalso is_all_different( [H1#house.smoke, H2#house.smoke, H3#house.smoke, H4#house.smoke, H5#house.smoke] );
is_rule_1_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
is_rule_5_ok( #house{colour=green}, #house{colour=white}, _House3, _House4, _House5 ) -> true;
is_rule_5_ok( _House1, #house{colour=green}, #house{colour=white}, _House4, _House5 ) -> true;
is_rule_5_ok( _House1, _House2, #house{colour=green}, #house{colour=white}, _House5 ) -> true;
is_rule_5_ok( _House1, _House2, _House3, #house{colour=green}, #house{colour=white} ) -> true;
is_rule_5_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
is_rule_11_ok( #house{smoke=blend}, #house{pet=cats}, _House3, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, #house{smoke=blend}, #house{pet=cats}, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, #house{smoke=blend}, #house{pet=cats}, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, _House3, #house{smoke=blend}, #house{pet=cats} ) -> true;
is_rule_11_ok( #house{pet=cats}, #house{smoke=blend}, _House3, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, #house{pet=cats}, #house{smoke=blend}, _House4, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, #house{pet=cats}, #house{smoke=blend}, _House5 ) -> true;
is_rule_11_ok( _House1, _House2, _House3, #house{pet=cats}, #house{smoke=blend} ) -> true;
is_rule_11_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
is_rule_12_ok( #house{smoke=dunhill}, #house{pet=horse}, _House3, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, #house{smoke=dunhill}, #house{pet=horse}, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, #house{smoke=dunhill}, #house{pet=horse}, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, _House3, #house{smoke=dunhill}, #house{pet=horse} ) -> true;
is_rule_12_ok( #house{pet=horse}, #house{smoke=dunhill}, _House3, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, #house{pet=horse}, #house{smoke=dunhill}, _House4, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, #house{pet=horse}, #house{smoke=dunhill}, _House5 ) -> true;
is_rule_12_ok( _House1, _House2, _House3, #house{pet=horse}, #house{smoke=dunhill} ) -> true;
is_rule_12_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
is_rule_15_ok( #house{nationality=norveigan}, #house{colour=blue}, _House3, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, #house{nationality=norveigan}, #house{colour=blue}, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, #house{nationality=norveigan}, #house{colour=blue}, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, _House3, #house{nationality=norveigan}, #house{colour=blue} ) -> true;
is_rule_15_ok( #house{colour=blue}, #house{nationality=norveigan}, _House3, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, #house{colour=blue}, #house{nationality=norveigan}, _House4, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, #house{drink=water}, #house{nationality=norveigan}, _House5 ) -> true;
is_rule_15_ok( _House1, _House2, _House3, #house{drink=water}, #house{nationality=norveigan} ) -> true;
is_rule_15_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
is_rule_16_ok( #house{smoke=blend}, #house{drink=water}, _House3, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, #house{smoke=blend}, #house{drink=water}, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, #house{smoke=blend}, #house{drink=water}, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, _House3, #house{smoke=blend}, #house{drink=water} ) -> true;
is_rule_16_ok( #house{drink=water}, #house{smoke=blend}, _House3, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, #house{drink=water}, #house{smoke=blend}, _House4, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, #house{drink=water}, #house{smoke=blend}, _House5 ) -> true;
is_rule_16_ok( _House1, _House2, _House3, #house{drink=water}, #house{smoke=blend} ) -> true;
is_rule_16_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.
- Output:
10> zebra_puzzle:task().
german owns the zebra
All solutions [[{house,yellow,water,norveigan,1,cats,dunhill},
{house,blue,tea,danish,2,horse,blend},
{house,red,milk,english,3,birds,'pall mall'},
{house,green,coffe,german,4,zebra,prince},
{house,white,beer,swedish,5,dog,'blue master'}]]
Number of solutions: 1
ERRE
PROGRAM ZEBRA_PUZZLE
DIM DRINK$[4],NATION$[4],COLR$[4],SMOKE$[4],ANIMAL$[4]
DIM PERM$[120],X$[4]
PROCEDURE PERMUTATION(X$[]->X$[],OK)
LOCAL I%,J%
FOR I%=UBOUND(X$,1)-1 TO 0 STEP -1 DO
EXIT IF X$[I%]<X$[I%+1]
END FOR
IF I%<0 THEN OK=FALSE EXIT PROCEDURE END IF
J%=UBOUND(X$,1)
WHILE X$[J%]<=X$[I%] DO
J%=J%-1
END WHILE
SWAP(X$[I%],X$[J%])
I%=I%+1
J%=UBOUND(X$,1)
WHILE I%<J% DO
SWAP(X$[I%],X$[J%])
I%=I%+1
J%=J%-1
END WHILE
OK=TRUE
END PROCEDURE
BEGIN
! The names (only used for printing the results)
DATA("Beer","Coffee","Milk","Tea","Water")
DATA("Denmark","England","Germany","Norway","Sweden")
DATA("Blue","Green","Red","White","Yellow")
DATA("Blend","BlueMaster","Dunhill","PallMall","Prince")
DATA("Birds","Cats","Dog","Horse","Zebra")
FOR I%=0 TO 4 DO READ(DRINK$[I%]) END FOR
FOR I%=0 TO 4 DO READ(NATION$[I%]) END FOR
FOR I%=0 TO 4 DO READ(COLR$[I%]) END FOR
FOR I%=0 TO 4 DO READ(SMOKE$[I%]) END FOR
FOR I%=0 TO 4 DO READ(ANIMAL$[I%]) END FOR
! Some single-character tags:
A$="A" B$="B" c$="C" d$="D" e$="E"
! ERRE doesn't have enumerations!
Beer$=A$ Coffee$=B$ Milk$=c$ TeA$=d$ Water$=e$
Denmark$=A$ England$=B$ Germany$=c$ Norway$=d$ Sweden$=e$
Blue$=A$ Green$=B$ Red$=c$ White$=d$ Yellow$=e$
Blend$=A$ BlueMaster$=B$ Dunhill$=c$ PallMall$=d$ Prince$=e$
Birds$=A$ Cats$=B$ Dog$=c$ Horse$=d$ ZebrA$=e$
PRINT(CHR$(12);)
! Create the 120 permutations of 5 objects:
X$[0]=A$ X$[1]=B$ X$[2]=C$ X$[3]=D$ X$[4]=E$
REPEAT
P%=P%+1
PERM$[P%]=X$[0]+X$[1]+X$[2]+X$[3]+X$[4]
PERMUTATION(X$[]->X$[],OK)
UNTIL NOT OK
! Solve:
SOLUTIONS%=0
T1=TIMER
FOR NATION%=1 TO 120 DO
NATION$=PERM$[NATION%]
IF LEFT$(NATION$,1)=Norway$ THEN
FOR COLR%=1 TO 120 DO
COLR$=PERM$[COLR%]
IF INSTR(COLR$,Green$+White$)<>0 AND INSTR(NATION$,England$)=INSTR(COLR$,Red$) AND ABS(INSTR(NATION$,Norway$)-INSTR(COLR$,Blue$))=1 THEN
FOR DRINK%=1 TO 120 DO
DRINK$=PERM$[DRINK%]
IF MID$(DRINK$,3,1)=Milk$ AND INSTR(NATION$,Denmark$)=INSTR(DRINK$,TeA$) AND INSTR(DRINK$,Coffee$)=INSTR(COLR$,Green$) THEN
FOR SmOKe%=1 TO 120 DO
SmOKe$=PERM$[SMOKE%]
IF INSTR(NATION$,Germany$)=INSTR(SmOKe$,Prince$) AND INSTR(SmOKe$,BlueMaster$)=INSTR(DRINK$,Beer$) AND ABS(INSTR(SmOKe$,Blend$)-INSTR(DRINK$,Water$))=1 AND INSTR(SmOKe$,Dunhill$)=INSTR(COLR$,Yellow$) THEN
FOR ANIMAL%=1 TO 120 DO
ANIMAL$=PERM$[ANIMAL%]
IF INSTR(NATION$,Sweden$)=INSTR(ANIMAL$,Dog$) AND INSTR(SmOKe$,PallMall$)=INSTR(ANIMAL$,Birds$) AND ABS(INSTR(SmOKe$,Blend$)-INSTR(ANIMAL$,Cats$))=1 AND ABS(INSTR(SmOKe$,Dunhill$)-INSTR(ANIMAL$,Horse$))=1 THEN
PRINT("House Drink Nation Colour Smoke Animal")
PRINT("---------------------------------------------------------------------------")
FOR house%=1 TO 5 DO
PRINT(house%;)
PRINT(TAB(10);DRINK$[ASC(MID$(DRINK$,house%))-65];)
PRINT(TAB(25);NATION$[ASC(MID$(NATION$,house%))-65];)
PRINT(TAB(40);COLR$[ASC(MID$(COLR$,house%))-65];)
PRINT(TAB(55);SMOKE$[ASC(MID$(SmOKe$,house%))-65];)
PRINT(TAB(70);ANIMAL$[ASC(MID$(ANIMAL$,house%))-65])
END FOR
SOLUTIONS%=SOLUTIONS%+1
END IF
END FOR ! ANIMAL%
END IF
END FOR ! SmOKe%
END IF
END FOR ! DRINK%
END IF
END FOR ! COLR%
END IF
END FOR ! NATION%
PRINT("Number of solutions=";SOLUTIONS%)
PRINT("Solved in ";TIMER-T1;" seconds")
END PROGRAM- Output:
House Drink Nation Colour Smoke Animal --------------------------------------------------------------------------- 1 Water Norway Yellow Dunhill Cats 2 Tea Denmark Blue Blend Horse 3 Milk England Red PallMall Birds 4 Coffee Germany Green Prince Zebra 5 Beer Sweden White BlueMaster Dog Number of solutions= 1 Solved in .109375 seconds
F#
This task uses Permutations_by_swapping#F.23
(*Here I solve the Zebra puzzle using Plain Changes, definitely a challenge to some campanoligist to solve it using Grandsire Doubles.
Nigel Galloway: January 27th., 2017 *)
type N = |English=0 |Swedish=1|Danish=2 |German=3|Norwegian=4
type I = |Tea=0 |Coffee=1 |Milk=2 |Beer=3 |Water=4
type G = |Dog=0 |Birds=1 |Cats=2 |Horse=3 |Zebra=4
type E = |Red=0 |Green=1 |White=2 |Blue=3 |Yellow=4
type L = |PallMall=0|Dunhill=1|BlueMaster=2|Prince=3|Blend=4
type NIGELz={Nz:N[];Iz:I[];Gz:G[];Ez:E[];Lz:L[]}
let fn (i:'n[]) g (e:'g[]) l = //coincident?
let rec _fn = function
|5 -> false
|ig when (i.[ig]=g && e.[ig]=l) -> true
|ig -> _fn (ig+1)
_fn 0
let fi (i:'n[]) g (e:'g[]) l = //leftof?
let rec _fn = function
|4 -> false
|ig when (i.[ig]=g && e.[ig+1]=l) -> true
|ig -> _fn (ig+1)
_fn 0
let fg (i:'n[]) g (e:'g[]) l = (fi i g e l || fi e l i g) //adjacent?
let n = Ring.PlainChanges [|for n in System.Enum.GetValues(typeof<N>)->n:?>N|]|>Seq.filter(fun n->n.[0]=N.Norwegian) //#10
let i = Ring.PlainChanges [|for n in System.Enum.GetValues(typeof<I>)->n:?>I|]|>Seq.filter(fun n->n.[2]=I.Milk) //# 9
let g = Ring.PlainChanges [|for n in System.Enum.GetValues(typeof<G>)->n:?>G|]
let e = Ring.PlainChanges [|for n in System.Enum.GetValues(typeof<E>)->n:?>E|]|>Seq.filter(fun n->fi n E.Green n E.White) //# 5
let l = Ring.PlainChanges [|for n in System.Enum.GetValues(typeof<L>)->n:?>L|]
match n|>Seq.map(fun n->{Nz=n;Iz=[||];Gz=[||];Ez=[||];Lz=[||]})
|>Seq.collect(fun n->i|>Seq.map(fun i->{n with Iz=i}))|>Seq.filter(fun n-> fn n.Nz N.Danish n.Iz I.Tea) //# 4
|>Seq.collect(fun n->g|>Seq.map(fun i->{n with Gz=i}))|>Seq.filter(fun n-> fn n.Nz N.Swedish n.Gz G.Dog) //# 3
|>Seq.collect(fun n->e|>Seq.map(fun i->{n with Ez=i}))|>Seq.filter(fun n-> fn n.Nz N.English n.Ez E.Red && //# 2
fn n.Ez E.Green n.Iz I.Coffee&& //# 6
fg n.Nz N.Norwegian n.Ez E.Blue) //#15
|>Seq.collect(fun n->l|>Seq.map(fun i->{n with Lz=i}))|>Seq.tryFind(fun n->fn n.Lz L.PallMall n.Gz G.Birds && //# 7
fg n.Lz L.Blend n.Gz G.Cats && //#11
fn n.Lz L.Prince n.Nz N.German&& //#14
fg n.Lz L.Blend n.Iz I.Water && //#16
fg n.Lz L.Dunhill n.Gz G.Horse && //#12
fn n.Lz L.Dunhill n.Ez E.Yellow&& //# 8
fn n.Iz I.Beer n.Lz L.BlueMaster) with //#13
|Some(nn) -> nn.Gz |> Array.iteri(fun n g -> if (g = G.Zebra) then printfn "\nThe man who owns a zebra is %A\n" nn.Nz.[n]); printfn "%A" nn
|None -> printfn "No solution found"
- Output:
The man who owns a zebra is German
{Nz = [|Norwegian; Danish; English; German; Swedish|];
Iz = [|Water; Tea; Milk; Coffee; Beer|];
Gz = [|Cats; Horse; Birds; Zebra; Dog|];
Ez = [|Yellow; Blue; Red; Green; White|];
Lz = [|Dunhill; Blend; PallMall; Prince; BlueMaster|];}
FormulaOne
// First, let's give some type-variables some values:
Nationality = Englishman | Swede | Dane | Norwegian | German
Colour = Red | Green | Yellow | Blue | White
Cigarette = PallMall | Dunhill | BlueMaster | Blend | Prince
Domestic = Dog | Bird | Cat | Zebra | Horse
Beverage = Tea | Coffee | Milk | Beer | Water
HouseRow = First | Second | Third | Fourth | Fifth
{
We use injections to make the array-elements unique.
Example: 'Pet' is an array of unique elements of type 'Domestic', indexed by 'Nationality'.
In the predicate 'Zebra', we use this injection 'Pet' to define the array-variable 'pet'
as a parameter of the 'Zebra'-predicate.
The symbol used is the '->>'. 'Nationality->>Domestic' can be read as 'Domestic(Nationality)'
in "plain array-speak";
the difference being that the elements are by definition unique (cf. 'injective function').
So, in FormulaOne we use a formula like: 'pet(Swede) = Dog', which simply means that the 'Swede'
(type 'Nationality') has a 'pet' (type 'Pet', of type 'Domestic', indexed by 'Nationality'),
which appears to be a 'Dog' (type 'Domestic').
Or, one could say that the 'Swede' has been mapped to the 'Dog' (Oh, well...).
}
Pet = Nationality->>Domestic
Drink = Nationality->>Beverage
HouseColour = Nationality->>Colour
Smoke = Nationality->>Cigarette
HouseOrder = HouseRow->>Nationality
pred Zebra(house_olour::HouseColour, pet::Pet, smoke::Smoke, drink::Drink, house_order::HouseOrder) iff
// For convenience sake, some temporary place_holder variables are used.
// An underscore distinguishes them:
house_colour(green_house) = Green &
house_colour(white_house) = White &
house_colour(yellow_house) = Yellow &
smoke(pallmall_smoker) = PallMall &
smoke(blend_smoker) = Blend &
smoke(dunhill_smoker) = Dunhill &
smoke(bluemaster_smoker) = BlueMaster &
pet(cat_keeper) = Cat &
pet(neighbour_dunhill_smoker) = Horse &
{ 2. The English man lives in the red house: }
house_colour(Englishman) = Red &
{ 3. The Swede has a dog: }
pet(Swede) = Dog &
{ 4. The Dane drinks tea: }
drink(Dane) = Tea &
{ 'smoke' and 'drink' are both nouns, like the other variables.
One could read the formulas like: 'the colour of the Englishman's house is Red' ->
'the Swede's pet is a dog' -> 'the Dane's drink is tea'.
}
{ 5. The green house is immediately to the left of the white house.
The local predicate 'LeftOf' (see below) determines the house order: }
LeftOf(green_house, white_house, house_order) &
{ 6. They drink coffee in the green house: }
drink(green_house) = Coffee &
{ 7. The man who smokes Pall Mall has birds: }
pet(pallmall_smoker) = Bird &
{ 8. In the yellow house they smoke Dunhill: }
smoke(yellow_house) = Dunhill &
{ 9. In the middle house (third in the row) they drink milk: }
drink(house_order(Third)) = Milk &
{10. The Norwegian lives in the first house: }
house_order(First) = Norwegian &
{11. The man who smokes Blend lives in the house next to the house with cats.
Another local predicate 'Neighbour' makes them neighbours: }
Neighbour(blend_smoker, cat_keeper, house_order) &
{12. In a house next to the house where they have a horse, they smoke Dunhill: }
Neighbour(dunhill_smoker, neighbour_dunhill_smoker, house_order) &
{13. The man who smokes Blue Master drinks beer: }
drink(bluemaster_smoker) = Beer &
{14. The German smokes Prince: }
smoke(German) = Prince &
{15. The Norwegian lives next to the blue house
Cf. 10. "The Norwegian lives in the first house", so the blue house is the second house: }
house_colour(house_order(Second)) = Blue &
{16. They drink water in a house next to the house where they smoke Blend: }
drink(neighbour_blend_smoker) = Water &
Neighbour(blend_smoker, neighbour_blend_smoker, house_order)
{ A simplified solution would number the houses 1, 2, 3, 4, 5
which makes it easier to order the houses.
'right in the center' would become 3; 'in the first house', 1
But we stick to the original puzzle and use some local predicates.
}
local pred Neighbour(neighbour1::Nationality, neighbour2::Nationality, house_order::HouseOrder)iff
neighbour1 <> neighbour2 &
house_order(house1) = neighbour1 &
house_order(house2) = neighbour2 &
( house1 = house2 + 1 |
house1 = house2 - 1 )
local pred LeftOf(neighbour1::Nationality, neighbour2::Nationality, house_order::HouseOrder) iff
neighbour1 <> neighbour2 &
house_order(house1) = neighbour1 &
house_order(house2) = neighbour2 &
house1 = house2 - 1
{
The 'all'-query in FormulaOne:
all Zebra(house_colour, pet, smokes, drinks, house_order)
gives, of course, only one solution, so it can be replaced by:
one Zebra(house_colour, pet, smokes, drinks, house_order)
}
// The compacted version:
Nationality = Englishman | Swede | Dane | Norwegian | German
Colour = Red | Green | Yellow | Blue | White
Cigarette = PallMall | Dunhill | BlueMaster | Blend | Prince
Domestic = Dog | Bird | Cat | Zebra | Horse
Beverage = Tea | Coffee | Milk | Beer | Water
HouseRow = First | Second | Third | Fourth | Fifth
Pet = Nationality->>Domestic
Drink = Nationality->>Beverage
HouseColour = Nationality->>Colour
Smoke = Nationality->>Cigarette
HouseOrder = HouseRow->>Nationality
pred Zebra(house_colour::HouseColour, pet::Pet, smoke::Smoke, drink::Drink, house_order::HouseOrder) iff
house-colour(green_house) = Green &
house-colour(white_house) = White &
house-colour(yellow_house) = Yellow &
smoke(pallmall_smoker) = PallMall &
smoke(blend_smoker) = Blend &
smoke(dunhill_smoker) = Dunhill &
smoke(bluemaster_smoker) = BlueMaster &
pet(cat_keeper) = Cat &
pet(neighbour_dunhill_smoker) = Horse &
house_colour(Englishman) = Red &
pet(Swede) = Dog &
drink(Dane) = Tea &
LeftOf(green_house, white_house, house_order) &
drink(green_house) = Coffee &
pet(pallmall_smoker) = Bird &
smoke(yellow_house) = Dunhill &
drink(house_order(Third)) = Milk &
house_order(First) = Norwegian &
Neighbour(blend_smoker, cat_keeper, house_order) &
Neighbour(dunhill_smoker, neighbour_dunhill_smoker, house_order) &
drink(bluemaster_smoker) = Beer &
smoke(German) = Prince &
house_colour(house_order(Second)) = Blue &
drink(neighbour_blend_smoker) = Water &
Neighbour(blend_smoker, neighbour_blend_smoker, house_order)
local pred Neighbour(neighbour1::Nationality, neighbour2::Nationality, house_order::HouseOrder)iff
neighbour1 <> neighbour2 &
house_order(house1) = neighbour1 & house_order(house2) = neighbour2 &
( house1 = house2 + 1 | house1 = house2 - 1 )
local pred LeftOf(neighbour1::Nationality, neighbour2::Nationality, house_::HouseOrder) iff
neighbour1 <> neighbour2 &
house_order(house1) = neighbour1 & house_order(house2) = neighbour2 &
house1 = house2 - 1- Output:
house_colour = [ {Englishman} Red, {Swede} White, {Dane} Blue, {Norwegian} Yellow, {German} Green ]
pet = [ {Englishman} Birds, {Swede} Dog, {Dane} Horse, {Norwegian} Cats, {German} Zebra ]
smokes = [ {Englishman} PallMall, {Swede} BlueMaster, {Dane} Blend, {Norwegian} Dunhill, {German} Prince ]
drinks = [ {Englishman} Milk, {Swede} Beer, {Dane} Tea, {Norwegian} Water, {German} Coffee ]
house_order = [ {First} Norwegian, {Second} Dane, {Third} Englishman, {Fourth} German, {Fifth}, Swede ]
FreeBASIC
Enum attr
Colour = 1
Nationality
Beverage
Smoke
Pet
End Enum
Enum Drinks_
Beer = 1
Coffee
Milk
Tea
Water
End Enum
Enum nations
Danish = 1
English
German
Norwegian
Swedish
End Enum
Enum colors
Blue = 1
Green
Red
White
Yellow
End Enum
Enum tobaccos
Blend = 1
BlueMaster
Dunhill
PallMall
Prince
End Enum
Enum animals
Bird = 1
Cat
Dog
Horse
Zebra
End Enum
Const factorial5 = 120
Dim Shared As String permutation(120), perm(5)
Dim Shared As String Colours(5), Nationalities(5), Drinks(5), Smokes(5), Pets(5)
Dim Shared As Integer index
Sub generate(n As Integer, A() As Integer)
Dim As Integer i
If n = 1 Then
Dim tmp As String = ""
For i = 1 To 5
tmp &= Str(A(i)) & " "
Next i
permutation(index) = tmp
index += 1
Else
For i = 1 To n
generate(n - 1, A())
If n Mod 2 = 0 Then
Swap A(i), A(n)
Else
Swap A(1), A(n)
End If
Next i
End If
End Sub
Function house(i As Integer, nombre As Integer) As Integer
For x As Integer = 1 To 5
If Val(Mid(perm(i), x * 2 - 1, 1)) = nombre Then Return x
Next x
Return 0
End Function
Function left_of(h1 As Integer, h2 As Integer) As Boolean
Return (h1 - h2) = -1
End Function
Function next_to(h1 As Integer, h2 As Integer) As Boolean
Return Abs(h1 - h2) = 1
End Function
Sub print_house(i As Integer)
Print Using "####: "; i;
Print Using "\ \ \ \ \ \ \ \ \ \"; _
Colours(Val(Mid(perm(Colour), i * 2 - 1, 1))); _
Nationalities(Val(Mid(perm(Nationality), i * 2 - 1, 1))); _
Drinks(Val(Mid(perm(Beverage), i * 2 - 1, 1))); _
Smokes(Val(Mid(perm(Smoke), i * 2 - 1, 1))); _
Pets(Val(Mid(perm(Pet), i * 2 - 1, 1)))
End Sub
Sub Zebra_puzzle()
Colours(1) = "blue": Colours(2) = "green": Colours(3) = "red": Colours(4) = "white": Colours(5) = "yellow"
Nationalities(1) = "Dane": Nationalities(2) = "English": Nationalities(3) = "German": Nationalities(4) = "Norwegian": Nationalities(5) = "Swede"
Drinks(1) = "beer": Drinks(2) = "coffee": Drinks(3) = "milk": Drinks(4) = "tea": Drinks(5) = "water"
Smokes(1) = "Blend": Smokes(2) = "Blue Master": Smokes(3) = "Dunhill": Smokes(4) = "Pall Mall": Smokes(5) = "Prince"
Pets(1) = "birds": Pets(2) = "cats": Pets(3) = "dog": Pets(4) = "horse": Pets(5) = "zebra"
Dim As String solperms(120, 5)
Dim As Integer solutions, i, c, n, d, s, p, j
Dim As Integer b(5)
For i = 1 To 5: b(i) = i: Next
'There are five houses.
index = 0
generate(5, b())
For c = 0 To factorial5 - 1
perm(Colour) = permutation(c)
'The green house is immediately to the left of the white house.
If left_of(house(Colour, Green), house(Colour, White)) Then
For n = 0 To factorial5 - 1
perm(Nationality) = permutation(n)
'The Norwegian lives in the first house.
'The English man lives in the red house.
'The Norwegian lives next to the blue house.
If house(Nationality, Norwegian) = 1 _
And house(Nationality, English) = house(Colour, Red) _
And next_to(house(Nationality, Norwegian), house(Colour, Blue)) Then
For d = 0 To factorial5 - 1
perm(Beverage) = permutation(d)
'The Dane drinks tea.
'They drink coffee in the green house.
'In the middle house they drink milk.
If house(Nationality, Danish) = house(Beverage, Tea) _
And house(Beverage, Coffee) = house(Colour, Green) _
And house(Beverage, Milk) = 3 Then
For s = 0 To factorial5 - 1
perm(Smoke) = permutation(s)
'In the yellow house they smoke Dunhill.
'The German smokes Prince.
'The man who smokes Blue Master drinks beer.
'They Drink water in a house next to the house where they smoke Blend.
If house(Colour, Yellow) = house(Smoke, Dunhill) _
And house(Nationality, German) = house(Smoke, Prince) _
And house(Smoke, BlueMaster) = house(Beverage, Beer) _
And next_to(house(Beverage, Water), house(Smoke, Blend)) Then
For p = 0 To factorial5 - 1
perm(Pet) = permutation(p)
'The Swede has a dog.
'The man who smokes Pall Mall has birds.
'The man who smokes Blend lives in the house next to the house with cats.
'In a house next to the house where they have a horse, they smoke Dunhill.
If house(Nationality, Swedish) = house(Pet, Dog) _
And house(Smoke, PallMall) = house(Pet, Bird) _
And next_to(house(Smoke, Blend), house(Pet, Cat)) _
And next_to(house(Pet, Horse), house(Smoke, Dunhill)) Then
For i = 1 To 5
print_house(i)
Next i
Print
solutions += 1
For j = 1 To 5
solperms(solutions - 1, j - 1) = perm(j)
Next j
End If
Next p
End If
Next s
End If
Next d
End If
Next n
End If
Next c
Print solutions & " solution" & Iif(solutions > 1, "s", "") & " found"
For i As Integer = 0 To solutions - 1
For j As Integer = 1 To 5
perm(j) = solperms(i, j - 1)
Next j
Print "The " & Nationalities(Val(Mid(perm(Nationality), house(Pet, Zebra) * 2 - 1, 1))) & " owns the Zebra"
Next i
End Sub
Print "House Colour Nation Drink Smoke Animal"
Zebra_puzzle()
Sleep
- Output:
House Colour Nation Drink Smoke Animal 1: yellow Norwegian water Dunhill cats 2: blue Dane tea Blend horse 3: red English milk Pall Mall birds 4: green German coffee Prince zebra 5: white Swede beer Blue Mast dog 1 solution found The German owns the Zebra
GAP
leftOf :=function(setA, vA, setB, vB)
local i;
for i in [1..4] do
if ( setA[i] = vA) and (setB[i+1] = vB) then return true ;fi;
od;
return false;
end;
nextTo :=function(setA, vA, setB, vB)
local i;
for i in [1..4] do
if ( setA[i] = vA) and (setB[i+1] = vB) then return true ;fi;
if ( setB[i] = vB) and (setA[i+1] = vA) then return true ;fi;
od;
return false;
end;
requires := function(setA, vA, setB, vB)
local i;
for i in [1..5] do
if ( setA[i] = vA) and (setB[i] = vB) then return true ;fi;
od;
return false;
end;
pcolors :=PermutationsList(["white" ,"yellow" ,"blue" ,"red" ,"green"]);
pcigars :=PermutationsList(["blends", "pall_mall", "prince", "bluemasters", "dunhill"]);
pnats:=PermutationsList(["german", "swedish", "british", "norwegian", "danish"]);
pdrinks :=PermutationsList(["beer", "water", "tea", "milk", "coffee"]);
ppets :=PermutationsList(["birds", "cats", "horses", "fish", "dogs"]);
for colors in pcolors do
if not (leftOf(colors,"green",colors,"white")) then continue ;fi;
for nats in pnats do
if not (requires(nats,"british",colors,"red")) then continue ;fi;
if not (nats[1]="norwegian") then continue ;fi;
if not (nextTo(nats,"norwegian",colors,"blue")) then continue ;fi;
for pets in ppets do
if not (requires(nats,"swedish",pets,"dogs")) then continue ;fi;
for drinks in pdrinks do
if not (drinks[3]="milk") then continue ;fi;
if not (requires(colors,"green",drinks,"coffee")) then continue ;fi;
if not (requires(nats,"danish",drinks,"tea")) then continue ;fi;
for cigars in pcigars do
if not (nextTo(pets,"horses",cigars,"dunhill")) then continue ;fi;
if not (requires(cigars,"pall_mall",pets,"birds")) then continue ;fi;
if not (nextTo(cigars,"blends",drinks,"water")) then continue ;fi;
if not (nextTo(cigars,"blends",pets,"cats")) then continue ;fi;
if not (requires(nats,"german",cigars,"prince")) then continue ;fi;
if not (requires(colors,"yellow",cigars,"dunhill")) then continue ;fi;
if not (requires(cigars,"bluemasters",drinks,"beer")) then continue ;fi;
Print(colors,"\n");
Print(nats,"\n");
Print(drinks,"\n");
Print(pets,"\n");
Print(cigars,"\n");
od;od;od;od;od;
Go
package main
import (
"fmt"
"log"
"strings"
)
// Define some types
type HouseSet [5]*House
type House struct {
n Nationality
c Colour
a Animal
d Drink
s Smoke
}
type Nationality int8
type Colour int8
type Animal int8
type Drink int8
type Smoke int8
// Define the possible values
const (
English Nationality = iota
Swede
Dane
Norwegian
German
)
const (
Red Colour = iota
Green
White
Yellow
Blue
)
const (
Dog Animal = iota
Birds
Cats
Horse
Zebra
)
const (
Tea Drink = iota
Coffee
Milk
Beer
Water
)
const (
PallMall Smoke = iota
Dunhill
Blend
BlueMaster
Prince
)
// And how to print them
var nationalities = [...]string{"English", "Swede", "Dane", "Norwegian", "German"}
var colours = [...]string{"red", "green", "white", "yellow", "blue"}
var animals = [...]string{"dog", "birds", "cats", "horse", "zebra"}
var drinks = [...]string{"tea", "coffee", "milk", "beer", "water"}
var smokes = [...]string{"Pall Mall", "Dunhill", "Blend", "Blue Master", "Prince"}
func (n Nationality) String() string { return nationalities[n] }
func (c Colour) String() string { return colours[c] }
func (a Animal) String() string { return animals[a] }
func (d Drink) String() string { return drinks[d] }
func (s Smoke) String() string { return smokes[s] }
func (h House) String() string {
return fmt.Sprintf("%-9s %-6s %-5s %-6s %s", h.n, h.c, h.a, h.d, h.s)
}
func (hs HouseSet) String() string {
lines := make([]string, 0, len(hs))
for i, h := range hs {
s := fmt.Sprintf("%d %s", i, h)
lines = append(lines, s)
}
return strings.Join(lines, "\n")
}
// Simple brute force solution
func simpleBruteForce() (int, HouseSet) {
var v []House
for n := range nationalities {
for c := range colours {
for a := range animals {
for d := range drinks {
for s := range smokes {
h := House{
n: Nationality(n),
c: Colour(c),
a: Animal(a),
d: Drink(d),
s: Smoke(s),
}
if !h.Valid() {
continue
}
v = append(v, h)
}
}
}
}
}
n := len(v)
log.Println("Generated", n, "valid houses")
combos := 0
first := 0
valid := 0
var validSet HouseSet
for a := 0; a < n; a++ {
if v[a].n != Norwegian { // Condition 10:
continue
}
for b := 0; b < n; b++ {
if b == a {
continue
}
if v[b].anyDups(&v[a]) {
continue
}
for c := 0; c < n; c++ {
if c == b || c == a {
continue
}
if v[c].d != Milk { // Condition 9:
continue
}
if v[c].anyDups(&v[b], &v[a]) {
continue
}
for d := 0; d < n; d++ {
if d == c || d == b || d == a {
continue
}
if v[d].anyDups(&v[c], &v[b], &v[a]) {
continue
}
for e := 0; e < n; e++ {
if e == d || e == c || e == b || e == a {
continue
}
if v[e].anyDups(&v[d], &v[c], &v[b], &v[a]) {
continue
}
combos++
set := HouseSet{&v[a], &v[b], &v[c], &v[d], &v[e]}
if set.Valid() {
valid++
if valid == 1 {
first = combos
}
validSet = set
//return set
}
}
}
}
}
}
log.Println("Tested", first, "different combinations of valid houses before finding solution")
log.Println("Tested", combos, "different combinations of valid houses in total")
return valid, validSet
}
// anyDups returns true if h as any duplicate attributes with any of the specified houses
func (h *House) anyDups(list ...*House) bool {
for _, b := range list {
if h.n == b.n || h.c == b.c || h.a == b.a || h.d == b.d || h.s == b.s {
return true
}
}
return false
}
func (h *House) Valid() bool {
// Condition 2:
if h.n == English && h.c != Red || h.n != English && h.c == Red {
return false
}
// Condition 3:
if h.n == Swede && h.a != Dog || h.n != Swede && h.a == Dog {
return false
}
// Condition 4:
if h.n == Dane && h.d != Tea || h.n != Dane && h.d == Tea {
return false
}
// Condition 6:
if h.c == Green && h.d != Coffee || h.c != Green && h.d == Coffee {
return false
}
// Condition 7:
if h.a == Birds && h.s != PallMall || h.a != Birds && h.s == PallMall {
return false
}
// Condition 8:
if h.c == Yellow && h.s != Dunhill || h.c != Yellow && h.s == Dunhill {
return false
}
// Condition 11:
if h.a == Cats && h.s == Blend {
return false
}
// Condition 12:
if h.a == Horse && h.s == Dunhill {
return false
}
// Condition 13:
if h.d == Beer && h.s != BlueMaster || h.d != Beer && h.s == BlueMaster {
return false
}
// Condition 14:
if h.n == German && h.s != Prince || h.n != German && h.s == Prince {
return false
}
// Condition 15:
if h.n == Norwegian && h.c == Blue {
return false
}
// Condition 16:
if h.d == Water && h.s == Blend {
return false
}
return true
}
func (hs *HouseSet) Valid() bool {
ni := make(map[Nationality]int, 5)
ci := make(map[Colour]int, 5)
ai := make(map[Animal]int, 5)
di := make(map[Drink]int, 5)
si := make(map[Smoke]int, 5)
for i, h := range hs {
ni[h.n] = i
ci[h.c] = i
ai[h.a] = i
di[h.d] = i
si[h.s] = i
}
// Condition 5:
if ci[Green]+1 != ci[White] {
return false
}
// Condition 11:
if dist(ai[Cats], si[Blend]) != 1 {
return false
}
// Condition 12:
if dist(ai[Horse], si[Dunhill]) != 1 {
return false
}
// Condition 15:
if dist(ni[Norwegian], ci[Blue]) != 1 {
return false
}
// Condition 16:
if dist(di[Water], si[Blend]) != 1 {
return false
}
// Condition 9: (already tested elsewhere)
if hs[2].d != Milk {
return false
}
// Condition 10: (already tested elsewhere)
if hs[0].n != Norwegian {
return false
}
return true
}
func dist(a, b int) int {
if a > b {
return a - b
}
return b - a
}
func main() {
log.SetFlags(0)
n, sol := simpleBruteForce()
fmt.Println(n, "solution found")
fmt.Println(sol)
}
- Output:
Generated 51 valid houses Tested 652 different combinations of valid houses before finding solution Tested 750 different combinations of valid houses in total 1 solution found 0 Norwegian yellow cats water Dunhill 1 Dane blue horse tea Blend 2 English red birds milk Pall Mall 3 German green zebra coffee Prince 4 Swede white dog beer Blue Master
Benchmark (not included but just calling simpleBruteForce):
BenchmarkBruteForce 1000 2687946 ns/op 550568 B/op 7560 allocs/op
Haskell
module Main where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (foldM, forM_)
import Data.List ((\\))
-- types
data House = House
{ color :: Color -- <trait> :: House -> <Trait>
, man :: Man
, pet :: Pet
, drink :: Drink
, smoke :: Smoke
}
deriving (Eq, Show)
data Color = Red | Green | Blue | Yellow | White
deriving (Eq, Show, Enum, Bounded)
data Man = Eng | Swe | Dan | Nor | Ger
deriving (Eq, Show, Enum, Bounded)
data Pet = Dog | Birds | Cats | Horse | Zebra
deriving (Eq, Show, Enum, Bounded)
data Drink = Coffee | Tea | Milk | Beer | Water
deriving (Eq, Show, Enum, Bounded)
data Smoke = PallMall | Dunhill | Blend | BlueMaster | Prince
deriving (Eq, Show, Enum, Bounded)
type Solution = [House]
main :: IO ()
main = do
forM_ solutions $ \sol -> mapM_ print sol
>> putStrLn "----"
putStrLn "No More Solutions"
solutions :: [Solution]
solutions = filter finalCheck . map reverse $ foldM next [] [1..5]
where
-- NOTE: list of houses is generated in reversed order
next :: Solution -> Int -> [Solution]
next sol pos = [h:sol | h <- newHouses sol, consistent h pos]
newHouses :: Solution -> Solution
newHouses sol = -- all combinations of traits not yet used
House <$> new color <*> new man <*> new pet <*> new drink <*> new smoke
where
new trait = [minBound ..] \\ map trait sol -- :: [<Trait>]
consistent :: House -> Int -> Bool
consistent house pos = and -- consistent with the rules:
[ man `is` Eng <=> color `is` Red -- 2
, man `is` Swe <=> pet `is` Dog -- 3
, man `is` Dan <=> drink `is` Tea -- 4
, color `is` Green <=> drink `is` Coffee -- 6
, pet `is` Birds <=> smoke `is` PallMall -- 7
, color `is` Yellow <=> smoke `is` Dunhill -- 8
, const (pos == 3) <=> drink `is` Milk -- 9
, const (pos == 1) <=> man `is` Nor -- 10
, drink `is` Beer <=> smoke `is` BlueMaster -- 13
, man `is` Ger <=> smoke `is` Prince -- 14
]
where
infix 4 <=>
p <=> q = p house == q house -- both True or both False
is :: Eq a => (House -> a) -> a -> House -> Bool
(trait `is` value) house = trait house == value
finalCheck :: [House] -> Bool
finalCheck solution = and -- fulfills the rules:
[ (color `is` Green) `leftOf` (color `is` White) -- 5
, (smoke `is` Blend ) `nextTo` (pet `is` Cats ) -- 11
, (smoke `is` Dunhill) `nextTo` (pet `is` Horse) -- 12
, (color `is` Blue ) `nextTo` (man `is` Nor ) -- 15
, (smoke `is` Blend ) `nextTo` (drink `is` Water) -- 16
]
where
nextTo :: (House -> Bool) -> (House -> Bool) -> Bool
nextTo p q = leftOf p q || leftOf q p
leftOf p q
| (_:h:_) <- dropWhile (not . p) solution = q h
| otherwise = False
- Output:
House {color = Yellow, man = Nor, pet = Cats, drink = Water, smoke = Dunhill}
House {color = Blue, man = Dan, pet = Horse, drink = Tea, smoke = Blend}
House {color = Red, man = Eng, pet = Birds, drink = Milk, smoke = PallMall}
House {color = Green, man = Ger, pet = Zebra, drink = Coffee, smoke = Prince}
House {color = White, man = Swe, pet = Dog, drink = Beer, smoke = BlueMaster}
----
No More Solutions
LP-like version
(a little faster version)
import Control.Monad
import Data.List
values :: (Bounded a, Enum a) => [[a]]
values = permutations [minBound..maxBound]
data Nation = English | Swede | Dane | Norwegian | German
deriving (Bounded, Enum, Eq, Show)
data Color = Red | Green | White | Yellow | Blue
deriving (Bounded, Enum, Eq, Show)
data Pet = Dog | Birds | Cats | Horse | Zebra
deriving (Bounded, Enum, Eq, Show)
data Drink = Tea | Coffee | Milk | Beer | Water
deriving (Bounded, Enum, Eq, Show)
data Smoke = PallMall | Dunhill | Blend | BlueMaster | Prince
deriving (Bounded, Enum, Eq, Show)
answers = do
color <- values
leftOf color Green color White -- 5
nation <- values
first nation Norwegian -- 10
same nation English color Red -- 2
nextTo nation Norwegian color Blue -- 15
drink <- values
middle drink Milk -- 9
same nation Dane drink Tea -- 4
same drink Coffee color Green -- 6
pet <- values
same nation Swede pet Dog -- 3
smoke <- values
same smoke PallMall pet Birds -- 7
same color Yellow smoke Dunhill -- 8
nextTo smoke Blend pet Cats -- 11
nextTo pet Horse smoke Dunhill -- 12
same nation German smoke Prince -- 14
same smoke BlueMaster drink Beer -- 13
nextTo drink Water smoke Blend -- 16
return $ zip5 nation color pet drink smoke
where
same xs x ys y = guard $ (x, y) `elem` zip xs ys
leftOf xs x ys y = same xs x (tail ys) y
nextTo xs x ys y = leftOf xs x ys y `mplus`
leftOf ys y xs x
middle xs x = guard $ xs !! 2 == x
first xs x = guard $ head xs == x
main = do
forM_ answers $ (\answer -> -- for answer in answers:
do
mapM_ print answer
print [nation | (nation, _, Zebra, _, _) <- answer]
putStrLn "" )
putStrLn "No more solutions!"
Output:
(Norwegian,Yellow,Cats,Water,Dunhill) (Dane,Blue,Horse,Tea,Blend) (English,Red,Birds,Milk,PallMall) (German,Green,Zebra,Coffee,Prince) (Swede,White,Dog,Beer,BlueMaster) [German] No more solutions!
J
Progressive "build and filter" approach
in=: {{n&{ i. m"_}} NB. index of m in row n of matrix
F =: {{u"_1 # ]}} NB. filter by function of items
'Col Nat Pet Drink Cig'=: i.5 NB. refer to rows by name
'col nat pet drink cig'=: (A.~i.@!@#)&>;:'BGRWY DEGNS BCDHZ BCMTW BbDpP' NB. perm matrices
P=: ('W' in Col (= >:) 'G' in Col)F ,/col,:"1/nat NB. join first two mats and add 1st constraint
P=: ,/pet,"2 1/~ (('E' in Nat = 'R' in Col)*.(0 = 'N' in Nat))F P NB. and so on...
P=: ,/drink,"2 1/~ (('D' in Pet = 'S' in Nat)*.('N' in Nat (1=|@:-) 'B' in Col))F P
P=: (('C' in Drink = 'G' in Col)*.(2 = 'M' in Drink))F P
P=: (('T' in Drink = 'D' in Nat)*.('p' in Cig = 'B' in Pet))F ,/P,"2 1/cig
P=: (('D' in Cig = 'Y' in Col)*.('b' in Cig = 'B' in Drink))F P
P=: (('P' in Cig = 'G' in Nat)*.('B' in Cig (1=|@:-) 'C' in Pet))F P
P=: (('D' in Cig (1=|@:-) 'H' in Pet)*.('B' in Cig (1=|@:-) 'W' in Drink))F P
echo 'Solutions found: ',(":#P),LF,LF,~' owns the Z',~('Z' in Pet { Nat&{){.P
echo 'Col Nat Pet Drink Cig', ([,(6#' '),])/"1|:{.P
- Output:
Solutions found: 1 G owns the Z Col Nat Pet Drink Cig Y N C W D B D H T B R E B M p G G Z C P W S D B b
Each line processes two constraints in order to save line space. The two constraints in a given line are not particularly related to each other; the coupling is arbitrary.
The permutation matrices are spliced into a cube in which each matrix represents a possible solution given the constraints considered thus far.
In the interest of compact code, each person/thing is denoted by a single character. But note that we could've easily used symbols (s:) instead of characters, enabling longer names while still using the same flat array code:
perms=: A.~ i.@!@# ]Mat=: perms (N)=: s: ;: N=:'Swede Dane Norwegian' `Swede `Dane `Norwegian `Swede `Norwegian `Dane `Dane `Swede `Norwegian `Dane `Norwegian `Swede `Norwegian `Swede `Dane `Norwegian `Dane `Swede $Mat 6 3 Mat i."1 Swede 0 0 1 2 1 2 Swede `Swede
"Solve all constraints at the end" approach
Propositions 1 .. 16 without 9,10 and 15
ehs=: 5$a:
cr=: (('English';'red') 0 3} ehs);<('Dane';'tea') 0 2}ehs
cr=: cr, (('German';'Prince') 0 4}ehs);<('Swede';'dog') 0 1 }ehs
cs=: <('PallMall';'birds') 4 1}ehs
cs=: cs, (('yellow';'Dunhill') 3 4}ehs);<('BlueMaster';'beer') 4 2}ehs
lof=: (('coffee';'green')2 3}ehs);<(<'white')3}ehs
next=: <((<'Blend') 4 }ehs);<(<'water')2}ehs
next=: next,<((<'Blend') 4 }ehs);<(<'cats')1}ehs
next=: next,<((<'Dunhill') 4}ehs);<(<'horse')1}ehs
Example
lof
┌─────────────────┬───────────┐
│┌┬┬──────┬─────┬┐│┌┬┬┬─────┬┐│
││││coffee│green│││││││white│││
│└┴┴──────┴─────┴┘│└┴┴┴─────┴┘│
└─────────────────┴───────────┘
Collections of all variants of the propositions:
hcr=: (<ehs),. (A.~i.@!@#)cr
hcs=:~. (A.~i.@!@#)cs,2$<ehs
hlof=:(-i.4) |."0 1 lof,3$<ehs
hnext=: ,/((i.4) |."0 1 (3$<ehs)&,)"1 ;(,,:|.)&.> next
We start the row of houses with fixed properties 9, 10 and 15.
houses=: ((<'Norwegian') 0}ehs);((<'blue') 3 }ehs);((<'milk') 2}ehs);ehs;<ehs
- Output:
houses
┌───────────────┬──────────┬──────────┬──────┬──────┐
│┌─────────┬┬┬┬┐│┌┬┬┬────┬┐│┌┬┬────┬┬┐│┌┬┬┬┬┐│┌┬┬┬┬┐│
││Norwegian││││││││││blue││││││milk││││││││││││││││││
│└─────────┴┴┴┴┘│└┴┴┴────┴┘│└┴┴────┴┴┘│└┴┴┴┴┘│└┴┴┴┴┘│
└───────────────┴──────────┴──────────┴──────┴──────┘
Set of proposition variants:
constraints=: hcr;hcs;hlof;<hnext
The worker and its helper verbs
Select=: [: ~. ,: #~ ,&(0~:#)
Filter=: #~ *./@:(2>#S:0)"1
Compose=: [: Filter [: ,/ Select L:0"1"1 _
solve=: 4 :0
h=. ,:x
whilst. 0=# z do.
for_e. y do. h=. h Compose > e end.
z=.(#~1=[:+/"1 (0=#)S:0"1) h=.~. h
end.
)
- Output:
> houses solve constraints
┌─────────┬─────┬──────┬──────┬──────────┐
│Norwegian│cats │water │yellow│Dunhill │
├─────────┼─────┼──────┼──────┼──────────┤
│Dane │horse│tea │blue │Blend │
├─────────┼─────┼──────┼──────┼──────────┤
│English │birds│milk │red │PallMall │
├─────────┼─────┼──────┼──────┼──────────┤
│German │ │coffee│green │Prince │
├─────────┼─────┼──────┼──────┼──────────┤
│Swede │dog │beer │white │BlueMaster│
└─────────┴─────┴──────┴──────┴──────────┘
So, the German owns the zebra.
Alternative
A longer running solver by adding the zebra variants.
zebra=: (-i.5)|."0 1 (<(<'zebra') 1}ehs),4$<ehs
solve3=: 4 :0
p=. *./@:((0~:#)S:0)
f=. [:~.&.> [: compose&.>~/y&,
z=. f^:(3>[:#(#~p"1)&>)^:_ <,:x
> (#~([:*./[:;[:<@({.~:}.)\.;)"1)(#~p"1); z
)
- Output:
houses solve3 constraints,<zebra
┌─────────┬─────┬──────┬──────┬──────────┐
│Norwegian│cats │water │yellow│Dunhill │
├─────────┼─────┼──────┼──────┼──────────┤
│Dane │horse│tea │blue │Blend │
├─────────┼─────┼──────┼──────┼──────────┤
│English │birds│milk │red │PallMall │
├─────────┼─────┼──────┼──────┼──────────┤
│German │zebra│coffee│green │Prince │
├─────────┼─────┼──────┼──────┼──────────┤
│Swede │dog │beer │white │BlueMaster│
└─────────┴─────┴──────┴──────┴──────────┘
Java
This Java solution includes 4 classes:
- The outer class Zebra
- A PossibleLine
- A set of PossibleLines
- The Solver
package org.rosettacode.zebra;
import java.util.Arrays;
import java.util.Iterator;
import java.util.LinkedHashSet;
import java.util.Objects;
import java.util.Set;
public class Zebra {
private static final int[] orders = {1, 2, 3, 4, 5};
private static final String[] nations = {"English", "Danish", "German", "Swedish", "Norwegian"};
private static final String[] animals = {"Zebra", "Horse", "Birds", "Dog", "Cats"};
private static final String[] drinks = {"Coffee", "Tea", "Beer", "Water", "Milk"};
private static final String[] cigarettes = {"Pall Mall", "Blend", "Blue Master", "Prince", "Dunhill"};
private static final String[] colors = {"Red", "Green", "White", "Blue", "Yellow"};
static class Solver {
private final PossibleLines puzzleTable = new PossibleLines();
void solve() {
PossibleLines constraints = new PossibleLines();
constraints.add(new PossibleLine(null, "English", "Red", null, null, null));
constraints.add(new PossibleLine(null, "Swedish", null, "Dog", null, null));
constraints.add(new PossibleLine(null, "Danish", null, null, "Tea", null));
constraints.add(new PossibleLine(null, null, "Green", null, "Coffee", null));
constraints.add(new PossibleLine(null, null, null, "Birds", null, "Pall Mall"));
constraints.add(new PossibleLine(null, null, "Yellow", null, null, "Dunhill"));
constraints.add(new PossibleLine(3, null, null, null, "Milk", null));
constraints.add(new PossibleLine(1, "Norwegian", null, null, null, null));
constraints.add(new PossibleLine(null, null, null, null, "Beer", "Blue Master"));
constraints.add(new PossibleLine(null, "German", null, null, null, "Prince"));
constraints.add(new PossibleLine(2, null, "Blue", null, null, null));
//Creating all possible combination of a puzzle line.
//The maximum number of lines is 5^^6 (15625).
//Each combination line is checked against a set of knowing facts, thus
//only a small number of line result at the end.
for (Integer orderId : Zebra.orders) {
for (String nation : Zebra.nations) {
for (String color : Zebra.colors) {
for (String animal : Zebra.animals) {
for (String drink : Zebra.drinks) {
for (String cigarette : Zebra.cigarettes) {
addPossibleNeighbors(constraints, orderId, nation, color, animal, drink, cigarette);
}
}
}
}
}
}
System.out.println("After general rule set validation, remains " +
puzzleTable.size() + " lines.");
for (Iterator<PossibleLine> it = puzzleTable.iterator(); it.hasNext(); ) {
boolean validLine = true;
PossibleLine possibleLine = it.next();
if (possibleLine.leftNeighbor != null) {
PossibleLine neighbor = possibleLine.leftNeighbor;
if (neighbor.order < 1 || neighbor.order > 5) {
validLine = false;
it.remove();
}
}
if (validLine && possibleLine.rightNeighbor != null) {
PossibleLine neighbor = possibleLine.rightNeighbor;
if (neighbor.order < 1 || neighbor.order > 5) {
it.remove();
}
}
}
System.out.println("After removing out of bound neighbors, remains " +
puzzleTable.size() + " lines.");
//Setting left and right neighbors
for (PossibleLine puzzleLine : puzzleTable) {
for (PossibleLine leftNeighbor : puzzleLine.neighbors) {
PossibleLine rightNeighbor = leftNeighbor.copy();
//make it left neighbor
leftNeighbor.order = puzzleLine.order - 1;
if (puzzleTable.contains(leftNeighbor)) {
if (puzzleLine.leftNeighbor != null)
puzzleLine.leftNeighbor.merge(leftNeighbor);
else
puzzleLine.setLeftNeighbor(leftNeighbor);
}
rightNeighbor.order = puzzleLine.order + 1;
if (puzzleTable.contains(rightNeighbor)) {
if (puzzleLine.rightNeighbor != null)
puzzleLine.rightNeighbor.merge(rightNeighbor);
else
puzzleLine.setRightNeighbor(rightNeighbor);
}
}
}
int iteration = 1;
int lastSize = 0;
//Recursively validate against neighbor rules
while (puzzleTable.size() > 5 && lastSize != puzzleTable.size()) {
lastSize = puzzleTable.size();
puzzleTable.clearLineCountFlags();
recursiveSearch(null, puzzleTable, -1);
constraints.clear();
// Assuming we'll get at leas one valid line each iteration, we create
// a set of new rules with lines which have no more then one instance of same OrderId.
for (int i = 1; i < 6; i++) {
if (puzzleTable.getLineCountByOrderId(i) == 1)
constraints.addAll(puzzleTable.getSimilarLines(new PossibleLine(i, null, null, null, null,
null)));
}
puzzleTable.removeIf(puzzleLine -> !constraints.accepts(puzzleLine));
System.out.println("After " + iteration + " recursive iteration, remains "
+ puzzleTable.size() + " lines");
iteration++;
}
// Print the results
System.out.println("-------------------------------------------");
if (puzzleTable.size() == 5) {
for (PossibleLine puzzleLine : puzzleTable) {
System.out.println(puzzleLine.getWholeLine());
}
} else
System.out.println("Sorry, solution not found!");
}
private void addPossibleNeighbors(
PossibleLines constraints, Integer orderId, String nation,
String color, String animal, String drink, String cigarette) {
boolean validLine = true;
PossibleLine pzlLine = new PossibleLine(orderId,
nation,
color,
animal,
drink,
cigarette);
// Checking against a set of knowing facts
if (constraints.accepts(pzlLine)) {
// Adding rules of neighbors
if (cigarette.equals("Blend")
&& (animal.equals("Cats") || drink.equals("Water")))
validLine = false;
if (cigarette.equals("Dunhill")
&& animal.equals("Horse"))
validLine = false;
if (validLine) {
puzzleTable.add(pzlLine);
//set neighbors constraints
if (color.equals("Green")) {
pzlLine.setRightNeighbor(
new PossibleLine(null, null, "White", null, null, null));
}
if (color.equals("White")) {
pzlLine.setLeftNeighbor(
new PossibleLine(null, null, "Green", null, null, null));
}
//
if (animal.equals("Cats") && !cigarette.equals("Blend")) {
pzlLine.neighbors.add(new PossibleLine(null, null, null, null, null,
"Blend"));
}
if (cigarette.equals("Blend") && !animal.equals("Cats")) {
pzlLine.neighbors.add(new PossibleLine(null, null, null, "Cats", null
, null));
}
//
if (drink.equals("Water")
&& !animal.equals("Cats")
&& !cigarette.equals("Blend")) {
pzlLine.neighbors.add(new PossibleLine(null, null, null, null, null,
"Blend"));
}
if (cigarette.equals("Blend") && !drink.equals("Water")) {
pzlLine.neighbors.add(new PossibleLine(null, null, null, null, "Water"
, null));
}
//
if (animal.equals("Horse") && !cigarette.equals("Dunhill")) {
pzlLine.neighbors.add(new PossibleLine(null, null, null, null, null,
"Dunhill"));
}
if (cigarette.equals("Dunhill") && !animal.equals("Horse")) {
pzlLine.neighbors.add(new PossibleLine(null, null, null, "Horse",
null, null));
}
}
}
}
// Recursively checks the input set to ensure each line has right neighbor.
// Neighbors can be of three type, left, right or undefined.
// Direction: -1 left, 0 undefined, 1 right
private boolean recursiveSearch(PossibleLine pzzlNodeLine,
PossibleLines possibleLines, int direction) {
boolean validLeaf = false;
boolean hasNeighbor;
PossibleLines puzzleSubSet;
for (Iterator<PossibleLine> it = possibleLines.iterator(); it.hasNext(); ) {
PossibleLine pzzlLeafLine = it.next();
validLeaf = false;
hasNeighbor = pzzlLeafLine.hasNeighbor(direction);
if (hasNeighbor) {
puzzleSubSet = puzzleTable.getSimilarLines(pzzlLeafLine.getNeighbor(direction));
if (puzzleSubSet != null) {
if (pzzlNodeLine != null)
validLeaf = puzzleSubSet.contains(pzzlNodeLine);
else
validLeaf = recursiveSearch(pzzlLeafLine, puzzleSubSet, -1 * direction);
}
}
if (!validLeaf && pzzlLeafLine.hasNeighbor(-1 * direction)) {
hasNeighbor = true;
puzzleSubSet = puzzleTable.getSimilarLines(pzzlLeafLine.getNeighbor(-1 * direction));
if (puzzleSubSet != null) {
if (pzzlNodeLine != null)
validLeaf = puzzleSubSet.contains(pzzlNodeLine);
else
validLeaf = recursiveSearch(pzzlLeafLine, puzzleSubSet, direction);
}
}
if (pzzlNodeLine != null && validLeaf)
return true;
if (pzzlNodeLine == null && hasNeighbor && !validLeaf) {
it.remove();
}
if (pzzlNodeLine == null) {
if (hasNeighbor && validLeaf) {
possibleLines.riseLineCountFlags(pzzlLeafLine.order);
}
if (!hasNeighbor) {
possibleLines.riseLineCountFlags(pzzlLeafLine.order);
}
}
}
return validLeaf;
}
}
public static void main(String[] args) {
Solver solver = new Solver();
solver.solve();
}
static class PossibleLines extends LinkedHashSet<PossibleLine> {
private final int[] count = new int[5];
public PossibleLine get(int index) {
return ((PossibleLine) toArray()[index]);
}
public PossibleLines getSimilarLines(PossibleLine searchLine) {
PossibleLines puzzleSubSet = new PossibleLines();
for (PossibleLine possibleLine : this) {
if (possibleLine.getCommonFactsCount(searchLine) == searchLine.getFactsCount())
puzzleSubSet.add(possibleLine);
}
if (puzzleSubSet.isEmpty())
return null;
return puzzleSubSet;
}
public boolean contains(PossibleLine searchLine) {
for (PossibleLine puzzleLine : this) {
if (puzzleLine.getCommonFactsCount(searchLine) == searchLine.getFactsCount())
return true;
}
return false;
}
public boolean accepts(PossibleLine searchLine) {
int passed = 0;
int notpassed = 0;
for (PossibleLine puzzleSetLine : this) {
int lineFactsCnt = puzzleSetLine.getFactsCount();
int comnFactsCnt = puzzleSetLine.getCommonFactsCount(searchLine);
if (lineFactsCnt != comnFactsCnt && lineFactsCnt != 0 && comnFactsCnt != 0) {
notpassed++;
}
if (lineFactsCnt == comnFactsCnt)
passed++;
}
return passed >= 0 && notpassed == 0;
}
public void riseLineCountFlags(int lineOrderId)