Rosetta Code

Zebra puzzle: Difference between revisions

← Older editNewer edit →
Content deleted Content added
→‎{{header|Perl 6}}: a bit more gather/take
Line 4,887:
 
my @facts = (
{ :nat<englishEnglish>, :color<red> }, # 2 The English man lives in the red house.
{ :nat<swedeSwede>, :pet<dog> }, # 3 The Swede has a dog.
{ :nat<daneDane>, :drink<tea> }, # 4 The Dane drinks tea.
{ :color<green>, :leftLeft-ofOf(:color<white>) }, # 5 the green house is immediately to the left of the white house
{ :drink<coffee>, :color<green> }, # 6 They drink coffee in the green house.
{ :smoke<pallPall-mallMall>, :pet<birds> }, # 7 The man who smokes Pall Mall has birds.
{ :color<yellow>, :smoke<dunhillDunhill> }, # 8 In the yellow house they smoke Dunhill.
{ :num(3), :drink<milk> }, # 9 In the middle house they drink milk.
{ :num(1), :nat<norwegianNorwegian> }, # 10 The Norwegian lives in the first house.
{ :smoke<blendBlend>, :nextNext-toTo(:pet<cats>) }, # 11 The man who smokes Blend lives in the house next to the house with cats.
{ :pet<horse>, :nextNext-toTo(:smoke<dunhillDunhill>) }, # 12 In a house next to the house where they have a horse, they smoke Dunhill.
{ :smoke<blueBlue-masterMaster>, :drink<beer> }, # 13 The man who smokes Blue Master drinks beer.
{ :nat<germanGerman>, :smoke<princePrince> }, # 14 The German smokes Prince.
{ :nat<norwegianNorwegian>, :nextNext-toTo(:color<blue>) }, # 15 The Norwegian lives next to the blue house.
{ :drink<water>, :nextNext-toTo(:smoke<blendBlend>) }, # 16 They drink water in a house next to the house where they smoke Blend.
{ :pet<zebra> }, # who owns this?
);
Line 4,911:
say .pairs.sort.map(*.value.fmt("%-9s")).join(' | ')
for .list;
last; # stop after first solution
}
}
 
#| completedfound ifa theresolution arethat nofits moreall the facts
multi sub solve(@houses, @facts [ ]) {
take @houses;
Line 4,922 ⟶ 4,923:
multi sub solve(@houses, @facts is copy) {
my $fact = @facts.shift;
generatefor gather speculate(@houses, |$fact).first: {solve(@$_, @facts) }
solve(@$_, @facts)
}
}
 
#| find all possible solutions for pairs of houses with
#| %a attributes, left of a house with %b attributes
multi sub generatespeculate(@houses, :leftLeft-ofOf(%b)!, *%a) {
my @scenarios;
for @houses {
Line 4,935 ⟶ 4,938:
@scenario[$idx-1] = %( %(@houses[$idx-1]), %a );
@scenario[$idx] = %( %(@houses[$idx]), %b );
@scenarios.push:take @scenario;
}
}
@scenarios;
}
 
#| find all possible pairs of houses with %a attributes, either side
#! of a house with %b attributes
multi sub generatespeculate(@houses, :nextNext-toTo(%b)!, *%a ) {
generatespeculate(@houses, |%a, :leftLeft-ofOf(%b) ).append: generate(@houses, |%b, :left-of(%a) );
speculate(@houses, |%b, :Left-Of(%a) );
}
 
#| find all possible houses that match the given attributes
multi sub generatespeculate(@houses, *%fact) {
for @houses.grep({plausible($_, %fact)}).map: -> $house {
my @scenario = @houses.clone;
my $idx = $house<num> - 1;
@scenario[$idx] = %( %$house, %fact );
take @scenario;
}
}
 
#| attributes are plausible if they dondoesn't conflict with house valuesanything
sub plausible(%house, %atts) {
!all %atts.keys.firstmap: { (%house{$_}:!exists) &&|| %house{$_} neeq %atts{$_} };
}
</lang>
Line 4,965 ⟶ 4,968:
<pre>
COLOR | DRINK | NAT | NUM | PET | SMOKE
yellow | water | norwegianNorwegian | 1 | cats | dunhillDunhill
blue | tea | daneDane | 2 | horse | blendBlend
red | milk | englishEnglish | 3 | birds | pallPall-mallMall
green | coffee | germanGerman | 4 | zebra | princePrince
white | beer | swedeSwede | 5 | dog | blueBlue-masterMaster
</pre>
 
Retrieved from "https://rosettacode.org/wiki/Zebra_puzzle"