module Main where
import Control. Applicative ( ( <$> ) , ( <*> ) )
import Control
. Monad ( foldM
, forM
_ ) import Data. List ( ( \\) , isInfixOf)
-- types
data House = House
{ color :: Color -- <getter> :: House -> <Trait>
, man :: Man
, pet :: Pet
, drink :: Drink
, smoke :: Smoke
}
data Color = Red | Green | Blue | Yellow | White
data Man = Eng | Swe | Dan | Nor | Ger
data Pet = Dog | Birds | Cats | Horse | Zebra
data Drink = Coffee | Tea | Milk | Beer | Water
data Smoke = PallMall | Dunhill | Blend | BlueMaster | Prince
main = do
solutions :: [ [ House] ]
solutions
= filter finalCheck
$ foldM next
[ ] [ 1 .. 5 ] where
next
:: [ House
] -> Int -> [ [ House
] ] next sol pos = [ h:sol | h <- newHouses sol, consistent h pos]
newHouses :: [ House] -> [ House]
newHouses sol = -- all combinations of available traits
House <$> new color <*> new man <*> new pet <*> new drink <*> new smoke
where
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
is
:: Eq a
=> ( House
-> a
) -> a
-> House
-> Bool getter `is` value = ( == value) . getter
finalCheck
:: [ House
] -> Bool finalCheck solution
= and -- fulfills the rules: -- NOTE: list of houses is generated in reversed order
[ [ White
, Green
] `isInfixOf`
map color solution
-- 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
, ( smoke `is` Blend ) `nextTo` ( drink `is` Water) -- 16
]
where
nextTo p q
where
it x = p x || q x
bW9kdWxlIE1haW4gd2hlcmUKCmltcG9ydCBDb250cm9sLkFwcGxpY2F0aXZlICgoPCQ+KSwgKDwqPikpCmltcG9ydCBDb250cm9sLk1vbmFkIChmb2xkTSwgZm9yTV8pCmltcG9ydCBEYXRhLkxpc3QgKChcXCksIGlzSW5maXhPZikKCi0tIHR5cGVzCmRhdGEgSG91c2UgPSBIb3VzZSAgIAogICAgeyBjb2xvciA6OiBDb2xvciAgICAgIC0tIDxnZXR0ZXI+IDo6IEhvdXNlIC0+IDxUcmFpdD4KICAgICwgbWFuICAgOjogTWFuCiAgICAsIHBldCAgIDo6IFBldAogICAgLCBkcmluayA6OiBEcmluawogICAgLCBzbW9rZSA6OiBTbW9rZQogICAgfQogICAgZGVyaXZpbmcgKEVxLCBTaG93KQoKZGF0YSBDb2xvciA9IFJlZCB8IEdyZWVuIHwgQmx1ZSB8IFllbGxvdyB8IFdoaXRlCiAgICBkZXJpdmluZyAoRXEsIFNob3csIEVudW0sIEJvdW5kZWQpCgpkYXRhIE1hbiA9IEVuZyB8IFN3ZSB8IERhbiB8IE5vciB8IEdlcgogICAgZGVyaXZpbmcgKEVxLCBTaG93LCBFbnVtLCBCb3VuZGVkKQoKZGF0YSBQZXQgPSBEb2cgfCBCaXJkcyB8IENhdHMgfCBIb3JzZSB8IFplYnJhCiAgICBkZXJpdmluZyAoRXEsIFNob3csIEVudW0sIEJvdW5kZWQpCgpkYXRhIERyaW5rID0gQ29mZmVlIHwgVGVhIHwgTWlsayB8IEJlZXIgfCBXYXRlcgogICAgZGVyaXZpbmcgKEVxLCBTaG93LCBFbnVtLCBCb3VuZGVkKQoKZGF0YSBTbW9rZSA9IFBhbGxNYWxsIHwgRHVuaGlsbCB8IEJsZW5kIHwgQmx1ZU1hc3RlciB8IFByaW5jZQogICAgZGVyaXZpbmcgKEVxLCBTaG93LCBFbnVtLCBCb3VuZGVkKQoKCm1haW4gOjogSU8gKCkKbWFpbiA9IGRvCiAgZm9yTV8gc29sdXRpb25zICQgXHNvbCAtPiBtYXBNXyBwcmludCAocmV2ZXJzZSBzb2wpCiAgICAgICAgICAgICAgICAgICAgICAgICAgICA+PiBwdXRTdHJMbiAiLS0tLSIKICBwdXRTdHJMbiAiTm8gTW9yZSBTb2x1dGlvbnMiCgoKc29sdXRpb25zIDo6IFtbSG91c2VdXQpzb2x1dGlvbnMgPSBmaWx0ZXIgZmluYWxDaGVjayAkIGZvbGRNIG5leHQgW10gWzEuLjVdCiAgICB3aGVyZQogICAgICBuZXh0IDo6IFtIb3VzZV0gLT4gSW50IC0+IFtbSG91c2VdXQogICAgICBuZXh0IHNvbCBwb3MgPSBbaDpzb2wgfCBoIDwtIG5ld0hvdXNlcyBzb2wsIGNvbnNpc3RlbnQgaCBwb3NdCgoKbmV3SG91c2VzIDo6IFtIb3VzZV0gLT4gW0hvdXNlXQpuZXdIb3VzZXMgc29sID0gICAtLSBhbGwgY29tYmluYXRpb25zIG9mIGF2YWlsYWJsZSB0cmFpdHMKICAgIEhvdXNlIDwkPiBuZXcgY29sb3IgPCo+IG5ldyBtYW4gPCo+IG5ldyBwZXQgPCo+IG5ldyBkcmluayA8Kj4gbmV3IHNtb2tlCiAgICB3aGVyZQogICAgICBuZXcgZ2V0dGVyID0gW21pbkJvdW5kIC4uXSBcXCBtYXAgZ2V0dGVyIHNvbAoKCmNvbnNpc3RlbnQgOjogSG91c2UgLT4gSW50IC0+IEJvb2wKY29uc2lzdGVudCBob3VzZSBwb3MgPSBhbmQgICAgICAgICAgICAgICAgICAtLSBjb25zaXN0ZW50IHdpdGggdGhlIHJ1bGVzOgogICAgWyBtYW4gICBgaXNgIEVuZyAgICA8PT4gY29sb3IgYGlzYCBSZWQgICAgICAgICAgICAgIC0tICAyCiAgICAsIG1hbiAgIGBpc2AgU3dlICAgIDw9PiBwZXQgICBgaXNgIERvZyAgICAgICAgICAgICAgLS0gIDMKICAgICwgbWFuICAgYGlzYCBEYW4gICAgPD0+IGRyaW5rIGBpc2AgVGVhICAgICAgICAgICAgICAtLSAgNAogICAgLCBjb2xvciBgaXNgIEdyZWVuICA8PT4gZHJpbmsgYGlzYCBDb2ZmZWUgICAgICAgICAgIC0tICA2CiAgICAsIHBldCAgIGBpc2AgQmlyZHMgIDw9PiBzbW9rZSBgaXNgIFBhbGxNYWxsICAgICAgICAgLS0gIDcKICAgICwgY29sb3IgYGlzYCBZZWxsb3cgPD0+IHNtb2tlIGBpc2AgRHVuaGlsbCAgICAgICAgICAtLSAgOAogICAgLCBjb25zdCAocG9zID09IDMpICA8PT4gZHJpbmsgYGlzYCBNaWxrICAgICAgICAgICAgIC0tICA5CiAgICAsIGNvbnN0IChwb3MgPT0gMSkgIDw9PiBtYW4gICBgaXNgIE5vciAgICAgICAgICAgICAgLS0gMTAKICAgICwgZHJpbmsgYGlzYCBCZWVyICAgPD0+IHNtb2tlIGBpc2AgQmx1ZU1hc3RlciAgICAgICAtLSAxMwogICAgLCBtYW4gICBgaXNgIEdlciAgICA8PT4gc21va2UgYGlzYCBQcmluY2UgICAgICAgICAgIC0tIDE0CiAgICBdCiAgICB3aGVyZQogICAgICBpbmZpeCA0IDw9PgogICAgICBwIDw9PiBxID0gcCBob3VzZSA9PSBxIGhvdXNlICAtLSBib3RoIFRydWUgb3IgYm90aCBGYWxzZQoKCmlzIDo6IEVxIGEgPT4gKEhvdXNlIC0+IGEpIC0+IGEgLT4gSG91c2UgLT4gQm9vbApnZXR0ZXIgYGlzYCB2YWx1ZSA9ICg9PSB2YWx1ZSkgLiBnZXR0ZXIKCgpmaW5hbENoZWNrIDo6IFtIb3VzZV0gLT4gQm9vbApmaW5hbENoZWNrIHNvbHV0aW9uID0gYW5kICAgICAgICAgICAgICAgICAgICAtLSBmdWxmaWxscyB0aGUgcnVsZXM6CiAgICAtLSBOT1RFOiBsaXN0IG9mIGhvdXNlcyBpcyBnZW5lcmF0ZWQgaW4gcmV2ZXJzZWQgb3JkZXIKICAgIFsgW1doaXRlLCBHcmVlbl0gYGlzSW5maXhPZmAgbWFwIGNvbG9yIHNvbHV0aW9uICAgICAtLSAgNQogICAgLCAoc21va2UgYGlzYCBCbGVuZCAgKSBgbmV4dFRvYCAocGV0ICAgYGlzYCBDYXRzICkgIC0tIDExCiAgICAsIChzbW9rZSBgaXNgIER1bmhpbGwpIGBuZXh0VG9gIChwZXQgICBgaXNgIEhvcnNlKSAgLS0gMTIKICAgICwgKGNvbG9yIGBpc2AgQmx1ZSAgICkgYG5leHRUb2AgKG1hbiAgIGBpc2AgTm9yICApICAtLSAxNQogICAgLCAoc21va2UgYGlzYCBCbGVuZCAgKSBgbmV4dFRvYCAoZHJpbmsgYGlzYCBXYXRlcikgIC0tIDE2CiAgICBdCiAgICB3aGVyZQogICAgICBuZXh0VG8gOjogKEhvdXNlIC0+IEJvb2wpIC0+IChIb3VzZSAtPiBCb29sKSAtPiBCb29sCiAgICAgIG5leHRUbyBwIHEKICAgICAgICAgIHwgKF86aDpfKSA8LSBkcm9wV2hpbGUgKG5vdCAuIGl0KSBzb2x1dGlvbiA9IGl0IGgKICAgICAgICAgIHwgb3RoZXJ3aXNlICAgICAgICAgICAgICAgICAgICAgICAgICAgICAgICA9IEZhbHNlCiAgICAgICAgICB3aGVyZQogICAgICAgICAgICBpdCB4ID0gcCB4IHx8IHEgeA==
stdout
House {color = Yellow, man = Nor, pet = Cats, drink = Water, smoke = Dunhill}
House {color = Blue, man = Dan, pet = Horse, drink = Tea, smoke = Blend}
House {color = Red, man = Eng, pet = Birds, drink = Milk, smoke = PallMall}
House {color = Green, man = Ger, pet = Zebra, drink = Coffee, smoke = Prince}
House {color = White, man = Swe, pet = Dog, drink = Beer, smoke = BlueMaster}
----
No More Solutions