Backtracking in Logic Haskell

I like logic and functional programming. I like Prolog and Haskell. There are some programming languages that combine those computational ideas, such as Mercury, Curry, and Verse. But what if I want to use a logic property (backtracking) in the functional language Haskell? Luckily, there is a logic package in Hackage, which adds backtracking to Haskell.

What is Backtracking?

Backtracking is a search strategy a computer uses to explore all possible options for a problem systematically. It tries one possibility, and if it fails (doesn’t satisfy the conditions), it “backs up” and tries another. This is best explained with an example:

% fact
likes(john, jane).
likes(jane, john).
likes(jack, jane).

% rule
friends(X, Y) :- likes(X, Y), likes(Y, X).

That is a Prolog program that has facts and a rule. When I ask the Prolog engine friends(X, Y), it will give me the possible arguments of X and Y. If I specify the X argument, the engine will give me the possible Y arguments.

how do i use logic in haskell

The first thing is declaring some facts. We can encode atoms as String, since Haskell doesn’t have atoms. Also, don’t forget the import and the utility function (a function that converts a list to Logic).

import Data.List
import Control.Applicative
import Control.Monad.Logic

choose :: [a] -> Logic a
choose = foldr ((<|>) . pure) empty

likeFact :: [ (String, String) ]
likeFact =  [ ("John", "Jane")
            , ("Jane", "John")
            , ("Jack", "Jane")
            ]

peopleFact :: [ String ]
peopleFact = nub [ s | (a, b) <- likeFacts, s <- [a, b] ]

friendRule :: String -> String -> Logic ()
friendRule x y = rule1 <|> rule2
  where
    rule1 = choose likeFact >>- \(a, b) ->
              if a == x && b == y
              then pure ()
              else empty
    rule2 = choose likeFact >>- \(a, b) ->
              if a == y && b == x
              then pure ()
              else empty

After we define some facts and a rule, we can ask the computer who is a friend of John.

queryFriend :: String -> Logic String
queryFriend x =
  choose peopleFact >>- \y ->
    friendRule x y >>- \_ ->
      pure y

observeAll $ queryFriend "John"

That program will find who is a friend of John.

λ> observeAll $ queryFriend "John"
["Jane","Jane"]
λ> 

More Exmaple

One of my favorite books is Simply Logical. In that book, it teaches how to use Prolog. One of the interesting examples is using Prolog to find nearby stations [^sl]

connected(bond_street,oxford_circus,central).
connected(oxford_circus,tottenham_court_road,central).
connected(bond_street,green_park,jubilee).
connected(green_park,charing_cross,jubilee).
connected(green_park,piccadilly_circus,piccadilly).
connected(piccadilly_circus,leicester_square,piccadilly).
connected(green_park,oxford_circus,victoria).
connected(oxford_circus,piccadilly_circus,bakerloo).
connected(piccadilly_circus,charing_cross,bakerloo).
connected(tottenham_court_road,leicester_square,northern).
connected(leicester_square,charing_cross,northern).

and using a rule to find the nearby stations:

nearby(X,Y):-connected(X,Y,_L).
nearby(X,Y):-connected(X,Z,L),connected(Z,Y,L).

Then I query:

?-nearby(tottenham_court_road,W).
   W = leicester_square
;  W = charing_cross.

Now how do I do that in Logic Haskell? Same as before: define some facts and a rule.

import Data.List
import Control.Applicative
import Control.Monad.Logic

choose :: [a] -> Logic a
choose = foldr ((<|>) . pure) empty

connectedFact :: [(String, String, String)]
connectedFact =
  [ ("Station"             , "Station"             , "Line")
  , ("Bond Street"         , "Oxford Circus"       , "Central")
  , ("Oxford Circus"       , "Tottenham Court Road", "Central")
  , ("Bond Street"         , "Green Park"          , "Jubilee")
  , ("Green Park"          , "Charing Cross"       , "Jubilee")
  , ("Green Park"          , "Piccadilly Circus"   , "Piccadilly")
  , ("Piccadilly Circus"   , "Leicester Square"    , "Piccadilly")
  , ("Green Park"          , "Oxford Circus"       , "Victoria")
  , ("Oxford Circus"       , "Piccadilly Circus"   , "Bakerloo")
  , ("Piccadilly Circus"   , "Charing Cross"       , "Bakerloo")
  , ("Tottenham Court Road", "Leicester Square"    , "Northern")
  , ("Leicester Square"    , "Charing Cross"       , "Northern")
  ]

stationFact :: [String]
stationFact = nub [ s | (a,b,_) <- connectedFact, s <- [a,b] ]

nearby :: String -> String -> Logic ()
nearby x y = rule1 <|> rule2
  where
    rule1 = choose connectedFact >>- \(a,b,_) ->
              if a == x && b == y
              then pure ()
              else empty
    rule2 = choose connectedFact >>- \(p11,p21,r1) ->
              choose connectedFact >>- \(p12,p22,r2) ->
                if p11 == x && p21 == p12 && p22 == y && r1 == r2
                then pure ()
                else empty

queryNearby :: String -> Logic String
queryNearby x =
  choose stationFact >>- \y ->
    nearby x y >>- \_ ->
      pure y

then do some query..

λ> observeAll $ queryNearby "Tottenham Court Road"
["Charing Cross","Leicester Square"]
λ> 

[^sl]: Simply Logical https://book.simply-logical.space/src/text/1_part_i/1.0.html