fork(1) download
copy 
  1. :- set_prolog_flag(verbose,normal).
  2.  
  3. % register unique attribute names from rules
  4. attrs(H,[N-V|R]):- memberchk( N-X, H), X=V, (R=[] -> true ; attrs(H,R)).
  5.  
  6. in(HS,Attrs)  :- member(H,HS), attrs(H,Attrs).
  7. in(HS,G,AttrsL):- call(G,Args,HS), maplist(attrs,Args,AttrsL).
  8.  
  9. left_of([A,B],HS):- append(_,[A,B|_],HS).
  10. next_to([A,B],HS):- left_of([A,B],HS) ; left_of([B,A],HS).
  11.  
  12. zebra(Owner,Houses):-
  13.     Houses = [A,_,C,_,_],                                               % 1
  14.     maplist( in(Houses), [ [ nation-englishman,   color-red          ]  % 2
  15.                          , [ nation-swede,        owns -dog          ]  % 3
  16.                          , [ nation-dane,         drink-tea          ]  % 4
  17.                          , [ drink -coffee,       color-green        ]  % 6
  18.                          , [ smoke -'Pall Mall',  owns -birds        ]  % 7
  19.                          , [ color -yellow,       smoke-'Dunhill'    ]  % 8
  20.                          , [ drink -beer,         smoke-'Blue Master']  % 13
  21.                          , [ nation-german,       smoke-'Prince'     ]  % 14
  22.                          ] ),
  23.     in(Houses, left_of,    [[color -green    ],  [color -white    ]]),  % 5
  24.     maplist( attrs, [C,A], [[drink -milk     ],                         % 9
  25.                             [nation-norwegian]]),                       % 10
  26.     maplist( in(Houses, next_to),  
  27.                          [ [[smoke -'Blend'  ],  [owns -cats      ]]    % 11
  28.                          , [[owns  -horse    ],  [smoke-'Dunhill' ]]    % 12
  29.                          , [[nation-norwegian],  [color-blue      ]]    % 15
  30.                          , [[drink -water    ],  [smoke-'Blend'   ]]    % 16
  31.                          ] ),
  32.     in(Houses, [owns-zebra, nation-Owner]).
  33.  
  34. :- time(( zebra(Z,HS), (maplist(length,HS,_) -> maplist(sort,HS,S),
  35.                            maplist(writeln,S),nl,writeln(Z))
  36.                      , false 
  37.           ; writeln('No More Solutions'))).
Success #stdin #stdout #stderr 0.05s 30840KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
[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
No More Solutions
stderr
copy 
% 250,927 inferences, 0.029 CPU in 0.029 seconds (99% CPU, 8797123 Lips)
ERROR: '$runtoplevel'/0: Undefined procedure: program/0
   Exception: (3) program ? EOF: exit
https://ideone.com/wcwXfZ
Zebra puzzle at RosettaCode -- traits discovery from rules
language:
Prolog (swi 7.6.4)
created:
6 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!