The only think that I would add to Rainer’s presentation is that Raspbian didn’t come with `m4(1)`

out of the box, but it is needed when you `make all`

to rebuild Clozure.

Hacks and glory await!

Also, Linux pro-tip: If you are thinking of renaming your only account on the machine, make sure you add the new name to a group with sudo privileges and make sure you get both /etc/passwd and /etc/shadow in the same sudo.

**Edit:** Rainer correctly points out that his article does say you will need to install `m4`

if you haven’t already. I just missed it.

The Minnesota Secretary of State’s website has information about which candidates where eliminated in which of the 33 elimination rounds in the tabulation. I scraped the data from their Excel spreadsheet, added some Vecto, and put together some worm-trail charts. I couldn’t quite use Zach’s wormtrails library because I wanted to show how an eliminated candidates votes were redistributed (to other candidates who were lower-ranked choices or to the exhausted

bucket). Also, note: the tabulated data on the Minnesota Secretary of State’s website is insufficient to form an accurate proportioning in rounds when multiple candidates are eliminated. In those cases, I just assumed that all candidates whose votes were redistributed were redistributed in the same proportions to the candidates who gained votes because of the eliminations in that round.

About 450 lines of Lisp code later, I came up with images like the one below (click to see it at full-size):

The white worm-trail through the center is the exhausted

pile. Unfortunately, the eliminated candidates in the first 25 or so rounds had so few votes that I’d have to render these images wall-sized for you to get any idea what proportion of their votes went where. In the final few rounds, you can see some detail even with a semi-reasonable file size. I suppose I should see if I can wrangle the data from the St. Paul race which only had six candidates (and thus fewer than six rounds of counting).

Here is the chart broken up into three sections to make it a bit more manageable:

Here is a link to all rounds in one big file. And, here is the source code: rcv.lisp.

Note for Lisp folks: I don’t like the above code. I like short functions, but I also like using `flet`

or `labels`

to make functions that are still within lexical scope of a whole mess of variables. Anyone else come to a good resolution between those two things? Is bundling data in structs and classes really the right thing or a sea of global specials?

I just added an exercise to implement Lisp-style Generic Functions (including the standard method combinations) in Javascript. I’m pretty happy with the way my code came out.

var append = defgeneric('append');

append.defmethod('Array,Array', function (a,b) { return a.concat(b); });

append.defmethod('*,Array', function (a,b) { return [a].concat(b); });

append.defmethod('Array,*', function (a,b) { return a.concat([b]); });

append([1,2],[3,4]); // => [1,2,3,4]

append(1,[2,3,4]); // => [1,2,3,4]

append([1,2,3],4); // => [1,2,3,4]

append(1,2,3,4); // => throws "No method found for append with args: number,number,number,number

append.defmethod('Array,Array', function (a,b) { return a.concat(b); });

append.defmethod('*,Array', function (a,b) { return [a].concat(b); });

append.defmethod('Array,*', function (a,b) { return a.concat([b]); });

append([1,2],[3,4]); // => [1,2,3,4]

append(1,[2,3,4]); // => [1,2,3,4]

append([1,2,3],4); // => [1,2,3,4]

append(1,2,3,4); // => throws "No method found for append with args: number,number,number,number

Here’s a link directly to the exercise, but if you register for the site with this link, I get bonus points.

]]>About two weeks ago, I found David Hestenes’s paper Old Wine in New Bottles: A new algebraic framework for computational geometry. In that paper, he describes a way to use Clifford Algebras to unify the representation of points, lines, planes, hyperplanes, circles, spheres, hyperspheres, etc. This was a big bonus. By using a projective basis, we can unify the orientation and offset. By using a null basis, we can bring in lines, planes, hyperplanes, circles, spheres, and hyperspheres.

The null basis ends up giving you a point at infinity. Every line goes through the point at infinity. None of the circles do. But, if you think of a line as a really, really big circle that goes through infinity, now you have unified lines and circles. Circles and lines are both defined by three points in the plane. (Technically, you can define a line with any three collinear points, but then you need to craft a point collinear to the other two. The point at infinity is collinear with every line. Further, such things could be seen as flattened circles having finite extent (diameter equal to the distance between the furthest apart of the three points) rather than an infinite line.)

So, I need to use Clifford algebras with a projective and null basis. All of the playing I previously did with Clifford algebras was using an orthonormal basis.

To make a Clifford algebra, one starts with a vector space. A vector space has a field of scalars (real numbers, usually) and vectors. You can multiply any vector by a scalar to get another vector. And, if and are scalars and is a vector, then . And, of course, we want (in fact, even if weren’t exactly, we’re always going to be multiplying by at least , so we can recast our thinking to think about any place we write ).

You can add together any two vectors to get another vector. Further, this addition is completely compatible with the scalar multiplication so that and . This of course means that every vector has a negative vector. Further for all vectors and . This is the distinguished vector called the zero vector. The sum of any vector and the zero vector is just the vector .

Every vector space has a basis (though some have an infinite basis). A basis is a minimal subset of the vectors such that every vector vector can be written as the sum of multiples of the basis vectors. So, if the whole basis is and , then every vector can be written as . A basis is a minimal subset in that no basis element can be written as the sum of multiples of the other elements. Equivalently, this means that the only way to express the zero vector with the basis is by having every basis element multiplied by the scalar zero.

You need more than just a vector space to make a Clifford algebra. You need either a quadratic form or a dot-product defined on the vectors.

A quadratic form on a vector is a function that takes in a vector and outputs a scalar. Further, for all scalars and all vectors .

A dot product is a function that takes two vectors and outputs a scalar. A dot product must be symmetric so that for all vectors and . Furthermore, the dot product must be linear in either term. (Since it’s symmetric, it suffices to require it be linear in either term.) This means that for all scalars and and all vectors , , and then .

From any dot product, you can make a quadratic form by saying . And, so long as you’re working with scalars where one can divide by two (aka, almost always), you can make a dot product from a quadratic form by saying . So, it doesn’t really matter which you have. I’m going to freely switch back and forth between them here for whichever is most convenient for the task at hand. I’ll assume that I have both.

So, let’s say we have a dot product on our vector space. What happens when we take the dot product on pairs of our basis vectors? If and are distinct elements of our basis with , then and are said to be orthogonal (basis elements). If every element of the basis is orthogonal to every other basis element, then we have an orthogonal basis.

We say a basis element is normalized if . If all of the basis vectors are normalized, we have a normal basis.

An orthonormal basis is a basis that’s both an orthogonal basis and a normal basis.

You can represent any dot product as a symmetric matrix . To find , you multiply . Further, you can always decompose a scalar matrix into the form where is a diagonal matrix (a matrix where all of the elements off of the diagonal are zero) and . Because of that, you can always find an orthogonal basis for a vector space. So, with just a little bit of rotating around your original choice of basis set, you can come up with a different basis that is orthogonal.

If your orthogonal basis is not normalized, you can (almost always) normalize the basis vectors where by dividing it by the square root of . If any of the elements on the diagonal in the diagonal matrix are zero, then you didn’t have a minimal set for a basis.

So, as long as you can divide by square roots in whatever numbers system you chose for your scalars, then you can find an orthonormal basis. That means that is either or for every basis vector . It also means (going back to dot product) that for distinct basis vectors and .

You can also re-order your basis set so that all of the vectors come first and all of the vectors are last. So, much of the literature on Clifford algebras (and all of the stuff that I had done before with them) uses such a basis. If the field of scalars is the real numbers , then we abbreviate the Clifford algebra as when there are basis vectors where and basis vectors where .

I mentioned at the outset that the Hestenes paper uses a projective basis that’s also a null basis. If you’ve done any geometry in computers before you have probably bumped into projective coordinates. If you have a 3d-vector then you turn it into a projective coordinate by making it a 4d-vector that ends with giving you . Now, you take your three by three rotation matrices and extend them to four by four matrices. This lets you incorporate rotations and translations into the same matrix instead of having to track a rotation and an offset.

What about a null basis though? With a null basis, for each (some?) of the basis vectors. The key point for me here is that the matrix representing the dot product isn’t diagonal. As an easy example, if we have a basis with two basis vectors and , then we can represent any vector as . If we have , then that is an orthonormal basis (with and ). If we picked two different basis vectors and then we would represent as . We could pick them so that . This would be a null basis because .

Once you have a vector space and a quadratic form or dot product, then you make a Clifford algebra by defining a way to multiply vectors together. For Clifford algebras, we insist that when we multiply a vector by itself, the result is exactly . Then, we go about building the biggest algebra we can with this restriction.

Let’s look at what happens when we have two vectors and . Our Clifford restriction means that . We want multiplication to distribute with addition just like it does in algebra so the left hand side there should be: . Note: we haven’t yet assumed that our multiplication has to be commutative, so we can’t reduce that to .

Remember, now, the connection between the quadratic form and the dot product . We have, for the right hand side, that . Now, we use the fact that the dot product is linear in both terms to say that . Using the connection to the quadratic form again and the fact that the dot product *is* symmetric, we can simplify that to .

Because and , we can simplify our original equation to be .

If , then the above reduces to the definitional . If and are distinct basis vectors in our orthogonal basis, then . This means that . So, our multiplication of distinct basis vectors anticommutes!

Now, given an arbitrary vector, we can express it as a sum of multiples of the basis vectors: where the are all scalars and the are all basis vectors in our orthogonal basis. Given two such vectors we can do all of the usual algebraic expansion to express the product of the two vectors as a sum of multiples of products of pairs of basis vectors. Any place where we end up with we can replace it with the scalar number . Any place we end up with with , we can leave it as it is. Any place we end up with with , we can replace it with . Then, we can gather up like terms.

So, suppose there were two vectors in our orthonormal basis and . And, assume and . Then expands out to . We can then manipulate that as outlined in the previous paragraph to whittle it down to .

We still don’t know what is exactly, but we’re building a big-tent algebra here. We don’t have a restriction that says it has to be something, so it gets to be its own thing unless our restrictions hold it back. How big is our tent going to be? Well, let’s see what happens if we multiply by other things we already know about.

What happens if we multiply ? We want our multiplication to be associative. So, and because , this is just . Well, what if we had multiplied in the other order? . Interesting. By similar reasoning, and .

What happens if we multiply . This is just a combination of the above sorts of things and we find that

So, that’s as big as our tent is going to get with only two vectors in our orthonormal basis.

Our Clifford algebra then has elements composed of some multiple of the scalar plus some multiple of plus some multiple of plus some multiple of . If we had added a third basis vector , then we also get , , and . In general, if you have vectors in the basis of the vector space, then there will be basis elements in the corresponding Clifford algebra.

You can rework any term so that the subscripts of the basis vectors are monotonically increasing by swapping adjacent basis vectors with differing subscripts changing the sign on at the same time. When you have two side-by-side with the same subscript, annihilate them and multiply the coefficient by (which was either or ). Then, you have a reduced term where the subscripts are strictly increasing.

The Hestenes paper doesn’t use an orthonormal basis. I’d never played with Clifford algebras outside of one. It took me about two weeks of scrounging through text books and information about something called the contraction product and the definitions of Clifford algebras in terms of dot-products plus something called the outer product (which gives geometric meaning to our new

things like ).

I learned a great deal about how to multiply vectors, but I didn’t feel that much closer to being able to multiply unless the basis was orthonormal. I felt like I’d have to know things like the dot product of a vector with something like and then somehow mystically mix in the contraction product and extend by linearity

.

There’s a whole lot of extending by linearity

in math. In some cases, I feel like extending by linearity leaves me running in circles. (To go with the theme, sometimes I’m even running in a really big circle through the point at infinity.) We did a bit of extending by linearity above when we went from into what must be based on the linearity in the dot product.

Finally, something clicked for me enough to figure out how to multiply and express it as a sum of terms in which the basis vectors in each term had increasing subscripts. Now that it has clicked, I see how I should have gone back to one of our very first equations: . With our orthogonal basis, was always zero for distinct basis vectors.

If we don’t have an orthogonal basis, then the best we can do is . That is good enough. Suppose then we want to figure out so that none of the terms have subscripts out of order. For brevity, let me write to mean . The first things we see out of order are and . To swap those, we have to replace with . Now, we have . With a little bit of algebra, this becomes . That last term is still not in order, so we still have more to do.

Whew. Now, to get that into code.

In the end, I ended up with this 26 SLOC function that takes in a matrix `dots`

to represent the dot product and some number of ordered lists of subscripts and returns a list of scalars where the scalar in spot represents the coefficient in front of the ordered term where the -th basis vector is involved if the -th bit of is set. So, for the example we just did with the call `(basis-multiply dots '(1 4) '(3) '(1))`

, the zeroth term in the result would be . The fifth term (-th term) would be . The ninth term would be . The twelfth term would be . The rest of the terms would be zero.

From this, I will be able to build a function that multiplies arbitrary elements of the Clifford algebra. Getting to this point was the hard part for me. It is 26 SLOC that took me several weeks of study to figure out how to do on paper and about six hours of thinking to figure out how to do in code.

(defun basis-multiply (dots &rest xs)

(let ((len (expt 2 (array-dimension dots 0))))

(labels ((mul (&rest xs)

(let ((xs (combine-adjacent (remove nil xs))))

(cond

((null xs)

(vec len 0))

((null (rest xs))

(vec len (from-bits (first xs))))

(t

(destructuring-bind (x y . xs) xs

(let ((a (first (last x)))

(b (first y))

(x (butlast x))

(y (rest y)))

(if (= a b)

(combine-like x a y xs)

(swap-ab x a b y xs))))))))

(dot (a b)

(aref dots (1- a) (1- b)))

(combine-like (x a y xs)

;; X e1 e1 Y ... = (e1.e1) X Y ...

(vs (dot a a) (apply #'mul x y xs)))

(swap-ab (x a b y xs)

;; X e2 e1 Y ... = 2(e1.e2) X Y ... - X e1 e2 Y ...

(v- (vs (* 2 (dot a b)) (apply #'mul x xs))

(apply #'mul x (list b a) y xs))))

(apply #'mul xs))))

(let ((len (expt 2 (array-dimension dots 0))))

(labels ((mul (&rest xs)

(let ((xs (combine-adjacent (remove nil xs))))

(cond

((null xs)

(vec len 0))

((null (rest xs))

(vec len (from-bits (first xs))))

(t

(destructuring-bind (x y . xs) xs

(let ((a (first (last x)))

(b (first y))

(x (butlast x))

(y (rest y)))

(if (= a b)

(combine-like x a y xs)

(swap-ab x a b y xs))))))))

(dot (a b)

(aref dots (1- a) (1- b)))

(combine-like (x a y xs)

;; X e1 e1 Y ... = (e1.e1) X Y ...

(vs (dot a a) (apply #'mul x y xs)))

(swap-ab (x a b y xs)

;; X e2 e1 Y ... = 2(e1.e2) X Y ... - X e1 e2 Y ...

(v- (vs (* 2 (dot a b)) (apply #'mul x xs))

(apply #'mul x (list b a) y xs))))

(apply #'mul xs))))

I had one false start on the above code where I accidentally confounded the lists that I was using as input with the lists that I was generating as output. I had to step back and get my code to push all of the work down the call stack while rolling out the recursion and only creating new vectors during the base cases of the recursion and only doing vector subtractions while unrolling the recursion.

There are also 31 SLOC involved in the `combine-adjacent`

function (which takes a list like `((1 2 3) nil (4 5) (3))`

and removes the nils then concatenates consecutive parts that are in order already to get `((1 2 3 4 5) (3))`

), the `vec`

function (which makes a vector of a given length with a non-zero coefficient in a given location), the `from-bits`

function (which turns a list of integers into a number with the bit set if is in the list) and the little functions like `vs`

and `v-`

(which, respectively, scale a list of numbers by a factor and element-wise subtract two lists).

The 31 supporting SLOC were easy though. The 26 SLOC shown above represent the largest thought-to-code ratio of any code that I’ve ever written.

WO0T!!!t!1! or something!

Now, to Zig this SLOC for Great Justice!

]]>The Bowling Game Kata in Functional Common Lisp from Patrick Stein on Vimeo.

Code Kata are repetitive coding tasks designed to help one internalize certain patterns, methodologies, or tools. In this video, I go through Uncle Bob Martin’s The Bowling Game Kata. The Kata exercises test-driven development. Uncle Bob’s presentation of the Kata is in Java. This is in Common Lisp using a functional approach.

In my previous video in this series, I employed an imperative style. Here, I use a functional style where all of the data is immutable.

Git repository: https://github.com/nklein/kata

]]>The first question that I wanted to look at was: How well does talkativeness on IRC follow a Power Law?

It looks pretty close when you’re looking at the raw data if you limit yourself to the top 100 to 300 people. Once you get up near the top 500 people, the best-fit curve really skyrockets way through the roof. There are just tons of speakers who have said one or two lines in the given time period. And, I made no effort to track lurkers so I have no zeros in my data set.

Here is a plot of the top 250 speakers (ranked by lines spoken). `stassats`

is the leader, followed by `pjb`

, then `H4ns`

, then `Xach`

. I made a best-effort to collate different handles for the same person (e.g. `Xach_`

vs. `Xach`

). The least-squares, best-fit power-law curve here is . So, if we’re going to match the curve exactly, we’ll need `stassats`

to talk more than twice as much. If you’d like to know how much more (or less) you should talk, drop me a note.

Click on the image above for the full-size version. I used `optima.ppcre`

to read the log files and `vecto`

to draw the graph. Here is the relevant source code: package.lisp, read.lisp, and power.lisp.

SICP has a few sections devoted to using a general, damped fixed-point iteration to solve square roots and then nth-roots. The Functional Programming In Scala course that I did on Coursera did the same exercise (at least as far as square roots go).

The idea goes like this. Say that I want to find the square root of five. I am looking then for some number so that . This means that I’m looking for some number so that . So, if I had a function and I could find some point where , I’d be done. Such a point is called a fixed point of .

There is a general method by which one can find a fixed point of an arbitrary function. If you type some random number into a calculator and hit the “COS” button over and over, your calculator is eventually going to get stuck at 0.739085…. What happens is that you are doing a recurrence where . Eventually, you end up at a point where (to the limits of your calculator’s precision/display). After that, your stuck. You’ve found a fixed point. No matter how much you iterate, you’re going to be stuck in the same spot.

Now, there are some situations where you might end up in an oscillation where , but for some . To avoid that, one usually does the iteration for some averaging function . This “damps” the oscillation.

In languages with first-class functions, it is easy to write a higher-order function called `fixed-point`

that takes a function and iterates (with damping) to find a fixed point. In SICP and the Scala course mentioned above, the `fixed-point`

function was written recursively.

(defun fixed-point (fn &optional (initial-guess 1) (tolerance 1e-8))

(labels ((close-enough? (v1 v2)

(<= (abs (- v1 v2)) tolerance))

(average (v1 v2)

(/ (+ v1 v2) 2))

(try (guess)

(let ((next (funcall fn guess)))

(cond

((close-enough? guess next) next)

(t (try (average guess next)))))))

(try (* initial-guess 1d0))))

(labels ((close-enough? (v1 v2)

(<= (abs (- v1 v2)) tolerance))

(average (v1 v2)

(/ (+ v1 v2) 2))

(try (guess)

(let ((next (funcall fn guess)))

(cond

((close-enough? guess next) next)

(t (try (average guess next)))))))

(try (* initial-guess 1d0))))

It is easy to express the recursion there iteratively instead if that’s easier for you to see/think about.

(defun fixed-point (fn &optional (initial-guess 1) (tolerance 1e-8))

(flet ((close-enough? (v1 v2)

(<= (abs (- v1 v2)) tolerance))

(average (v1 v2)

(/ (+ v1 v2) 2)))

(loop :for guess = (* initial-guess 1d0) :then (average guess next)

:for next = (funcall fn guess)

:until (close-enough? guess next)

:finally (return next))))

(flet ((close-enough? (v1 v2)

(<= (abs (- v1 v2)) tolerance))

(average (v1 v2)

(/ (+ v1 v2) 2)))

(loop :for guess = (* initial-guess 1d0) :then (average guess next)

:for next = (funcall fn guess)

:until (close-enough? guess next)

:finally (return next))))

Above, we showed that the square root of is a fixed point of the function . Now, we can use that to write our own square root function:

(defun my-sqrt (n)

(fixed-point (lambda (x) (/ n x)))

(fixed-point (lambda (x) (/ n x)))

By the same argument we used with the square root, we can find the -th root of 5 by finding the fixed point of . We can make a function that returns a function that does k-th roots:

(defun kth-roots (k)

(lambda (n)

(fixed-point (lambda (x) (/ n (expt x (1- k)))))))

(setf (symbol-function 'cbrt) (kth-root 3))

(lambda (n)

(fixed-point (lambda (x) (/ n (expt x (1- k)))))))

(setf (symbol-function 'cbrt) (kth-root 3))

I found myself wanting to find inverses of various complicated functions. All that I knew about the functions was that if you restricted their domain to the unit interval, they were one-to-one and their domain was also the unit interval. What I needed was the inverse of the function.

For some functions (like ), the inverse is easy enough to calculate. For other functions (like ), the inverse seems possible but incredibly tedious to calculate.

Could I use fixed points to find inverses of general functions? We’ve already used them to find inverses for . Can we extend it further?

After flailing around Google for quite some time, I found this article by Chen, Lu, Chen, Ruchala, and Olivera about using fixed-point iteration to find inverses for deformation fields.

There, the approach to inverting was to formulate and let . Then, because

That leaves the relationship that . The goal then is to find a fixed point of .

I messed this up a few times by conflating and so I abandoned it in favor of the tinkering that follows in the next section. Here though, is a debugged version based on the cited paper:

(defun pseudo-inverse (fn &optional (tolerance 1d-10))

(lambda (x)

(let ((iterant (lambda (v)

(flet ((u (x)

(- (funcall fn x) x)))

(- (u (+ x v)))))))

(+ x (fixed-point iterant 0d0 tolerance)))))

(lambda (x)

(let ((iterant (lambda (v)

(flet ((u (x)

(- (funcall fn x) x)))

(- (u (+ x v)))))))

(+ x (fixed-point iterant 0d0 tolerance)))))

Now, I can easily check the average variance over some points in the unit interval:

(defun check-pseudo-inverse (fn &optional (steps 100))

(flet ((sqr (x) (* x x)))

(/ (loop :with dx = (/ (1- steps))

:with inverse = (pseudo-inverse fn)

:repeat steps

:for x :from 0 :by dx

:summing (sqr (- (funcall fn (funcall inverse x)) x)))

steps)))

(check-pseudo-inverse #'identity) => 0.0d0

(check-pseudo-inverse #'sin) => 2.8820112095939962D-12

(check-pseudo-inverse #'sqrt) => 2.7957469632748447D-19

(check-pseudo-inverse (lambda (x) (* x x x (+ (* x (- (* x 6) 15)) 10))))

=> 1.3296561385041381D-21

(flet ((sqr (x) (* x x)))

(/ (loop :with dx = (/ (1- steps))

:with inverse = (pseudo-inverse fn)

:repeat steps

:for x :from 0 :by dx

:summing (sqr (- (funcall fn (funcall inverse x)) x)))

steps)))

(check-pseudo-inverse #'identity) => 0.0d0

(check-pseudo-inverse #'sin) => 2.8820112095939962D-12

(check-pseudo-inverse #'sqrt) => 2.7957469632748447D-19

(check-pseudo-inverse (lambda (x) (* x x x (+ (* x (- (* x 6) 15)) 10))))

=> 1.3296561385041381D-21

When I had abandoned the above, I spent some time tinkering on paper. To find , I need to find so that . Multiplying both sides by and dividing by , I get . So, to find , I need to find a that is a fixed point for :

(defun pseudo-inverse (fn &optional (tolerance 1d-10))

(lambda (x)

(let ((iterant (lambda (y)

(/ (* x y) (funcall fn y)))))

(fixed-point iterant 1 tolerance))))

(lambda (x)

(let ((iterant (lambda (y)

(/ (* x y) (funcall fn y)))))

(fixed-point iterant 1 tolerance))))

This version, however, has the disadvantage of using division. Division is more expensive and has obvious problems if you bump into zero on your way to your goal. Getting rid of the division also allows the above algorithms to be generalized for inverting endomorphisms of vector spaces (the function being the only slightly tricky part).

I finally found a use of the `fixed-point`

function that goes beyond -th roots. Wahoo!

`WITH-TRACK-BEST`

macro now accepts the `:KEEP-TIES`

keyword parameter.
Here are some examples of using the `:KEEP-TIES`

option. For all of the examples, we will use the same sequence of `TRACK`

calls:

(defun track-numbers ()

(track :one 1)

(track :uno 1)

(track :two 2)

(track :dos 2)

(track :one 1)

(track :uno 1)

(track :two 2)

(track :dos 2)

Here are some calls with `:KEEP-TIES`

as `NIL`

(the default):

(with-track-best (:keep 1 :keep-ties nil) (track-numbers))

=> (values :TWO 2)

(with-track-best (:keep 3 :keep-ties nil) (track-numbers))

=> (values (:TWO :DOS :ONE) (2 2 1))

=> (values :TWO 2)

(with-track-best (:keep 3 :keep-ties nil) (track-numbers))

=> (values (:TWO :DOS :ONE) (2 2 1))

Here are some calls with `:KEEP-TIES`

as `T`

:

(with-track-best (:keep 1 :keep-ties t) (track-numbers))

=> (values (:TWO :DOS) (2 2))

(with-track-best (:keep 3 :keep-ties t) (track-numbers))

=> (values (:TWO :DOS :ONE :UNO) (2 2 1 1))

=> (values (:TWO :DOS) (2 2))

(with-track-best (:keep 3 :keep-ties t) (track-numbers))

=> (values (:TWO :DOS :ONE :UNO) (2 2 1 1))

`REDUCE`

and `LOOP`

to try to find the best one (or two or three) things in a big bag of things based on various criteria: similarity to English, hamming distance from their neighbor, etc.
I wrote a macro that encapsulated the pattern. I’ve reworked that macro into a library for public use.

- Home page: http://nklein.com/software/track-best-library/
- Main git repository: http://git.nklein.com/lisp/libs/track-best.git
- Browsable repository: https://github.com/nklein/track-best

There are a variety of examples in the README and the tests directory.

Here is one example to pique your interest. Suppose you have some data about the elevations of various cities in various states and you (being a Moxy Fruvous fan) want to know What Is the Lowest Highest Point?

Here’s how you might tackle that with the `TRACK-BEST`

library:

(let ((data '(("Alabama" ("Birmingham" 664)

("Mobile" 218)

("Montegomery" 221))

("Alaska" ("Anchorage" 144)

("Fairbanks" 531))

("Arizona" ("Grand Canyon" 6606)

("Phoenix" 1132)

("Tuscon" 2641)))))

(with-track-best (:order-by-fn #'<)

(dolist (state-info data)

(multiple-value-bind (city altitude)

(with-track-best ()

(dolist (city-info (rest state-info))

(track (first city-info) (second city-info))))

(track (list (first state-info) city) altitude)))))

("Mobile" 218)

("Montegomery" 221))

("Alaska" ("Anchorage" 144)

("Fairbanks" 531))

("Arizona" ("Grand Canyon" 6606)

("Phoenix" 1132)

("Tuscon" 2641)))))

(with-track-best (:order-by-fn #'<)

(dolist (state-info data)

(multiple-value-bind (city altitude)

(with-track-best ()

(dolist (city-info (rest state-info))

(track (first city-info) (second city-info))))

(track (list (first state-info) city) altitude)))))

With this limited dataset, the end result would be `(VALUES '("Alaska" "Fairbanks") 531)`

. The inner `WITH-TRACK-BEST`

finds the highest city in each state. The outer `WITH-TRACK-BEST`

finds the lowest of these.

I read an article about Treaps on reddit yesterday. The article used pretty direct pylisp to present Treaps.

I thought it would be fun to go through the exercise in Common Lisp instead. Pylisp made a number of things awkward that would melt away in Common Lisp.

I began by defining a node structure to encapsulate the information at a given node:

(defstruct node

(priority (random 1.0d0) :type real :read-only t)

(key 0 :read-only t)

(value 0 :read-only t)

(left nil :type (or null node) :read-only t)

(right nil :type (or null node) :read-only t))

(priority (random 1.0d0) :type real :read-only t)

(key 0 :read-only t)

(value 0 :read-only t)

(left nil :type (or null node) :read-only t)

(right nil :type (or null node) :read-only t))

Then, I defined a top-level structure to hold the root node, track the function used to sort the tree, and track the function used to create a key from a value. I used the convention that two keys are equivalent if neither is less than the other.

(defstruct treap

(root nil :type (or null node) :read-only t)

(less-than #'< :read-only t)

(key #'identity :read-only t))

(root nil :type (or null node) :read-only t)

(less-than #'< :read-only t)

(key #'identity :read-only t))

The article was using a functional style. As you may have guessed by the liberal use of `:read-only t`

in those `DEFSTRUCT`

clauses, I also used a functional style.

When working with functional data structures, one often needs to copy a whole structure with only slight modifications. Here, Lisp’s keyword arguments made everything simple and clean. I made this functions:

(defun copy-node (node &key (priority (node-priority node))

(key (node-key node))

(value (node-value node))

(left (node-left node))

(right (node-right node)))

(make-node :priority priority

:key key

:value value

:left left

:right right))

(key (node-key node))

(value (node-value node))

(left (node-left node))

(right (node-right node)))

(make-node :priority priority

:key key

:value value

:left left

:right right))

Now, for any node, I could copy it and only have to specify the fields that I wanted to change. Here is a left-rotation using this:

(defun left-rotate (node)

(let ((left (node-left node)))

(copy-node left

:right (copy-node node

:left (node-right left)))))

(let ((left (node-left node)))

(copy-node left

:right (copy-node node

:left (node-right left)))))

What other languages let you do anything like that so simply? You could pull it off in Perl if you were willing to have your node be a hash (which, admittedly, you probably are if you’re writing Perl). What other language lets you do anything like that? Even other languages with named arguments don’t let you have the defaults based on other arguments.

As with any binary tree, you find yourself having to deal with four specific cases over and over again with Treaps.

- You ran out of tree
- Your key is less than the current node’s key
- Your key is greater than the current node’s key
- Your key is equivalent to the current node’s key

I wrote myself a `TREAP-CASES`

macro that streamlines all of these checks. It also validates to make sure you don’t have duplicate cases or cases other than these four. It makes sure that no matter which order you write the cases (or even if you leave some out), they end up organized in the order listed above. The four cases are mutually exclusive so the order doesn’t matter except that you want to make sure you haven’t run out of tree before doing comparisons and that once you’re beyond the less-than and greater-than cases you already know you’re in the equivalence case.

With this macro, my `TREAP-FIND`

function looks like this:

(defun treap-find (key treap)

(check-type treap treap)

(labels ((treap-node-find (root)

(treap-cases (key root treap)

(null (values nil nil))

(< (treap-node-find (node-left root)))

(> (treap-node-find (node-right root)))

(= (values (node-value root) t)))))

(treap-node-find (treap-root treap))))

(check-type treap treap)

(labels ((treap-node-find (root)

(treap-cases (key root treap)

(null (values nil nil))

(< (treap-node-find (node-left root)))

(> (treap-node-find (node-right root)))

(= (values (node-value root) t)))))

(treap-node-find (treap-root treap))))

The little DSL makes writing and reading the code so much easier. All of the mess of comparing the key to the node’s key is hidden away.

With years of practice and days of debugging, you might be able to pull off some quasi-readable control construct like this using C++ templates. With enough therapy, you could convince yourself you can get a close-enough effect with C-preprocessor macros. In Lisp, it’s the work of minutes (without lying to yourself).

Here is the `TREAP-CASES`

macro for reference/completeness.

(defmacro treap-cases ((key root treap) &rest clauses)

(validate-treap-case-clauses clauses)

(let ((k (gensym "KEY-"))

(tr (gensym "TREAP-"))

(r (gensym "ROOT-"))

(t< (gensym "<-")))

`(let* ((,k ,key)

(,tr ,treap)

(,r ,root)

(,t< (treap-less-than ,tr)))

(cond

((null ,r) ,@(rest (assoc 'null clauses)))

((funcall ,t< ,k (node-key ,r)) ,@(rest (assoc '< clauses)))

((funcall ,t< (node-key ,r) ,k) ,@(rest (assoc '> clauses)))

(t ,@(rest (assoc '= clauses)))))))

(validate-treap-case-clauses clauses)

(let ((k (gensym "KEY-"))

(tr (gensym "TREAP-"))

(r (gensym "ROOT-"))

(t< (gensym "<-")))

`(let* ((,k ,key)

(,tr ,treap)

(,r ,root)

(,t< (treap-less-than ,tr)))

(cond

((null ,r) ,@(rest (assoc 'null clauses)))

((funcall ,t< ,k (node-key ,r)) ,@(rest (assoc '< clauses)))

((funcall ,t< (node-key ,r) ,k) ,@(rest (assoc '> clauses)))

(t ,@(rest (assoc '= clauses)))))))

I suppose I should also include `#'VALIDATE-TREAP-CASE-CLAUSES`

, too, but it’s what you’d expect:

(defun validate-treap-case-clauses (clauses)

(let ((all-choices '(null < > =)))

(flet ((assert-all-choices-valid ()

(dolist (c clauses)

(unless (member (first c) all-choices)

(error "Unrecognized clause type: ~S" (first c)))))

(assert-no-duplicates ()

(dolist (c all-choices)

(unless (<= (count c clauses :key #'first) 1)

(error "Duplicate ~S clause not allowed." c)))))

(assert-all-choices-valid)

(assert-no-duplicates))))

(let ((all-choices '(null < > =)))

(flet ((assert-all-choices-valid ()

(dolist (c clauses)

(unless (member (first c) all-choices)

(error "Unrecognized clause type: ~S" (first c)))))

(assert-no-duplicates ()

(dolist (c all-choices)

(unless (<= (count c clauses :key #'first) 1)

(error "Duplicate ~S clause not allowed." c)))))

(assert-all-choices-valid)

(assert-no-duplicates))))