Solving a logic task using Prolog

Question

I started to learn Prolog and I can't solve a difficult task for me.

On Halloween, three friends - Bob, Mark, Alex, chose the costumes of three ghosts: a ghost, a zombie, a werewolf. It is known that:

• Bob is the tallest.
• The one who chose the werewolf costume is shorter than the one who chose the ghost costume.
• Alex didn't fit the werewolf costume.
• None of the friends have the same name as the Halloween character from the selected costumes.

Which costume did each of the friends choose?

I solved the problem mathematically, but it is impossible to describe its solution in Prolog.

Answer 1

(the previous versions of this answer suffered from the "premature implementation syndrome". Here's another take on it)

I started to learn Prolog and I can't solve a difficult task for me. [...] it is impossible to describe its solution in Prolog.

Nah: :) If we can say it in English we can say it in Prolog:

task( Sol) :-

On Halloween, three friends - Bob , Mark , Alex , chose the costumes of three ghosts: a ghost , a zombie , a werewolf .

    Sol = [bob-C1, mark-C2, alex-C3],
    permutation( [ghost, zombie, werewolf], [C1,C2,C3]),

It is known that:

• Bob is the tallest .

    select( bob-_, Sol, ShorterOnes),

• The one who chose the werewolf costume is shorter than the one who chose the ghost costume.

    member( _-werewolf, ShorterOnes),

• Alex didn't fit the werewolf costume.

    C3 \= werewolf,

• None of the friends have the same name as the Halloween character from the selected costumes.

  Apparently, there is one Bob the Ghost, so

    C1 \= ghost,

Which costume did each of the friends choose?

    true.  % nothing more to say

So we were able to describe the problem in Prolog, after all.

Having described the problem properly, we already have our program to find the solution.

Testing:

13 ?- task(X).
X = [bob-zombie, mark-werewolf, alex-ghost] ;
false.

---

This can be written a tiny bit shorter if we realize that selecting bob as the tallest

    select( bob-_, Sol, ShorterOnes),
    member( _-werewolf, ShorterOnes),

leaves us with mark and alex as the shorter ones:

task( [bob-C1, mark-C2, alex-C3]) :-
    permutation( [ghost, zombie, werewolf], [C1,C2,C3]),
    member( werewolf, [C2, C3]),
    C3 \= werewolf,
    C1 \= ghost.

Glancing at this short code for a minute, we realize that it can be further simplified to

task( [bob-C1, mark-C2, alex-C3]) :-
    permutation( [ghost, zombie, werewolf], [C1,C2,C3]),
    ( werewolf = C2 ; werewolf = C3 ),
    C3 \= werewolf,
    C1 \= ghost.

and this to

task( [bob-C1, mark-C2, alex-C3]) :-
    permutation( [ghost, zombie, werewolf], [C1,C2,C3]),
    werewolf = C2,
    C1 \= ghost.

and this to

task( [bob-C1, mark-werewolf, alex-C3]) :-
    permutation( [ghost, zombie], [C1,C3]),
    C1 \= ghost.

and this to

task( [bob-zombie, mark-werewolf, alex-ghost]).

And this version we don't even need to run.

Answer 2

Here is a solution using clpb.

:- use_module(library(clpb)).


solve :-
    /* Alex is wearing one of the following costumes */
    sat(card([1], [Alex * GhostA , Alex * ZombieA , Alex * WerewolfA])),

    /* Bob is wearing one of the following costumes */
    sat(card([1], [Bob * GhostB , Bob * ZombieB , Bob * WerewolfB])),

    /* Mark is wearing one of the following costumes */
    sat(card([1], [Mark * GhostM , Mark * ZombieM , Mark * WerewolfM])),

    /* Alex wears only one of the following costumes */
    sat(card([1], [GhostA, ZombieA, WerewolfA])),

    /* Bob wears only one of the following costumes */
    sat(card([1], [GhostB, ZombieB, WerewolfB])),

    /* Mark wears only one of the following costumes */
    sat(card([1], [GhostM, ZombieM, WerewolfM])),

    /* There is only one ghost costume */
    sat(card([1], [GhostA,    GhostB,    GhostM])),

    /* There is only one zombie costume */
    sat(card([1], [ZombieA,   ZombieB,   ZombieM])),

    /* There is only one werewolf costume */
    sat(card([1], [WerewolfA, WerewolfB, WerewolfM])),

    /* Alex didn't fit the werewolf costume. */
    sat(Alex * ~WerewolfA),

    /*  Bob can't wear the ghost costume. */
    sat(Bob * ~GhostB),

    /* Bob is the tallest */
    sat(BobHigherA * ~AlexHigherB),
    sat(BobHigherM * ~MarkHigherB),

    /* For Alex and Mark we don't know */
    sat(AlexHigherM * ~MarkHigherA + ~AlexHigherM * MarkHigherA ),

    /* The one who chose the werewolf costume is shorter than the one who chose the ghost costume. */
    sat((WerewolfB * GhostA) =< (BobHigherA  < AlexHigherB)),
    sat((WerewolfB * GhostM) =< (BobHigherM  < MarkHigherB)),
    sat((WerewolfA * GhostB) =< (AlexHigherB < BobHigherA)),
    sat((WerewolfA * GhostM) =< (AlexHigherM < MarkHigherA)),
    sat((WerewolfM * GhostB) =< (MarkHigherB < BobHigherM)),
    sat((WerewolfM * GhostA) =< (MarkHigherA < AlexHigherM)),

    /* We solve the puzzle */
    labeling([GhostA, ZombieA, WerewolfA, GhostB, ZombieB, WerewolfB, GhostM, ZombieM, WerewolfM]),

    writef('Alex => Ghost %d Zombie %d Werewolf %d\n', [GhostA, ZombieA, WerewolfA]),
    writef('Bob  => Ghost %d Zombie %d Werewolf %d\n', [GhostB, ZombieB, WerewolfB]),
    writef('Mark => Ghost %d Zombie %d Werewolf %d\n', [GhostM, ZombieM, WerewolfM]).

The answer is

?- solve.
Alex => Ghost 1 Zombie 0 Werewolf 0
Bob  => Ghost 0 Zombie 1 Werewolf 0
Mark => Ghost 0 Zombie 0 Werewolf 1
true.

[EDIT] After a search on the inte.net, I found these Halloween characters: Bob the ghost, Alex the werewolf and Mark the Zombie. So there is no need of the fact that "Alex didn't fit the werewolf costume."

We get now:

:- use_module(library(clpb)).

solve :-
    /* Alex is wearing one of the following costumes */
    sat(card([1], [Alex * GhostA , Alex * ZombieA , Alex * WerewolfA])),

    /* Bob is wearing one of the following costumes */
    sat(card([1], [Bob * GhostB , Bob * ZombieB , Bob * WerewolfB])),

    /* Mark is wearing one of the following costumes */
    sat(card([1], [Mark * GhostM , Mark * ZombieM , Mark * WerewolfM])),

    /* Alex wears only one of the following costumes */
    sat(card([1], [GhostA, ZombieA, WerewolfA])),

    /* Bob wears only one of the following costumes */
    sat(card([1], [GhostB, ZombieB, WerewolfB])),

    /* Mark wears only one of the following costumes */
    sat(card([1], [GhostM, ZombieM, WerewolfM])),

    /* There is only one ghost costume */
    sat(card([1], [GhostA,    GhostB,    GhostM])),

    /* There is only one zombie costume */
    sat(card([1], [ZombieA,   ZombieB,   ZombieM])),

    /* There is only one werewolf costume */
    sat(card([1], [WerewolfA, WerewolfB, WerewolfM])),

    /*  Alex can't wear the zombie costume. */
    sat(Alex * ~ZombieA),

    /*  Bob can't wear the ghost costume. */
    sat(Bob * ~GhostB),

    /*  Mark can't wear the werewolf costume. */
    sat(Mark * ~WerewolfM),

    /* Bob is the tallest */
    sat(BobHigherAlex * ~AlexHigherBob),
    sat(BobHigherMark * ~MarkHigherBob),

    /* For Alex and Mark we don't know */
    sat(AlexHigherMark * ~MarkHigherAlex + ~AlexHigherMark * MarkHigherAlex ),

    /* The one who chose the werewolf costume is shorter than the one who chose the ghost costume. */
    sat((WerewolfB * GhostA) =< (BobHigherAlex  < AlexHigherBob)),
    sat((WerewolfB * GhostM) =< (BobHigherMark  < MarkHigherBob)),
    sat((WerewolfA * GhostB) =< (AlexHigherBob < BobHigherAlex)),
    sat((WerewolfA * GhostM) =< (AlexHigherMark < MarkHigherAlex)),
    sat((WerewolfM * GhostB) =< (MarkHigherBob < BobHigherMark)),
    sat((WerewolfM * GhostA) =< (MarkHigherAlex < AlexHigherMark)),

    /* We solve the puzzle */
    labeling([GhostA, ZombieA, WerewolfA, GhostB, ZombieB, WerewolfB, GhostM, ZombieM, WerewolfM]),

    writef('Alex => Ghost %d Zombie %d Werewolf %d\n', [GhostA, ZombieA, WerewolfA]),
    writef('Bob  => Ghost %d Zombie %d Werewolf %d\n', [GhostB, ZombieB, WerewolfB]),
    writef('Mark => Ghost %d Zombie %d Werewolf %d\n', [GhostM, ZombieM, WerewolfM]).

And the solution is now

?- solve.
Alex => Ghost 0 Zombie 0 Werewolf 1
Bob  => Ghost 0 Zombie 1 Werewolf 0
Mark => Ghost 1 Zombie 0 Werewolf 0
true.

Answer 3

Using dif :

go(Sol) :-
    Sol = [bob-Bob, mark-Mark, alex-Alex],

    % werewolf is not tallest (Bob)
    dif(Bob, werewolf),

    dif(Alex, werewolf),

    % Not usual names
    dif(Bob, ghost),

    permutation([Bob, Mark, Alex], [ghost, zombie, werewolf]).

Result in swi-prolog:

?- go(Sol).
Sol = [bob-zombie, mark-werewolf, alex-ghost] ;
false.