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.

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.

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.

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.

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)))
```

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.

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.

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.

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.

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.

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.

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.

```
(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)))))
```

Published by Meikel Brandmeyer on .

I'm a long-time Clojure user and the developer of several open source projects mostly involving Clojure. I try to actively contribute to the Clojure community.

My most active projects are at the moment VimClojure, Clojuresque and ClojureCheck.

- … type hints?
- … some?
- … argument order?
- … version numbers?
- … comments?
- … bound-fn?
- … ::keywords?
- … -> and ->>?
- … with-open?

Copyright © 2009-2014 All Right Reserved. Meikel Brandmeyer