Logic programming example

Using the List Monad it's possible to rig up a basic logic program, where the bulk of the code simply asserts the shape of the answer rather than worrying about generating the solution space. The below code is a full solution to a relatively simple, but classic, logic puzzle. It uses properties of the List Monad, in a straightforward way, to declaratively assert the answer.

The problem

There is a tribe where all the Male members speak true statements and Female members never speak two true statements in a row, nor two untrue statements in a row. (I apologize for the obvious misogyny).

A researcher comes across a mother, a father, and their child. The mother and father speak English but the child does not. However, the researcher asks the child "Are you a boy?". The child responds but the researcher doesn't understand the response and turns to the parents for a translation.

Parent 1: "The child said 'I am a boy.'"
Parent 2: "The child is a girl. The child lied."

What is the sex of parent 1, parent 2, the child, and what sex did the child say they were?

Bonus problem

There is a unique solution for heterosexual, gay, and lesbian couples. Find all three solutions.

Solution

Run the code at the bottom of the page :)

The approach

Use the monadic properties of lists to setup some basic logic programming. There are four variables in the puzzle: Sex of parent 1, Sex of parent 2, Sex of the child, and the Sex the child said they were. Each of these has two possibilities, which means we've got 2^4 == 16 possible outcomes.

Using List Monads we can realize all 2^4 outcomes in a straightforward fashion. Then it is just a matter of testing each combination to make sure it fits the constraints of the puzzle.

We have two axioms:

A Male does not lie.
A Female will never tell two lies or two truths in a row.

And we have three statements (i.e. logical expressions) in the puzzle:

The child said a single statement, in which they declared their sex.
Parent 1 said a single statement: "The child said 'I am a a boy'"
Parent 2 said two statements: "The child is a girl. The child lied."

Each of those three statements is realized as a function. These functions do not test the truth of the statement but rather test its logical validity in the face of the axioms.

For example, if the Child is Male then it is not possible the child said they were Female since that would violate axiom 1. Similarly if the Child is Female then no matter if they lied or told the truth the statement is valid in the face of the axioms, this is an example of the truth of the statement differing from its logical validity.

Data structures and imports

We need to import guard from the Monad module, it culls out unwanted solutions from the solution space.

import Control.Monad (guard)

People are either Male or Female, this represents the constraints of the puzzle.

data Sex = Male | Female deriving (Eq, Show)

When creating an answer we stuff it into this data structure. This isn't strictly necessary, but it gently introduces structured data types and (below) defining a custom instance of Show.

data PuzzleAnswer = PuzzleAnswer {
    parent1 :: Sex,
    parent2 :: Sex,
    child :: Sex,
    child_desc :: Sex
}

This lets us print out the data structure in a friendly way.

instance Show (PuzzleAnswer) where
    show pa = "Parent1 is " ++ (show $ parent1 pa) ++ "\n" ++
              "Parent2 is " ++ (show $ parent2 pa) ++ "\n" ++
              "The child is " ++ (show $ child pa) ++ "\n" ++
              "The child said they were " ++ (show $ child_desc pa) ++ "\n"

Verify the child's statement

childs_statement_is_valid(child_sex, child_described_sex)

The only combination that violates the axioms is (Male, Female) since a Male does not lie. Obviously (Male, Male) and (Female, *) are valid statements.

childs_statement_is_valid :: Sex -> Sex -> Bool
childs_statement_is_valid Male Female = False
childs_statement_is_valid _ _ = True

Verify parent 1's statement

parent1_statement_is_valid(parent1_sex, child_described_sex)

Parent 1 said "The child said 'I am a boy'". The only invalid combination is (Male, Female), because that'd imply a Male (the parent) lied. Obviously (Male, Male) is okay because then parent 1 is telling the truth. (Female, *) is valid because there's no way they violated either axiom by speaking a single statement.

parent1_statement_is_valid :: Sex -> Sex -> Bool
parent1_statement_is_valid Male Female = False
parent1_statement_is_valid _ _ = True

Verify parent 2's statement

parent2_statement_is_valid(parent1_sex, child_sex, child_described_sex)

Parent 2 said "The child is a girl. The child lied." If Parent 2 is Male then the only way this can be a legal statement is if the child is Female and said they were Male. This would mean the child is in fact a girl and the child did in fact lie, two statements which are both true. This corresponds to (Male, Female, Male) being legal.

If Parent2 is Female then (Female, *, Female) are both true. (Female, Male, Female) is true because the first statement is false (the child is a girl) but the second one is true (the child lied -- it said Female when it was Male). (Female, Female, Female) is also legal since the first statement (the child is a girl) is true but the second one is a lie (the child lied -- the child said they were Female and they are Female).

Any other combination will be illegal.

parent2_statement_is_valid :: Sex -> Sex -> Sex -> Bool
parent2_statement_is_valid Male Female Male = True
parent2_statement_is_valid Female _ Female = True
parent2_statement_is_valid _ _ _ = False

Use the list monad to get the answer, declaratively

Here we use the List Monad to declare the four variables, each ranging over the set [Male, Female]. The List Monad transparently constructs all 2^4 possibilities. The guard statements discard statements that are invalid. We have four guards, the three described above and an additional guard that asserts the sexuality of the parents. The sexuality assertion is passed in as a function, this lets us reuse the same code for homosexual, gay, and lesbian couples.

The result is a list of tuples listing all possible solutions. There happens to be only one, if there was more than one than the other legal ones would be returned too.

solve_puzzle :: (Sex -> Sex -> Bool) -> [PuzzleAnswer]
solve_puzzle sexuality_pred = do 
    parent1 <- [Male, Female]
    parent2 <- [Male, Female]
    child <- [Male, Female]
    child_desc <- [Male, Female]
    guard $ sexuality_pred parent1 parent2
    guard $ childs_statement_is_valid child child_desc
    guard $ parent1_statement_is_valid parent1 child_desc
    guard $ parent2_statement_is_valid parent2 child child_desc
    return $ PuzzleAnswer {
        parent1=parent1, 
        parent2=parent2, 
        child=child, 
        child_desc=child_desc
    }

Execute the program

Run the program. We use mapM because we're applying a print in Monadic setting. We use any kind of map because it's possible (due to poor coding) that the solution could have more than one answer.

main = do
    putStrLn "----------- Heterosexual Couple -----------"
    mapM_ print (solve_puzzle (/=))
    putStrLn "----------- Gay Couple -----------"
    mapM_ print (solve_puzzle (\x y -> x == y && x == Male))
    putStrLn "----------- Lesbian Couple -----------"
    mapM_ print (solve_puzzle (\x y -> x == y && x == Female))

The full code listing

import Control.Monad (guard)

{-
Problem:

There is a tribe where all the Male members speak true statements and Female
members never speak two true statements in a row, nor two untrue statements in
a row.  (I apologize for the obvious misogyny).

A researcher comes across a mother, a father, and their child.  The mother and
father speak English but the child does not.  However, the researcher asks the
child "Are you a boy?".  The child responds but the researcher doesn't
understand the response and turns to the parents for a translation.

Parent 1: "The child said 'I am a boy.'"
Parent 2: "The child is a girl.  The child lied."

What is the sex of parent 1, parent 2, the child, and what sex did the child
say they were?

Bonus:

There is a unique solution for heterosexual, gay, and lesbian couples.  Find
all three solutions.

Solution:

Run the code :)

Approach:

Use the monadic properties of lists to setup some basic logic programming.
There are four variables in the puzzle: Sex of parent 1, Sex of parent 2, Sex
of the child, and the Sex the child said they were.  Each of these has two
possibilities, which means we've got 2^4 == 16 possible outcomes.

Using List Monads we can realize all 2^4 outcomes in a straightforward
fashion.  Then it is just a matter of testing each combination to make sure it
fits the constraints of the puzzle.  

We have two axioms:

1. A Male does not lie.
2. A Female will never tell two lies or two truths in a row.

And we have three statements (i.e. logical expressions) in the puzzle:

1. The child said a single statement, in which they declared their sex.
2. Parent 1 said a single statement: "The child said 'I am a a boy'"
3. Parent 2 said two statements: "The child is a girl.  The child lied."

Each of those three statements is realized as a function.  These functions do
not test the truth of the statement but rather test its logical validity in
the face of the axioms.  

For example, if the Child is Male then it is not possible the child said they
were Female since that would violate axiom 1.  Similarly if the Child is Female
then no matter if they lied or told the truth the statement is valid in the
face of the axioms, this is an example of the truth of statement differing
from its logical validity.

-}

-- People are either Male or Female, this represents the constraints of the puzzle.
data Sex = Male | Female deriving (Eq, Show)

-- When creating an answer we stuff it into this data structure
data PuzzleAnswer = PuzzleAnswer {
    parent1 :: Sex,
    parent2 :: Sex,
    child :: Sex,
    child_desc :: Sex
}

-- This lets us print out the data structure in a friendly way
instance Show (PuzzleAnswer) where
    show pa = "Parent1 is " ++ (show $ parent1 pa) ++ "\n" ++
              "Parent2 is " ++ (show $ parent2 pa) ++ "\n" ++
              "The child is " ++ (show $ child pa) ++ "\n" ++
              "The child said they were " ++ (show $ child_desc pa) ++ "\n"
        
{-
childs_statement_is_valid(child_sex, child_described_sex)

The only combination that violates the axioms is (Male, Female) since a Male
does not lie.  Obviously (Male, Male) and (Female, *) are valid statements.
-}
childs_statement_is_valid :: Sex -> Sex -> Bool
childs_statement_is_valid Male Female = False
childs_statement_is_valid _ _ = True

{-
parent1_statement_is_valid(parent1_sex, child_described_sex)

Parent 1 said "The child said 'I am a boy'".  The only invalid combination is
(Male, Female), because that'd imply a Male (the parent) lied.  Obviously
(Male, Male) is okay because then parent 1 is telling the truth.  (Female, *)
is dubious because you can't trust a Female.
-}
parent1_statement_is_valid :: Sex -> Sex -> Bool
parent1_statement_is_valid Male Female = False
parent1_statement_is_valid _ _ = True

{-
parent2_statement_is_valid(parent1_sex, child_sex, child_described_sex)

Parent 2 said "The child is a girl.  The child lied."  If Parent 2 is Male
then the only way this can be a legal statement is if the child is Female and
said they were Male.  This would mean the child is in fact a girl and the
child did in fact lie, two statements which are both true.  This corresponds
to (Male, Female, Male) being legal.

If Parent2 is Female then (Female, *, Female) are both true.  (Female, Male,
Female) is true because the first statement is false (the child is a girl) but
the second one is true (the child lied -- it said Female when it was Male).
(Female, Female, Female) is also legal since the first statement (the child is
a girl) is true but the second one is a lie (the child lied -- the child said
they were Female and they are Female).

Any other combination will be illegal.
-}
parent2_statement_is_valid :: Sex -> Sex -> Sex -> Bool
parent2_statement_is_valid Male Female Male = True
parent2_statement_is_valid Female _ Female = True
parent2_statement_is_valid _ _ _ = False

{-
Here we use the List Monad to declare the four variables, each ranging over
the set [Male, Female].  The List Monad transparently constructs all 2^4
possibilities.  The guard statements discard statements that are invalid.  We
have four guards, the three described above and an additional guard that
asserts the parents are not the same sex.

The result is a list of tuples listing all possible solutions.  There happens
to be only one, if there was more than one than the other legal ones would be
returned too.
-}
solve_puzzle :: (Sex -> Sex -> Bool) -> [PuzzleAnswer]
solve_puzzle sexuality_pred = do 
    parent1 <- [Male, Female]
    parent2 <- [Male, Female]
    child <- [Male, Female]
    child_desc <- [Male, Female]
    guard $ sexuality_pred parent1 parent2
    guard $ childs_statement_is_valid child child_desc
    guard $ parent1_statement_is_valid parent1 child_desc
    guard $ parent2_statement_is_valid parent2 child child_desc
    return $ PuzzleAnswer {
        parent1=parent1, 
        parent2=parent2, 
        child=child, 
        child_desc=child_desc
    }

-- Run the program.  We use mapM because we're applying a print in Monadic
-- setting.  We use any kind of map because it's possible (due to poor coding)
-- that the solution could have more than one answer.
main = do
    putStrLn "----------- Heterosexual Couple -----------"
    mapM_ print (solve_puzzle (/=))
    putStrLn "----------- Gay Couple -----------"
    mapM_ print (solve_puzzle (\x y -> x == y && x == Male))
    putStrLn "----------- Lesbian Couple -----------"
    mapM_ print (solve_puzzle (\x y -> x == y && x == Female))