A field trip into logic programming

Chris Houser got his first problem accepted at 4clojure. I decided to give core.logic a try—David Nolen's awesome logic programming framework for Clojure. And surprisingly I ended up with a working solution.

Disclaimer

I have no clue about logic programming besides reading Ambrose Bonnaire-Sergeant's cool intro for core.logic and some superstitious prejudices. Read the following with a grain of salt.

This will also not be a tutorial on logic programming. I will emphasise certain aspects where I deem them important for the article, but I won't introduce the underlying concepts or functions/goals provided by core.logic . There are other texts (eg. Ambrose's) which do that much better than I could ever hope to.

Programming – the other way

Logic programming is something I always wanted to try but never found the time to actually do something about it. Chris' problem announcement and David's mention of an article about appendo finally made me taking up the challenge.

After going through this exercise I can confirm: Logic programming is different! Coming from another background (no matter which!) you'll have to rethink radically.

Inference

One particular trait of logic programming is that you can infer information from other information. Take for example the already mentioned appendo goal.

( appendo [ :a :b ] [ :c ] [ :a :b :c ] )

This basically declares that appending the list [:c] to the list [:a :b] gives the list [:a :b :c] . Surprise.

However by introducing a fresh variable we can infer things. For example the following

( appendo [ :a :b ] [ :c ] v )

infers that v is [:a :b :c] based on the other inputs. But this can be done with any input. So here

( appendo [ :a :b ] v [ :a :b :c ] )

v will be inferred to be [:c] . This is crucial for the following.

Remark: The naming of goals ending in “o” is not one of my favourites. But it is historically used like that and it frees some meaningful names. So we stick to it here.

Puzzle piece: anyo helper

This is a rather simple helper. It simply defines a goal which is satisfied if and only if the given goal is satisfied for at least one element in list .

( defn anyo [ goal list ] ( fresh [ x ] ( membero x list ) ( goal x ) ) )

Puzzle piece: nodeo

Let's start by declaring some goals which set our basic relations. The first one is the basic building block of the tree: a node.

( defn nodeo [ node name children ] ( conso name children node ) )

So a node consists of a name prepended to it's children . This is verbatim from the problem description.

Puzzle piece: ancestoro

And interesting property of a node may be the fact that it is the ancestor of a certain node with a given name .

( defn ancestoro [ node name ] ( fresh [ children ] ( resto node children ) ( anyo # ( conde ( ( firsto % name ) ) ( ( ancestoro % name ) ) ) children ) ) )

And node is ancestor of another node if the other node belongs to its children or when one of its children is an ancestor of the other node.

Puzzle piece: siblingso

A node may have any number of siblings. Since the children of a node are ordered, these siblings are split into a group of left siblings and right siblings. Together they form a generation.

( defn siblingso [ node left right generation ] ( fresh [ tail ] ( conso node right tail ) ( appendo left tail generation ) ) )

What happens here is basically that we declare that prepending node to the right siblings gives a tail , which again forms the generation when appended to the left siblings.

Puzzle piece: rotated-treeo

This is the main working horse! This goal defines a tree and a rotated tree fit together.

( defn rotated-treeo [ tree name rotated-tree ] ( matche [ tree rotated-tree ] ( [ [ ?parent-name . ?parent-children ] [ name . ?new-named-node-children ] ] ( fresh [ left-siblings right-siblings named-node named-node-children rightmost-node rightmost-node-children ] ( nodeo named-node name named-node-children ) ( siblingso named-node left-siblings right-siblings ?parent-children ) ( appendo left-siblings right-siblings rightmost-node-children ) ( nodeo rightmost-node ?parent-name rightmost-node-children ) ( siblingso rightmost-node named-node-children () ?new-named-node-children ) ) ) ) )

This is a bit intimidating. So let's go through it goal by goal.

( nodeo named-node name named-node-children )

We declare a tree node with the given name. The other variables are still free. Only the name is bound.

( siblingso named-node left-siblings right-siblings ?parent-children )

Here we retrieve the named node from its parents children generation. This fills in the named-node-children as well as left-siblings and right-siblings .

( appendo left-siblings right-siblings rightmost-node-children )

We declare the children of the rotated parent node to be the concatenation of the named nodes siblings with the named node spliced out.

( nodeo rightmost-node ?parent-name rightmost-node-children )

Now we construct the rotated parent node. It gets the same name, but with the newly declared children.

(siblingso rightmost-node named-node-children () ?new-named-node-children)

Finally we declare the children of the rotated, named node to be its children of the unrotated tree plus the newly defined, rotated parent node.

Putting the puzzle together: rotateo

Finally, we put everything together and define our main goal— rotateo .

( defn rotateo [ tree name rotated-tree ] ( conde ( ( firsto tree name ) ( == tree rotated-tree ) ) ( ( ancestoro tree name ) ( fresh [ children child interim-tree ] ( resto tree children ) ( anyo # ( firsto % child ) children ) ( rotated-treeo tree child interim-tree ) ( rotateo interim-tree name rotated-tree ) ) ) ) )

It consists of two cases: either the root node is already the one we want to drag out. Then – well – nothing has to be done. The tree is declared to be the same as the rotated-tree .

Or the root node is an ancestor of the named node. In that case we rotate the tree for every child of the root node and try to apply the rotateo goal again to the resulting interim-tree in a recursive fashion.

Drawbacks

Unfortunately we cannot infer the inputs from the outputs since we loose information in the rotation process. Namely we don't know which siblings were to the left and to the right of the named node. Hence we can't rotate the tree backwards.

For this to work we'd need some kind of splito goal which defines the the split of the siblings based on some kind of ordering.

Upshot

Logic programming is different. Is this a good logic program? Probably not. Much is yet to be learned. However the possibilities and the big bang core.logic provides for the buck are stunning.

This relationship has to be deepened.

Post scriptum: the whole piece

( use ' [ clojure.core.logic minikanren prelude nonrel match disequality ] ) ( defn anyo [ goal list ] ( fresh [ x ] ( membero x list ) ( goal x ) ) ) ( defn nodeo [ node name children ] ( conso name children node ) ) ( defn ancestoro [ node name ] ( fresh [ children ] ( resto node children ) ( anyo # ( conde ( ( firsto % name ) ) ( ( ancestoro % name ) ) ) children ) ) ) ( defn siblingso [ node left right generation ] ( fresh [ tail ] ( conso node right tail ) ( appendo left tail generation ) ) ) ( defn rotated-treeo [ tree name rotated-tree ] ( matche [ tree rotated-tree ] ( [ [ ?parent-name . ?parent-children ] [ name . ?new-named-node-children ] ] ( fresh [ left-siblings right-siblings named-node named-node-children rightmost-node rightmost-node-children ] ( nodeo named-node name named-node-children ) ( siblingso named-node left-siblings right-siblings ?parent-children ) ( appendo left-siblings right-siblings rightmost-node-children ) ( nodeo rightmost-node ?parent-name rightmost-node-children ) ( siblingso rightmost-node named-node-children () ?new-named-node-children ) ) ) ) ) ( defn rotateo [ tree name rotated-tree ] ( conde ( ( firsto tree name ) ( == tree rotated-tree ) ) ( ( ancestoro tree name ) ( fresh [ children child interim-tree ] ( resto tree children ) ( anyo # ( firsto % child ) children ) ( rotated-treeo tree child interim-tree ) ( rotateo interim-tree name rotated-tree ) ) ) ) )