September 2017 Update

This commit is contained in:
Ingy döt Net 2017-09-23 10:01:46 +02:00
parent bba7bfd280
commit ba8067c3b7
14570 changed files with 153136 additions and 63871 deletions

View file

@ -1,5 +1,3 @@
[[File:zebra.png|550px||right]]
The [[wp:Zebra puzzle|Zebra puzzle]], a.k.a. Einstein's Riddle,
is a logic puzzle which is to be solved programmatically. <br>
It has several variants, one of them this:

View file

@ -1,4 +1,5 @@
---
category:
- Constraint Handling Rules
- Puzzles
note: Puzzles

View file

@ -1,10 +1,12 @@
module Main where
import Control.Applicative ((<$>), (<*>))
import Control.Monad (foldM, forM_)
import Data.List ((\\), isInfixOf)
import Data.List ((\\))
-- types
data House = House
{ color :: Color
{ color :: Color -- <trait> :: House -> <Trait>
, man :: Man
, pet :: Pet
, drink :: Drink
@ -27,51 +29,55 @@ data Drink = Coffee | Tea | Milk | Beer | Water
data Smoke = PallMall | Dunhill | Blend | BlueMaster | Prince
deriving (Eq, Show, Enum, Bounded)
type Solution = [House]
main :: IO ()
main = do
forM_ solutions $ \x -> mapM_ print (reverse x)
>> putStrLn "----"
forM_ solutions $ \sol -> mapM_ print sol
>> putStrLn "----"
putStrLn "No More Solutions"
solutions :: [[House]]
solutions = filter (and . postChecks) $ foldM next [] [1..5]
solutions :: [Solution]
solutions = filter finalCheck . map reverse $ foldM next [] [1..5]
where
next xs pos = [x:xs | x <- iterHouse xs, and $ checks pos x]
-- NOTE: list of houses is generated in reversed order
next :: Solution -> Int -> [Solution]
next sol pos = [h:sol | h <- newHouses sol, consistent h pos]
iterHouse :: [House] -> [House]
iterHouse xs =
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 getter = [minBound ..] \\ map getter xs
new trait = [minBound ..] \\ map trait sol -- :: [<Trait>]
-- immediate checks
checks :: Int -> House -> [Bool]
checks pos house =
[ 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
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
p <=> q = p house == q house -- both True or both False
-- final checks
postChecks :: [House] -> [Bool]
postChecks houses =
-- NOTE: list of houses is generated in reversed order
[ [White, Green] `isInfixOf` map color houses -- 5
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
@ -79,12 +85,7 @@ postChecks houses =
]
where
nextTo :: (House -> Bool) -> (House -> Bool) -> Bool
nextTo p q
| (_:x:_) <- dropWhile (not . match) houses = match x
| otherwise = False
where
match x = p x || q x
is :: Eq a => (House -> a) -> a -> House -> Bool
getter `is` value = (== value) . getter
nextTo p q = leftOf p q || leftOf q p
leftOf p q
| (_:h:_) <- dropWhile (not . p) solution = q h
| otherwise = False

View file

@ -0,0 +1,114 @@
// version 1.1.3
fun nextPerm(perm: IntArray): Boolean {
val size = perm.size
var k = -1
for (i in size - 2 downTo 0) {
if (perm[i] < perm[i + 1]) {
k = i
break
}
}
if (k == -1) return false // last permutation
for (l in size - 1 downTo k) {
if (perm[k] < perm[l]) {
val temp = perm[k]
perm[k] = perm[l]
perm[l] = temp
var m = k + 1
var n = size - 1
while (m < n) {
val temp2 = perm[m]
perm[m++] = perm[n]
perm[n--] = temp2
}
break
}
}
return true
}
fun check(a1: Int, a2: Int, v1: Int, v2: Int): Boolean {
for (i in 0..4)
if (p[a1][i] == v1) return p[a2][i] == v2
return false
}
fun checkLeft(a1: Int, a2: Int, v1: Int, v2: Int): Boolean {
for (i in 0..3)
if (p[a1][i] == v1) return p[a2][i + 1] == v2
return false
}
fun checkRight(a1: Int, a2: Int, v1: Int, v2: Int): Boolean {
for (i in 1..4)
if (p[a1][i] == v1) return p[a2][i - 1] == v2
return false
}
fun checkAdjacent(a1: Int, a2: Int, v1: Int, v2: Int): Boolean {
return checkLeft(a1, a2, v1, v2) || checkRight(a1, a2, v1, v2)
}
val colors = listOf("Red", "Green", "White", "Yellow", "Blue")
val nations = listOf("English", "Swede", "Danish", "Norwegian", "German")
val animals = listOf("Dog", "Birds", "Cats", "Horse", "Zebra")
val drinks = listOf("Tea", "Coffee", "Milk", "Beer", "Water")
val smokes = listOf("Pall Mall", "Dunhill", "Blend", "Blue Master", "Prince")
val p = Array(120) { IntArray(5) { -1 } } // stores all permutations of numbers 0..4
fun fillHouses(): Int {
var solutions = 0
for (c in 0..119) {
if (!checkLeft(c, c, 1, 2)) continue // C5 : Green left of white
for (n in 0..119) {
if (p[n][0] != 3) continue // C10: Norwegian in First
if (!check(n, c, 0, 0)) continue // C2 : English in Red
if (!checkAdjacent(n, c, 3, 4)) continue // C15: Norwegian next to Blue
for (a in 0..119) {
if (!check(a, n, 0, 1)) continue // C3 : Swede has Dog
for (d in 0..119) {
if (p[d][2] != 2) continue // C9 : Middle drinks Milk
if (!check(d, n, 0, 2)) continue // C4 : Dane drinks Tea
if (!check(d, c, 1, 1)) continue // C6 : Green drinks Coffee
for (s in 0..119) {
if (!check(s, a, 0, 1)) continue // C7 : Pall Mall has Birds
if (!check(s, c, 1, 3)) continue // C8 : Yellow smokes Dunhill
if (!check(s, d, 3, 3)) continue // C13: Blue Master drinks Beer
if (!check(s, n, 4, 4)) continue // C14: German smokes Prince
if (!checkAdjacent(s, a, 2, 2)) continue // C11: Blend next to Cats
if (!checkAdjacent(s, a, 1, 3)) continue // C12: Dunhill next to Horse
if (!checkAdjacent(s, d, 2, 4)) continue // C16: Blend next to Water
solutions++
printHouses(c, n, a, d, s)
}
}
}
}
}
return solutions
}
fun printHouses(c: Int, n: Int, a: Int, d: Int, s: Int) {
var owner: String = ""
println("House Color Nation Animal Drink Smokes")
println("===== ====== ========= ====== ====== ===========")
for (i in 0..4) {
val f = "%3d %-6s %-9s %-6s %-6s %-11s\n"
System.out.printf(f, i + 1, colors[p[c][i]], nations[p[n][i]], animals[p[a][i]], drinks[p[d][i]], smokes[p[s][i]])
if (animals[p[a][i]] == "Zebra") owner = nations[p[n][i]]
}
println("\nThe $owner owns the Zebra\n")
}
fun main(args: Array<String>) {
val perm = IntArray(5) { it }
for (i in 0..119) {
for (j in 0..4) p[i][j] = perm[j]
nextPerm(perm)
}
val solutions = fillHouses()
val plural = if (solutions == 1) "" else "s"
println("$solutions solution$plural found")
}

View file

@ -1,32 +1,30 @@
zebra( Z, HS):-
length( HS, 5),
member( H1, HS), nation(H1, eng), color(H1, red),
member( H2, HS), nation(H2, swe), owns( H2, dog),
member( H3, HS), nation(H3, dane), drink(H3, tea),
left_of(A,B, HS), color( A, green), color( B, white),
member( H4, HS), drink( H4, coffee), color(H4, green),
member( H5, HS), smoke( H5, palmal), owns( H5, birds),
member( H6, HS), color( H6, yellow), smoke(H6, dunhill),
middle( C, HS), drink( C, milk),
first( D, HS), nation( D, norweg),
next_to(E,F, HS), smoke( E, blend), owns( F, cats),
next_to(G,H, HS), owns( G, horse), smoke( H, dunhill),
member( H7, HS), smoke( H7, bluemas), drink(H7, beer),
member( H8, HS), nation(H8, german), smoke(H8, prince),
next_to(I,J, HS), nation( I, norweg), color( J, blue),
next_to(V,W, HS), drink( W, water), smoke( V, blend),
member( X, HS), owns( X, zebra), nation(X, Z).
% register unique attribute names from rules
attrs(H,[N-V|R]):- memberchk( N-X, H), X=V, (R=[] -> true ; attrs(H,R)).
left_of( A, B, HS):- append( _, [A,B|_], HS).
next_to( A, B, HS):- left_of( A, B, HS) ; left_of( B, A, HS).
middle( A, [_,_,A,_,_]).
first( A, [A|_]).
in(HS,Attrs) :- member(H,HS), attrs(H,Attrs).
in(HS,G,AttrsL):- call(G,Args,HS), maplist(attrs,Args,AttrsL).
attr( House, Name-Value):-
memberchk( Name-X, House), % unique attribute names
X = Value. % set, validate, or reject
nation(H, V):- attr( H, nation-V).
owns( H, V):- attr( H, owns-V). % select an attribute
smoke( H, V):- attr( H, smoke-V). % from an extensible record
color( H, V):- attr( H, color-V). % of house attributes
drink( H, V):- attr( H, drink-V). % which *is* a house
left_of([A,B],HS):- append(_,[A,B|_],HS).
next_to([A,B],HS):- left_of([A,B],HS) ; left_of([B,A],HS).
zebra(Owner,Houses):-
Houses = [A,_,C,_,_], % 1
maplist( in(Houses), [ [ nation-englishman, color-red ] % 2
, [ nation-swede, owns -dog ] % 3
, [ nation-dane, drink-tea ] % 4
, [ drink -coffee, color-green ] % 6
, [ smoke -'Pall Mall', owns -birds ] % 7
, [ color -yellow, smoke-'Dunhill' ] % 8
, [ drink -beer, smoke-'Blue Master'] % 13
, [ nation-german, smoke-'Prince' ] % 14
] ),
in(Houses, left_of, [[color -green ], [color -white ]]), % 5
maplist( attrs, [C,A], [[drink -milk ], % 9
[nation-norwegian]]), % 10
maplist( in(Houses, next_to),
[ [[smoke -'Blend' ], [owns -cats ]] % 11
, [[owns -horse ], [smoke-'Dunhill' ]] % 12
, [[nation-norwegian], [color-blue ]] % 15
, [[drink -water ], [smoke-'Blend' ]] % 16
] ),
in(Houses, [owns-zebra, nation-Owner]).

View file

@ -1,32 +1,12 @@
attrs( R, [N-V|T]):- % extensible record, attribute specs
memberchk( N-X, R), % unique attribute names
X = V, % set, validate, or reject
( T = [] -> true ; attrs( R, T) ).
?- time(( zebra(Z,HS), (maplist(length,HS,_) -> maplist(sort,HS,S),
maplist(writeln,S),nl,writeln(Z)), false ; writeln('No More Solutions'))).
specs( P, Hs, [Spec1]) :- call(P, A, Hs), attrs(A, Spec1).
specs( P, Hs, [Spec1, Spec2]) :- call(P, A, B, Hs), attrs(A, Spec1), attrs(B, Spec2).
[color-yellow,drink-water, nation-norwegian, owns-cats, smoke-Dunhill ]
[color-blue, drink-tea, nation-dane, owns-horse, smoke-Blend ]
[color-red, drink-milk, nation-englishman,owns-birds, smoke-Pall Mall ]
[color-green, drink-coffee,nation-german, owns-zebra, smoke-Prince ]
[color-white, drink-beer, nation-swede, owns-dog, smoke-Blue Master]
left_of( A, B, HS):- append( _, [A,B|_], HS).
next_to( A, B, HS):- left_of( A, B, HS) ; left_of( B, A, HS).
zebra( Zebra, Houses):- % a house *is* a collection of attributes
Houses = [A,_,C,_,_], % 1
maplist( specs( member, Houses),
[ [[ nation-englishman, color-red ]] % 2
, [[ nation-swede, owns -dog ]] % 3
, [[ nation-dane, drink-tea ]] % 4
, [[ drink -coffee, color-green ]] % 6
, [[ smoke -'Pall Mall', owns -birds ]] % 7
, [[ color -yellow, smoke-'Dunhill' ]] % 8
, [[ drink -beer, smoke-'Blue Master']] % 13
, [[ nation-german, smoke-'Prince' ]] % 14
] ),
specs( left_of, Houses, [[color -green ], [color-white ]]), % 5
maplist( attrs, [A, C], [[nation-norwegian], [drink-milk ]]), % 10, 9
maplist( specs( next_to, Houses),
[ [[smoke -'Blend' ], [owns -cats ]] % 11
, [[owns -horse ], [smoke-'Dunhill' ]] % 12
, [[nation-norwegian], [color-blue ]] % 15
, [[drink -water ], [smoke-'Blend' ]] % 16
] ),
specs( member, Houses, [[ owns-zebra, nation-Zebra]]).
german
No More Solutions
% 250,927 inferences, 0.027 CPU in 0.027 seconds (100% CPU, 9240311 Lips)

View file

@ -1,12 +1,45 @@
?- time(( zebra(Z,HS), ( maplist(length,HS,_) -> maplist(sort,HS,S),
maplist(writeln,S), nl, writeln(Z) ), false ; true)).
:- initialization(main).
[color-yellow,drink-water, nation-norwegian, owns-cats, smoke-Dunhill ]
[color-blue, drink-tea, nation-dane, owns-horse, smoke-Blend ]
[color-red, drink-milk, nation-englishman,owns-birds, smoke-Pall Mall ]
[color-green, drink-coffee,nation-german, owns-zebra, smoke-Prince ]
[color-white, drink-beer, nation-swede, owns-dog, smoke-Blue Master]
german
% 202,730 inferences, 0.031 CPU in 0.031 seconds (100% CPU, 6497715 Lips)
true.
zebra(X) :-
houses(Hs), member(h(_,X,zebra,_,_), Hs)
, findall(_, (member(H,Hs), write(H), nl), _), nl
, write('the one who keeps zebra: '), write(X), nl
.
houses(Hs) :-
Hs = [_,_,_,_,_] % 1
, H3 = h(_,_,_,milk,_), Hs = [_,_,H3,_,_] % 9
, H1 = h(_,nvg,_,_,_ ), Hs = [H1|_] % 10
, maplist( flip(member,Hs),
[ h(red,eng,_,_,_) % 2
, h(_,swe,dog,_,_) % 3
, h(_,dan,_,tea,_) % 4
, h(green,_,_,coffe,_) % 6
, h(_,_,birds,_,pm) % 7
, h(yellow,_,_,_,dh) % 8
, h(_,_,_,beer,bm) % 13
, h(_,ger,_,_,pri) % 14
])
, infix([ h(green,_,_,_,_)
, h(white,_,_,_,_) ], Hs) % 5
, maplist( flip(nextto,Hs),
[ [h(_,_,_,_,bl ), h(_,_,cats,_,_)] % 11
, [h(_,_,horse,_,_), h(_,_,_,_,dh )] % 12
, [h(_,nvg,_,_,_ ), h(blue,_,_,_,_)] % 15
, [h(_,_,_,water,_), h(_,_,_,_,bl )] % 16
])
.
flip(F,X,Y) :- call(F,Y,X).
infix(Xs,Ys) :- append(Xs,_,Zs) , append(_,Zs,Ys).
nextto(P,Xs) :- permutation(P,R), infix(R,Xs).
main :- findall(_, (zebra(_), nl), _), halt.

View file

@ -1,45 +0,0 @@
:- initialization(main).
zebra(X) :-
houses(Hs), member(h(_,X,zebra,_,_), Hs)
, findall(_, (member(H,Hs), write(H), nl), _), nl
, write('the one who keeps zebra: '), write(X), nl
.
houses(Hs) :-
Hs = [_,_,_,_,_] % 1
, H3 = h(_,_,_,milk,_), Hs = [_,_,H3,_,_] % 9
, H1 = h(_,nvg,_,_,_ ), Hs = [H1|_] % 10
, maplist( flip(member,Hs),
[ h(red,eng,_,_,_) % 2
, h(_,swe,dog,_,_) % 3
, h(_,dan,_,tea,_) % 4
, h(green,_,_,coffe,_) % 6
, h(_,_,birds,_,pm) % 7
, h(yellow,_,_,_,dh) % 8
, h(_,_,_,beer,bm) % 13
, h(_,ger,_,_,pri) % 14
])
, infix([ h(green,_,_,_,_)
, h(white,_,_,_,_) ], Hs) % 5
, maplist( flip(nextto,Hs),
[ [h(_,_,_,_,bl ), h(_,_,cats,_,_)] % 11
, [h(_,_,horse,_,_), h(_,_,_,_,dh )] % 12
, [h(_,nvg,_,_,_ ), h(blue,_,_,_,_)] % 15
, [h(_,_,_,water,_), h(_,_,_,_,bl )] % 16
])
.
flip(F,X,Y) :- call(F,Y,X).
infix(Xs,Ys) :- append(Xs,_,Zs) , append(_,Zs,Ys).
nextto(P,Xs) :- permutation(P,R), infix(R,Xs).
main :- findall(_, (zebra(_), nl), _), halt.

View file

@ -67,7 +67,7 @@ object Einstein extends App {
// There *should* be just one solution...
solutions.foreach { solution =>
// so we can pretty-print, find out the maximum strength length of all cells
// so we can pretty-print, find out the maximum string length of all cells
val maxLen = solution.flatten.map(_.length).max
def pretty(str: String): String = str + (" " * (maxLen - str.length + 1))

View file

@ -20,19 +20,19 @@ func coincident(n,i,g,e) {
}
func solve {
CONTENT{:Nationality}.permutations{|nation|
CONTENT{:Nationality}.permutations{|*nation|
nation.first == :Norwegian ->
&& CONTENT{:Colour}.permutations {|colour|
&& CONTENT{:Colour}.permutations {|*colour|
leftof(colour,:Green,colour,:White) ->
&& coincident(nation,:English,colour,:Red) ->
&& adjacent(nation,:Norwegian,colour,:Blue) ->
&& CONTENT{:Pet}.permutations {|pet|
&& CONTENT{:Pet}.permutations {|*pet|
coincident(nation,:Swedish,pet,:Dog) ->
&& CONTENT{:Drink}.permutations {|drink|
&& CONTENT{:Drink}.permutations {|*drink|
drink[2] == :Milk ->
&& coincident(nation,:Danish,drink,:Tea) ->
&& coincident(colour,:Green,drink,:Coffee) ->
&& CONTENT{:Smoke}.permutations {|smoke|
&& CONTENT{:Smoke}.permutations {|*smoke|
coincident(smoke,:PallMall,pet,:Birds) ->
&& coincident(smoke,:Dunhill,colour,:Yellow) ->
&& coincident(smoke,:BlueMaster,drink,:Beer) ->

View file

@ -0,0 +1,61 @@
var people,drinks,houses,smokes,pets; // lists treated as associated arrays
fcn c2 { people.find(English)==houses.find(Red) }
fcn c3 { people.find(Swede)==pets.find(Dog) }
fcn c4 { people.find(Dane)==drinks.find(Tea) }
fcn c5 { (houses.find(Green) + 1)==houses.find(White) }
fcn c5a{ houses.find(Green)!=4 } // deduced constraint (from c5)
fcn c5b{ houses.find(White)!=0 } // deduced constraint (from c5)
fcn c6 { drinks.find(Coffee)==houses.find(Green) }
fcn c7 { smokes.find(PallMall)==pets.find(Bird) }
fcn c8 { houses.find(Yellow)==smokes.find(Dunhill) }
fcn c9 { drinks[2]==Milk } // 0,1,2,3,4
fcn c10{ people[0]==Norwegian }
fcn c11{ (smokes.find(Blend) - pets.find(Cat)).abs()==1 }
fcn c12{ (pets.find(Horse) - smokes.find(Dunhill)).abs()==1 }
fcn c13{ smokes.find(BlueMaster)==drinks.find(Beer) }
fcn c14{ people.find(German)==smokes.find(Prince) }
fcn c15{ (people.find(Norwegian) - houses.find(Blue)).abs()==1 }
fcn c16{ (drinks.find(Water) - smokes.find(Blend)).abs()==1 }
#<<<#//////////////////////////////////////////////////////////////////////
Showing a solution to c2,c5,c10,c15:
|0 1 2 3 4
--------+-------------------------------------------
houses: |Yellow Blue Red Green White
people: |Norwegian Dane English German Swede
#<<<#//////////////////////////////////////////////////////////////////////
const Blue =0,Green =1,Red =2,White =3,Yellow=4,
Dane =0,English =1,German =2,Norwegian=3,Swede =4,
Beer =0,Coffee =1,Milk =2,Tea =3,Water =4,
Blend=0,BlueMaster=1,Dunhill=2,PallMall =3,Prince=4,
Bird =0,Cat =1,Dog =2,Horse =3,Zebra =4;
perm5:=T(0,1,2,3,4) : Utils.Helpers.permute(_); // 120 sets
constraints:=T(c2,c3,c4,c5,c5a,c5b,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16);
constraints1:=T(c2,c5,c10,c15); // houses,people: 12 solutions
constraints2:=T(c4,c6,c9); // houses,people,drinks: down to 8 solutions
foreach _houses,_people in (perm5,perm5){ houses,people=_houses,_people;
if(not constraints1.runNFilter(False)){ // all constraints are True
foreach _drinks in (perm5){ drinks=_drinks;
if(not constraints2.runNFilter(False)){
foreach _smokes,_pets in (perm5,perm5){ smokes,pets=_smokes,_pets;
if(not constraints.runNFilter(False)) printSolution();
}// smokes,pets
}
} // drinks
} // houses,people
}
fcn printSolution{
var titles=T("Houses:","People:","Drinks:","Smokes:","Pets:"),
names=T(
T("Blue", "Green", "Red", "White", "Yellow",),
T("Dane", "English", "German", "Norwegian","Swede",),
T("Beer", "Coffee", "Milk", "Tea", "Water",),
T("Blend","Blue Master","Dunhill","Pall Mall","Prince",),
T("Bird", "Cat", "Dog", "Horse", "Zebra",) ),
;
fmt:=("%-7s " + "%-11s "*5).fmt;
foreach list,title,names in (T(houses,people,drinks,smokes,pets)
.zip(titles,names))
{ println(list.apply(names.get):fmt(title,_.xplode())) }
}