Rosetta Code task: Zebra puzzle: http://rosettacode.org/wiki/Zebra_puzzle
In what follows I show you a solution of this task that I can only
formulate as a kind of annealing until there exists a candidate street
which misses only one property. Probably I should extend the testing
with a test for 'is the missing property also an animal'. But for now
this works also.
I'm wondering if this is a solution worth to contribute to RC and what
kind of method is this in terms of algorithm.
BTW: At the end of this mail I'll show that this method also works for
another RC task: Dinesman's multiple-dwelling problem
Combining the propositions reveals: there is no proposition saying
something about the 'zebra'. That's why: who owns the zebra.
(nationalities;animals;drinks;colors;<smokes) -.&.><@(~.@;:@(;:
inv"1)) |: >"0 hss,cs,cr,lof,;next
┌┬───────┬┬┬┐
││┌─────┐││││
│││zebra│││││
││└─────┘││││
└┴───────┴┴┴┘
Solution.
;"0 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│
└─────────┴─────┴──────┴──────┴──────────┘
-->
The German owns the zebra.
Needs to solve the task.
========================
NB. properties
nationalities=: ;: 'Norwegian Dane Swede German English'
animals=: ;: 'zebra cats dog birds horse'
drinks=: ;: 'coffee beer milk tea water'
colors=: ;: 'yellow white red green blue'
smokes=: ;: 'PallMall Dunhill Blend BlueMaster Prince'
NB. propositions
cr=: (('English';'red') 0 3} 5$a:);<('Dane';'tea') 0 2}5$a:
cr=: cr, (('German';'Prince') 0 4}5$a:);<('Swede';'dog') 0 1 } 5$a:
cs=: <('PallMall';'birds') 4 1}5$a:
cs=: cs, (('yellow';'Dunhill') 3 4}5$a:);<('BlueMaster';'beer') 4 2}5$a:
lof=: (('coffee';'green')2 3} 5$a:);<(<'white')3}5$a:
next=: <((<'Blend') 4 } 5$a:);<(<'water')2}5$a:
next=:next,<((<'Blend') 4 } 5$a:);<(<'cats')1}5$a:
next=: next,<((<'Dunhill') 4} 5$a:);<(<'horse')1}5$a:
ehs=: 5$a:
NB. permutations, rotations and or swaps 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
houses=: ((<'Norwegian') 0}5$a:);((<'blue') 3 }5$a:);((<'milk')
2}5$a:);(5$a:);<5$a:
constraints=: hcr;hcs;hlof;<hnext
NB. helper verbs
select=: 4 :0
if. 0=#x do. y return. end.
if. 0=#y do. x return. end.
if. x -: y do. x return. end.
x ,:y
)
filter=: #~*./@:(1=#@$S:0)"1
compose=: [: filter [: ,/ select L:0"1"1 _
NB. Solver
solve=: 4 :0
h=. ,:x
whilst. 0=# z=.a:(]#~1=+/@:(=;)"1) h do.
for_e. y do. h=. h compose > e end.
h=.~. h
end.
z
)
The same method applied to another Rosetta Code Task:
http://rosettacode.org/wiki/Dinesman%27s_multiple-dwelling_problem
(5$a:)solveDMD2 p0;p1;p2;p3;p4;<p5
┌─────┬──────┬─────┬────────┬──────┐
│Smith│Cooper│Baker│Fletcher│Miller│
└─────┴──────┴─────┴────────┴──────┘
NB. proposition variants
p0=: a:,.~ (i.4) |."0 1 a:,a:,a:,<'Baker'
p1=: a:,. (i.4) |."0 1 a:,a:,a:,<'Cooper'
p2=: a:,. a:,.~(i.3) |."0 1 a:,a:,<'Fletcher'
p3=: ; 1 2 3 4 <@({.,"1(|."0 1~ -@i.@#)@}.)"_1 (-i.4)|."0 1
'Cooper';'Miller';a:,a:,a:
p4=: ({:,((-i.2)|."0 1 ])@{.) ('Smith';a:),"1 (-i.2)|."0 1 'Fletcher';a:,a:
p4=: p4,({:,((-i.2)|."0 1 ])@{.)(a:,<'Fletcher'),"1 a:,.(-i.2)|."0 1
'Smith';a:
p5=: ,:a:,'Fletcher';a:,'Cooper';a:
p5=: p5, a:,'Fletcher';a:,a:,<'Cooper'
p5=: p5, (,(_1&|.)@{.)('Cooper';a:),"1(,:_1&|.) 'Fletcher';a:,a:
solveDMD2=: 4 :0
h=. ,:x
whilst. -. th -: h do.
for_e. y do. h=. h compose > e end. [th=. h
h =. ~. h
end.
)
--
Met vriendelijke groet,
@@i = Arie Groeneveld
----------------------------------------------------------------------
For information about J forums see http://www.jsoftware.com/forums.htm
