Zebra puzzle: Difference between revisions

{{task|Puzzles}}

[[Category:CHR]]

:#   The green house is immediately to the left of the white house.

:#   They drink coffee in the green house.

:#   In the yellow house they smoke Dunhill.

:#   In the middle house they drink milk.

:#   The Norwegian lives in the first house.

:#   The man who smokes Blue Master drinks beer.

:#   The German smokes Prince.

:#   They drink water in a house next to the house where they smoke Blend.

 

 

Additionally, list the solution for all the houses.

=={{header|Ada}}==

Not the prettiest Ada, but it's simple and very fast. Similar to my Dinesman's code; uses enums to keep things readable.

procedure Zebra is

type Content is (Beer, Coffee, Milk, Tea, Water,

end loop; end loop;

Solve (myAlley, 0, 5); -- start at test 0 with 5 options

{{out}}

<pre>ONE: DRINK=WATER PERSON=NORWEGIAN COLOR=YELLOW SMOKE=DUNHILL PET=CAT

=={{header|ALGOL 68}}==

Attempts to find solutions using the rules.

# attempt to solve Einstein's Riddle - the Zebra puzzle #

INT unknown = 0, same = -1;

print( ( "solutions: ", whole( solutions, 0 ), newline ) )

END

{{out}}

<pre>

solutions: 1

</pre>

 

=={{header|AutoHotkey}}==

=={{header|BBC BASIC}}==

{{works with|BBC BASIC for Windows}}

DIM Drink$(4), Nation$(4), Colr$(4), Smoke$(4), Animal$(4)

Drink$() = "Beer", "Coffee", "Milk", "Tea", "Water"

j% -= 1

ENDWHILE

'''Output:'''

<pre>

 

=={{header|Bracmat}}==

(red green white yellow blue,(red.English.))

(dog birds cats horse zebra,(dog.?.Swede.))

& props$(!properties...)

& done

Output:

<pre> Solution

 

=={{header|C}}==

#include <string.h>

 

 

return 0;

{{out}}

<pre>% gcc -Wall -O3 -std=c99 zebra.c -o zebra && time ./zebra

 

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.

 

use utf8;

 

# write C code. If it's ugly to you: I didn't write; Perl did.

output (ran as <code>perl test.pl | gcc -Wall -x c -; ./a.out</code>):<pre>

0 dunhill cats yellow water Norske

<!-- By Martin Freedman, 17/01/2018 -->

This is adapted from a solution to a similar problem by Peter Norvig in his [https://www.udacity.com/course/design-of-computer-programs--cs212 Udacity course CS212], originally written in Python. This is translated from [https://github.com/exercism/python/blob/master/exercises/zebra-puzzle/example.py example python solution on exercism]. This is a Generate-and-Prune Constraint Programming algorithm written with Linq. (See Benchmarks below)

using System.Collections.Generic;

using System.Linq;

Read();

}

Produces:

<pre>

 

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.Collections.Generic;

using System.Linq;

}

}

Produces

<pre>The zebra owner is German

{{works with|C sharp|C#|7.1}}

<!-- By Martin Freedman, 9/02/2018 -->

using System;

using System.Collections.Generic;

Read();

}

Produces

<pre>The zebra owner is German

{{libheader|Microsoft Solver Foundation}}

<!-- By Martin Freedman, 19/01/2018 based on MS example code-->

using System.Collections.Generic;

using System.Linq;

Read();

}

Produces:

<pre>

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>

return 0;

}

{{out}}

<pre>

=={{header|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 [http://github.com/swannodette/logic-tutorial Swannodette's logic tutorial], adapted to the problem statement here.

(:refer-clojure :exclude [==])

(:use [clojure.core.logic]

(println "full solution (in house order):")

(doseq [h soln] (println " " h)))

{{output}}

<pre>solution count: 1

This is adapted from a solution to a similar problem by Peter Norvig in his [https://www.udacity.com/course/design-of-computer-programs--cs212 Udacity course CS212], originally written in Python but equally applicable in any language with for-comprehensions.

 

(:require [clojure.math.combinatorics :as c]))

 

(println (apply format "%5s %-11s %-7s %-7s %-12s %-6s"

(map #(% i) (cons inc solution)))))))

{{output}}

<pre>user=> (time (zebra/-main))

=={{header|Crystal}}==

{{trans|Ruby}}

Nationality: %i[English Swedish Danish Norwegian German],

Colour: %i[Red Green White Blue Yellow],

end

 

 

=={{header|Curry}}==

{{Works with|PAKCS}}

import Findall (findall)

 

 

 

{{Output}} Using [http://www-ps.informatik.uni-kiel.de/~pakcs/webpakcs/main.cgi web interface].

<pre>Execution time: 180 msec. / elapsed: 180 msec.

{{trans|Ada}}

Most foreach loops in this program are static.

 

enum Content { Beer, Coffee, Milk, Tea, Water,

 

solve(M, Test.Drink, 5);

{{out}}

<pre> One: Water Norwegian Yellow Dunhill Cat

{{trans|Python}}

This requires the module of the first D entry from the Permutations Task.

 

uint factorial(in uint n) pure nothrow @nogc @safe

writeln;

}

{{out}}

<pre>Found a solution:

{{trans|PicoLisp}}

This requires the module of the second D entry from the Permutations Task.

import std.stdio, std.algorithm, permutations2;

 

nextTo(drinks, Water, smokes, Blend))

writefln("%(%10s\n%)\n", [houses, persons, drinks, pets, smokes]);

{{out}}

<pre>[ Yellow, Blue, Red, Green, White]

=={{header|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)

(amb-fail) ;; will ensure ALL solutions are printed

)

{{out}}

(define (task)

(amb-run zebra-puzzle (amb-make-context) (iota 5)))

→ #f

 

 

=={{header|Elixir}}==

{{trans|Ruby}}

defp adjacent?(n,i,g,e) do

Enum.any?(0..3, fn x ->

Smoke: ~w[PallMall Dunhill BlueMaster Prince Blend]a ]

 

 

{{out}}

=={{header|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 ).

 

is_rule_16_ok( _House1, _House2, _House3, #house{drink=water}, #house{smoke=blend} ) -> true;

is_rule_16_ok( _House1, _House2, _House3, _House4, _House5 ) -> false.

{{out}}

<pre>

 

=={{header|ERRE}}==

PROGRAM ZEBRA_PUZZLE

 

PRINT("Number of solutions=";SOLUTIONS%)

PRINT("Solved in ";TIMER-T1;" seconds")

{{out}}

<pre>

=={{header|F_Sharp|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 *)

|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"

{{out}}

<pre>

 

=={{header|FormulaOne}}==

// First, let's give some type-variables some values:

Nationality = Englishman | Swede | Dane | Norwegian | German

house_order(house1) = neighbour1 & house_order(house2) = neighbour2 &

house1 = house2 - 1

{{out}}

<pre>

 

=={{header|GAP}}==

local i;

for i in [1..4] do

Print(cigars,"\n");

od;od;od;od;od;

 

=={{header|Go}}==

 

import (

fmt.Println(n, "solution found")

fmt.Println(sol)

{{out}}

<pre>Generated 51 valid houses

 

=={{header|Haskell}}==

 

import Control.Applicative ((<$>), (<*>))

leftOf p q

| (_:h:_) <- dropWhile (not . p) solution = q h

{{out}}

<pre>House {color = Yellow, man = Nor, pet = Cats, drink = Water, smoke = Dunhill}

(a little faster version)

 

import Data.List

 

print [nation | (nation, _, Zebra, _, _) <- answer]

putStrLn "" )

 

Output:

 

Propositions 1 .. 16 without 9,10 and15

 

cr=: (('English';'red') 0 3} ehs);<('Dane';'tea') 0 2}ehs

next=: <((<'Blend') 4 }ehs);<(<'water')2}ehs

next=: next,<((<'Blend') 4 }ehs);<(<'cats')1}ehs

'''Example'''

┌─────────────────┬───────────┐

│┌┬┬──────┬─────┬┐│┌┬┬┬─────┬┐│

││││coffee│green│││││││white│││

│└┴┴──────┴─────┴┘│└┴┴┴─────┴┘│

 

Collections of all variants of the propositions:

hcs=:~. (A.~i.@!@#)cs,2$<ehs

hlof=:(-i.4) |."0 1 lof,3$<ehs

 

We start the row of houses with fixed properties 9, 10 and 15.

{{out}}

┌───────────────┬──────────┬──────────┬──────┬──────┐

│┌─────────┬┬┬┬┐│┌┬┬┬────┬┐│┌┬┬────┬┬┐│┌┬┬┬┬┐│┌┬┬┬┬┐│

││Norwegian││││││││││blue││││││milk││││││││││││││││││

│└─────────┴┴┴┴┘│└┴┴┴────┴┘│└┴┴────┴┴┘│└┴┴┴┴┘│└┴┴┴┴┘│

Set of proposition variants:

The worker and its helper verbs

filter=: #~*./@:(2>#S:0)"1

compose=: [: filter f. [: ,/ select f. L:0"1"1 _

z=.(#~1=[:+/"1 (0=#)S:0"1) h=.~. h

end.

{{out}}

┌─────────┬─────┬──────┬──────┬──────────┐

│Norwegian│cats │water │yellow│Dunhill │

├─────────┼─────┼──────┼──────┼──────────┤

│Swede │dog │beer │white │BlueMaster│

So, the German owns the zebra.

 

'''Alternative'''

<br>A longer running solver by adding the zebra variants.

 

solve3=: 4 :0

z=. f^:(3>[:#(#~p"1)&>)^:_ <,:x

>"0 (#~([:*./[:;[:<@({.~:}.)\.;)"1)(#~p"1); z

{{out}}

┌─────────┬─────┬──────┬──────┬──────────┐

│Norwegian│cats │water │yellow│Dunhill │

├─────────┼─────┼──────┼──────┼──────────┤

│Swede │dog │beer │white │BlueMaster│

 

=={{header|Java}}==

* The Solver

 

 

import java.util.Arrays;

}

}

{{out}}

<pre>

 

'''Part 1''': Generic filters for unification and matching

# Attempt to unify the input object with the specified object

def unify( object ):

| if $ans then .[i] = $ans else empty end

else empty

'''Part 2''': Zebra Puzzle

# { "number": _, "nation": _, "owns": _, "color": _, "drinks": _, "smokes": _}

 

;

{{Out}}

<div style="overflow:scroll; height:400px;">

[

{

real 0m0.284s

user 0m0.260s

 

=={{header|Julia}}==

 

# Julia 1.0

using Combinatorics

end

 

{{out}}

===Constraint Programming Version===

Using the rules from https://github.com/SWI-Prolog/bench/blob/master/zebra.pl

using JuMP

using GLPK

drinks=getindex.(m, 4),

smokes=getindex.(m, 5))

 

{{out}}

 

=={{header|Kotlin}}==

 

fun nextPerm(perm: IntArray): Boolean {

val plural = if (solutions == 1) "" else "s"

println("$solutions solution$plural found")

 

{{out}}

The Logtalk distribution includes a solution for a variant of this puzzle (here reproduced with permission):

 

/* Houses logical puzzle: who owns the zebra and who drinks water?

 

 

:- end_object.

 

Sample query:

| ?- houses::(houses(S), print(S)).

h(norwegian,fox,kool,water,yellow)

 

S = [h(norwegian,fox,kool,water,yellow),h(ukrainian,horse,chesterfield,tea,blue),h(english,snake,winston,milk,red),h(japonese,zebra,kent,coffee,green),h(spanish,dog,lucky,juice,white)]

 

This creates a table that has 5 columns, and 25 rows. We fill the table; each column is the same and equal to all the options joined together in blocks of 5:

<pre> 1 2 3 4 5

This should be read as follows: Each column shows (in blocks of 5) the possible candidates of each kind (beverage, animal, smoke...)

We solve it now in a 'sudoku' way: We remove candidates iteratively until we are left with 1 candidate of each kind for each house.

EliminatePoss[ct_, key1_, key2_] := Module[{t = ct, poss1, poss2, poss, notposs},

poss1 = Position[t, key1];

 

bigtable = FixedPoint[FilterPuzzle, bigtable];

Using the command FixedPoint, we iteratively filter out these candidates, until we are (hopefully) left with 1 candidate per kind per house.

{{out}}

5 White Swede Beer Dog Blue Master</pre>

 

=={{header|MiniZinc}}==

%Solve Zebra Puzzle. Nigel Galloway, August 27th., 2019

include "alldifferent.mzn";

solve satisfy;

output ["The "++show(Nz[n])++" owns the zebra"++"\n\n"++show(Nz)++"\n"++show(Iz)++"\n"++show(Gz)++"\n"++show(Ez)++"\n"++show(Lz)++"\n"];

{{out}}

<pre>

be pasted into the REPL.

 

remove is op x xs {filter (not (x =)) xs}

 

 

abs(time - (run; time))

 

{{out}}

Using the same order for test of criteria as in Kotlin solution.

 

 

type

 

let owner = sol.filterIt(it.pet == Zebra)[0].person

 

{{out}}

The German owns the zebra.</pre>

 

perm(arr) = {

n=#arr;i=n-1;

for(i=1,5,printf("House:%s %6s %10s %10s %10s %10s\n",i,colors[c][i],nations[n][i],pets[p][i],drinks[d][i],smokes[s][i]));\

)))))))));

 

{{out}}

=={{header|Perl}}==

Basically the same idea as C, though of course it's much easier to have Perl generate Perl code.

 

use utf8;

pair qw( water blend -1 1 );

 

 

Incidentally, the same logic can be used to solve the dwelling problem, if somewhat awkwardly:

# property names and values

setprops

pair qw(cooper fletcher 4 3 2 -2 -3 -4);

 

 

=={{header|Phix}}==

{{out}}

<pre>

The German owns the Zebra

</pre>

 

=={{header|PicoLisp}}==

(permute (red blue green yellow white) @House)

(left-of @House white @House green)

 

(be next-to (@X @A @Y @B) (right-of @X @A @Y @B))

Test:

(let Fmt (-8 -11 -8 -7 -11)

(tab Fmt "HOUSE" "PERSON" "DRINKS" "HAS" "SMOKES")

(mapc '(@ (pass tab Fmt))

Output:

<pre>HOUSE PERSON DRINKS HAS SMOKES

In Prolog we can specify the domain by selecting elements from it, making mutually exclusive choices for efficiency:

 

select([],_).

 

:- ?- time(( zebra(Who, HS), maplist(writeln,HS), nl, write(Who), nl, nl, fail

 

Output:

Using extensible records, letting the houses' attributes be discovered from rules, ''not'' predetermined by a programmer (as any ''"a house has five attributes"'' solution is doing).

 

attrs( H, [N-V | R]) :- !, memberchk( N-X, H), X = V, (R = [], ! ; attrs( H, R)).

attrs( HS, AttrsL) :- maplist( attrs, HS, AttrsL).

, [[drink -water ], [smoke-'Blend' ]] % 16

] ),

[http://ideone.com/wcwXfZ Output]:

maplist(writeln,S),nl,writeln(Z)), false ; writeln('No More Solutions'))).

german

No More Solutions

 

===Alternative version===

{{Works with|GNU Prolog}}

{{Works with|SWI Prolog}}

 

 

 

main :- findall(_, (zebra(_), nl), _), halt.

{{Output}}

<pre>h(yellow,nvg,cats,water,dh)

{{Works with|SWI Prolog}}

Original source code is 'ECLiPSe ( http://eclipseclp.org/ )' example: http://eclipseclp.org/examples/zebra.ecl.txt

 

zebra :-

format(Fmt, PetNames),

format(Fmt, DrinkNames).

{{Output}}

<pre>

{{trans|Clojure}}

Using 'logpy': https://github.com/logpy/logpy

from logpy import *

from logpy.core import lall

for line in solutions[0]:

print str(line)

 

===Alternative Version===

{{trans|D}}

 

class Content: elems= """Beer Coffee Milk Tea Water

solve(M, Test.Drink, 5)

 

{{out}}

<pre> One: Water Norwegian Yellow Dunhill Cat

Runtime about 0.18 seconds.

===Alternative Version===

 

class Number:elems= "One Two Three Four Five".split()

print

 

Output:

<pre>Found a solution:

Using 'python-constraint': http://labix.org/python-constraint,

Original source code is 'ECLiPSe ( http://eclipseclp.org/ )' example: http://eclipseclp.org/examples/zebra.ecl.txt

 

 

 

# add variables: house numbers 1 to 5

 

# add constraint: the values in each list are exclusive

 

# add constraint: actual constraints

 

# get solution

 

# print the answers

Output:

 

=={{header|R}}==

 

library(combinat)

}

{{out}}

<pre>

{{trans|Prolog}}

 

 

(require racklog)

(%member (list (_) Owns 'zebra (_) (_)) HS)]))

 

 

Output:

(formerly Perl 6)

A rule driven approach:

 

my @facts = (

for gather solve(@houses, @facts) {

#-- output

for .list;

last; # stop after first solution

}

 

multi sub solve(@solution, @facts [ ]) {

take @solution;

}

 

}

}

 

#| find all possible solutions for pairs of houses with

}

}

}

 

}

 

}

}

 

#| plausible if doesn't conflict with anything

}

{{out}}

<pre>

{{trans|BBC BASIC}}

Permutations algorithm taken from REXX

* Solve the Zebra Puzzle

*--------------------------------------------------------------------*/

out:

Say arg(1)

{{out}}

<pre>House Drink Nation Colour Smoke Animal

 

=={{header|Ruby}}==

Nationality: %i[English Swedish Danish Norwegian German],

Colour: %i[Red Green White Blue Yellow],

end

 

 

{{out}}

 

===Another approach===

class String; def brk; split(/(?=[A-Z])/); end; end

men,drinks,colors,pets,smokes = "NorwegianGermanDaneSwedeEnglish

puts "The #{x.find{|y|y[0]=="Zebra"}[1]} owns the zebra.",

x.map{|y| y.map{|z| z.ljust(11)}.join}}}}}}

Output:

<pre>

=={{header|Scala}}==

===Idiomatic (for comprehension)===

*

* It can further concluded that:

members.foreach(solution => solution.zipWithIndex.foreach(h => println(s"House ${h._2 + 1} ${h._1}")))

}

{{Out}}See it in running in your browser by [https://scalafiddle.io/sf/h5Y98te/0 ScalaFiddle (JavaScript executed in browser)] or by [https://scastie.scala-lang.org/fJZRog4xQ9aAV4D3crM1gQ Scastie (remote JVM)].{{out}}

<pre> The German is the owner of the zebra.

 

===Scala Alternate Version (Over-engineered)===

 

object Einstein extends App {

}

 

{{Out}}Experience running it in your browser by [https://scalafiddle.io/sf/hJgtjYG/1 ScalaFiddle (JavaScript executed in browser)] or by [https://scastie.scala-lang.org/ajeuRgDSQKyVv4Jd6SPfVQ Scastie (remote JVM)].

{{out}}

=={{header|Sidef}}==

{{trans|Ruby}}

:House => nil,

:Nationality => [:English, :Swedish, :Danish, :Norwegian, :German],

say "The Zebra is owned by the man who is #{res[0][res[2].first_index(:Zebra)]}\n"

say (fmt % keys..., "\n", fmt % width.map{|w| "-"*w }...)

{{out}}

<pre>

{{works with|SML/NJ}}

{{trans|C++}}(This implementation uses the search algorithm of the C++ implementation, but the rules check algorithm is different.)

(* Attributes and values *)

val str_attributes = Vector.fromList ["Color", "Nation", "Drink", "Pet", "Smoke"]

else print "No solution found!\n"

end

 

{{out}}

===General solver with relational algebra===

A general solver for this type of puzzle, using relational algebra. This solver can also be used for "Dinesman's multiple-dwelling problem"

@: [{|{}|}]; // A list of possible relations, start with one relation with an empty tuple

$ -> \(

 

operator (a nextTo&{byField:, bMinusA:} b)

@EinsteinSolver: [$@EinsteinSolver... -> \(

def in: $;

def numbers: [$temp({ES_temp__:})... -> $.ES_temp__];

$numbers... -> \(

def aNumber: $;

def new: ($temp matching {| {$a, ES_temp__: $aNumber} |});

@: ($new union (($temp notMatching {| $a |}) notMatching {| {ES_temp__: $aNumber} |}));

'No more solutions

' -> !OUT::write

 

{{out}}

{{trans|C#}}

The streaming syntax of Tailspin lends itself naturally to this solution

templates permutations

when <=1> do [1] !

-> \[i]('$i;: $;'! \) -> '$... -> '$;$#10;';$#10;'

-> !OUT::write

{{out}}

<pre>

=={{header|Tcl}}==

{{trans|Python}}

 

# Implements the constants by binding them directly into the named procedures.

 

initConstants isPossible

{{out}}

<pre>

=={{header|VBA}}==

{{trans|Phix}}

Public Enum attr

Colour = 1

Debug.Print "The " & Nationalities(perm(Nationality)(house(Pet, Zebra))) & " owns the Zebra"

Next i

<pre>1: yellow Norwegian water Dunhill cats

2: blue Dane tea Blend horse

1 solution found

The German owns the Zebra</pre>

 

=={{header|Wren}}==

{{trans|Kotlin}}

{{libheader|Wren-fmt}}

 

var colors = ["Red", "Green", "White", "Yellow", "Blue"]

var solutions = fillHouses.call()

var plural = (solutions == 1) ? "" : "s"

 

{{out}}

 

Lists are used as associated arrays rather than hash tables. With only five entries, it doesn't really matter.

fcn c2 { people.find(English)==houses.find(Red) }

fcn c3 { people.find(Swede)==pets.find(Dog) }

.zip(titles,names))

{ println(list.apply(names.get):fmt(title,_.xplode())) }

{{out}}

<pre>