core.logic introduction

Relational Logic Programming for Clojure
CORE.LOGIC
http://www.slideshare.net/normanrichards/corelogic-introduction
git clone https://github.com/orb/logicdemo.git

Why core.logic?
http://xkcd.com/292/

core.logic in the real world
ThreatGRID uses core.logic to
process observations of malware
execution looking for behavioral
indicators of compromise.
Observations are simple factual statements that map into
core.logic relations and SQL tables. The mapping allows
the same data model to be used for core.logic programs in
memory, as well as persistance in a database and later
analysis and querying via SQL.
A persistent core.logic database. pldb provides an in-
memory persistent fact database making it easier to use
core.logic in multi-threaded environments like web
applications.
github.com/threatgrid/observations
github.com/threatgrid/pldb

run*
core.logic
(run* [q])
This is the simplest possible
core.logic program. q is the
query. run* says “give me all the
results”.
run* returns a seq of all possible
results. The symbol _0
represents a fresh (unbound)
logic variable.
(_0)

unification
core.logic
(run* [q]
(== q :hello-world))
The most fundamental operation
on a logic variable is to unify it.
uniﬁcation is ==.
There is only one value of q that
satisﬁes the relation. (:hello-world)

unification
core.logic
(run* [q]
(== q [:hello :world]))
Logic variables can also be
uniﬁed over sequences.
There is still only one value of q
that satisﬁes the relation.
([:hello :world])

unification
core.logic
(run* [q]
(== q [:hello :world])
(== q [:hello :world]))
A logic variable can be uniﬁed
with the same value multiple
times.
([:hello :world])

unification
core.logic
(run* [q]
(== q :hello)
(== q :world))
A logic variable cannot unify with
two diﬀerent values at the same
time.
There are no values of q that
satisfy the relation. ()

conde
core.logic
(run* [q]
(conde
[(== q :hello)]
[(== q :world)]))
You can introduce alternative
values with conde. Every conde
line that succeeds produces
possible alternative values.
There are 2 values of q that
satisfy the relation. (:hello :world)

Disunification
core.logic
(run* [q]
(conde
[(== q :hello)]
[(== q :world)])
(!= q :hello))
!= introduces a constraint that
two values never unify.
There are 2 values of q that
satisfy the conde goal, but !=
eliminates one of them. (:world)

FRESH
core.logic
(run* [q]
(fresh [x y]
(== x :something)
(== y :something-else)))
fresh introduces new logic
variables.
x and y are bound, but the query
remains unbound.
(_0)

FRESH
core.logic
(run* [q]
(fresh [x y]
(== x :something)
(== x :something-else)))
The query fails since no value of
q can make x unify with two
diﬀerent values.
()

FRESH
core.logic
(run* [q]
(fresh [x y]
(== q [x :and y])
(== x :something)
(== :something-else y)))
Order does not matter for
uniﬁcation.
([:something :and :something-else])

membero
core.logiccore.logic
(run* [q]
(fresh [smurf]
(membero smurf
[:papa :brainy :lazy :handy])
(== q [smurf smurf])))
membero is relation that
succeeds when the ﬁrst
argument is a member of the
second argument. It can
succeed multiple times.
q produces each success ([:papa :papa]
[:brainy :brainy]
[:lazy :lazy]
[:handy :handy])

membero
(run* [q]
(fresh [smurf1 smurf2]
(membero smurf1
(membero smurf2
(== q [smurf1 smurf2])))
Both membero relations succeed
multiple times. q is uniﬁed with
each pair.
([:papa :papa]
[:papa :brainy]
[:brainy :papa]
...
[:handy :lazy]
[:handy :handy])

distincto
(run* [q]
(fresh [smurf1 smurf2 smurf3]
(membero smurf1
(membero smurf2
(membero smurf3
(distincto [smurf1 smurf2 smurf3])
(== q [smurf1 smurf2 smurf3])))
distincto ensures that no two
items in the relation unify with
each other. smurf1 will never
unify with smurf2, and neither will
unify with smurf3.
([:papa :brainy :lazy]
[:papa :brainy :handy]
[:brainy :papa :lazy]
[:brainy :papa :handy]
...
[:handy :lazy :brainy])

everyg
(run* [q]
(fresh [smurf1 smurf2 smurf3]
(== q [smurf1 smurf2 smurf3])
(everyg #(membero % [:papa :brainy :lazy :handy])
q)
(distincto q)))
everyg ensures that every
element in a collection satisﬁes a
goal. It is not a proper relation, in
that it requires the collection to
already be a seq.
...

lvar
(run* [q]
(== q [(lvar) (lvar) (lvar)])
(everyg #(membero % [:papa :brainy :lazy :handy])
q)
(distincto q))
lvar creates a new a logic
variable. Since we don’t need to
refer to the items individually, we
can just say that the
...

Map coloring
http://pragprog.com/book/btlang/seven-languages-in-seven-weeks
(run 1 [q]
(fresh [tn ms al ga fl]
(everyg #(membero % [:red :blue :green])
[tn ms al ga fl])
(!= ms tn) (!= ms al) (!= al tn)
(!= al ga) (!= al fl) (!= ga fl) (!= ga tn)

(== q {:tennesse tn
:mississipi ms
:alabama al
:georgia ga
:florida fl})))
({:tennesse :blue,
:mississipi :red,
:alabama :green,
:georgia :red,
:florida :blue})

rock paper scissors
(defn beatso [player1 player2]
(conde
[(== player1 :rock) (== player2 :scissors)]
[(== player1 :scissors) (== player2 :paper)]
[(== player1 :paper) (== player2 :rock)]))
beatso is a custom relation
between two terms. It succeeds
when the ﬁrst players move
beats the second players move

rock paper scissors
(run* [q]
(beatso :rock :paper))
beatso fails because :rock does
not beat paper. No value of q
makes this succeed.
()

rock paper scissors
(run* [q]
(beatso :paper :rock))
beatso succeeds because :paper
beats rock. q remains fresh
because no questions were
asked of it.
(_0)

rock paper scissors
(run* [q]
(beatso :rock q))
beatso can answer in either
direction.
(:scissors)
(run* [q]
(beatso q :scissors))
(:rock)

rock paper scissors
(run* [q]
(fresh [x y]
(beatso x y)
(== q [x y])))
This query asks for all the pairs
where x beats y.
([:rock :scissors]
[:scissors :paper]
[:paper :rock])

FACTS and RELATIONS
rpsls is a relation of one term.
Five facts are asserted about the
relation.
(defrel rpsls gesture)
(fact rpsls :rock)
(fact rpsls :paper)
(fact rpsls :scissors)
(fact rpsls :lizard)
(fact rpsls :spock)

FACTS and RELATIONS
(run* [q]
(rpsls q))
defrel relations answer queries in
the same way as the other
relations we’ve seen.
(:rock :paper :scissors :lizard :spock)

FACTS and RELATIONS
beats is a relation of two terms,
indicating the ﬁrst gesture beats
the second one.
(defrel beats gesture1 gesture2)
(fact beats :scissors :paper)
(fact beats :paper :rock)
(fact beats :rock :lizard)
(fact beats :lizard :spock)
(fact beats :spock :scissors)
(fact beats :scissors :lizard)
(fact beats :lizard :paper)
(fact beats :paper :spock)
(fact beats :spock :rock)
(fact beats :rock :scissors)

FACTS and RELATIONS
(run* [q]
(fresh [x y]
(beats :spock x)
(beats x y)
(beats y :spock)
(== q [:spock x y :spock])))
We can ask questions like: give
me a 4-chain of dominated
moves starting and ending
with :spock. There are three
solutions.
([:spock :scissors :lizard :spock]
[:spock :scissors :paper :spock]
[:spock :rock :lizard :spock])

FACTS and RELATIONS
(defn win-chaino [x]
(fresh [a d]
(rpsls a)
(conso a d x)
(conde
[(emptyo d)]
[(fresh [b]
(beats a b)
(firsto d b))
(win-chaino d)])))
A winning chain is a single rpsls
move either by itself or followed
by a winning chain whose ﬁrst
move is beaten by the original
move.
conso, emptyo and ﬁrsto are
relations over cons lists.

FACTS and RELATIONS
(count
(run* [q]
(== q (concat [:spock]
(repeatedly 10 lvar)
[:lizard]))
(win-chaino q)))
How many winning chains are
there from :spock to :lizard with
10 steps?
385

USEless logic puzzle
‣ petey pig did not hand out the popcorn
‣ pippin pig does not live in the wood house
‣ the pig that lives in the straw house handed out popcorn
‣ Petunia pig handed out apples
‣ The pig who handed out chocolate does not live in the brick house.
Three little pigs, who each
lived in a diﬀerent type of
house, handed out treats for
Halloween. Use the clues to
ﬁgure out which pig lived in
each house, and what type of
treat each pig handed out.
http://holidays.hobbyloco.com/halloween/logic1.html

(defn pigso [q]
(fresh [h1 h2 h3 t1 t2 t3]
(== q [[:petey h1 t1]
[:pippin h2 t2]
[:petunia h3 t3]])
(permuteo [t1 t2 t3]
[:chocolate :popcorn :apple])
(permuteo [h1 h2 h3]
[:wood :straw :brick])
... ))
pigso starts by deﬁning the
solution space.
permuteo succeeds when the
ﬁrst list is permutation of the
second.

(fresh [notpopcorn _]
(membero notpopcorn [:chocolate :apple])
(membero [:petey _ notpopcorn] q))
(fresh [notwood _]
(membero notwood [:straw :brick])
(membero [:pippin notwood _] q))
(fresh [_]
(membero [_ :straw :popcorn] q))
(fresh [_]
(membero [:petunia _ :apple] q))
(fresh [notbrick _]
(membero notbrick [:straw :wood])
(membero [_ notbrick :chocolate] q))
The clues translate cleanly to
goals constraining the solution
space.
membero has a solution when
the ﬁrst item is a member of the
second.

FACTS and RELATIONS
(run* [q]
(pigso q))
pigso ﬁnds the only solution.
([[:petey :wood :chocolate]
[:pippin :straw :popcorn]
[:petunia :brick :apple]])

FINITE DOMAINS
fd/interval declares a ﬁnite
integer interval and fd/in
contrains logic variables to a
domain.
(defn two-plus-two-is-four [q]
(fresh [t w o f u r TWO FOUR]
(fd/in t w o f u r (fd/interval 0 9))
(fd/distinct [t w o f u r])
(fd/in TWO (fd/interval 100 999))
(fd/in FOUR (fd/interval 1000 9999))

...
(== q [TWO TWO FOUR])))
T W O
+ T W O
-------
F O U R
http://www.amazon.com/Crypt-arithmetic-Puzzles-in-PROLOG-ebook/dp/B006X9LY8O

FINITE DOMAINS
fd/eq translates simple math to
constraints over ﬁnite domain
logic variables.
(fd/eq (= TWO
(+ (* 100 t)
(* 10 w)
o)))
(fd/eq (= FOUR
(+ (* 1000 f)
(* 100 o)
(* 10 u)
r)))

(fd/eq (= (+ TWO TWO) FOUR))
T W O
+ T W O
-------
F O U R

FINITE DOMAINS
There are 7 unique solutions to
the problem.
(run* [q]
(two-plus-two-is-four q))
T W O
+ T W O
-------
F O U R
([734 734 1468]
[765 765 1530]
[836 836 1672]
[846 846 1692]
[867 867 1734]
[928 928 1856]
[938 938 1876])

sudoku made easier
After setting up the logic
variables and initializing state,
the solution simply requires every
row, column and square on the
board to have distinct values.
(defn solve [puzzle]
(let [sd-num (fd/domain 1 2 3 4 5 6 7 8 9)
board (repeatedly 81 lvar)
rows (into [] (map vec (partition 9 board)))
cols (apply map vector rows)
squares (for [x (range 0 9 3)
y (range 0 9 3)]
(get-square rows x y))]

(run* [q]
(== q board)
(everyg #(fd/in % sd-num) board)
(init-board board puzzle)
(everyg fd/distinct rows)
(everyg fd/distinct cols)
(everyg fd/distinct squares))))
https://gist.github.com/swannodette/3217582

sudoku made easier
matche is pattern matching
syntax for conde. To unify the
initial logic variables with a
board, we require either the
board have a 0 or that the logic
variable uniﬁes with the value of
the board.
(defn init-board [vars puzzle]
(matche [vars puzzle]
([[] []]
succeed)
([[_ . vs] [0 . ps]]
(init-board vs ps))
([[num . vs] [num . ps]]
(init-board vs ps))))

sudoku
(def puzzle1
[0 0 0 0 0 9 0 6 0
0 3 8 0 0 5 0 0 4
0 2 0 0 6 0 0 7 0
0 0 0 0 0 0 3 9 0
0 0 0 9 2 6 0 0 0
0 9 7 0 0 0 0 0 0
0 4 0 0 7 0 0 3 0
5 0 0 4 0 0 2 1 0
0 7 0 8 0 0 0 0 0])
(partition 9 (first (solve puzzle1)))
((7 1 4 2 8 9 5 6 3)
(6 3 8 7 1 5 9 2 4)
(9 2 5 3 6 4 1 7 8)
(8 6 1 5 4 7 3 9 2)
(4 5 3 9 2 6 7 8 1)
(2 9 7 1 3 8 4 5 6)
(1 4 9 6 7 2 8 3 5)
(5 8 6 4 9 3 2 1 7)
(3 7 2 8 5 1 6 4 9))

Norman richards
orb@nostacktrace.com
@maximoburrito

core.logic introduction

More Related Content

Similar to core.logic introduction (20)

More from Norman Richards (6)

Recently uploaded (20)

core.logic introduction