Planet Lisp

Joe MarshallA use of Newton's method

· 5 hours ago
I've seen more than one book claim that computing with real numbers inevitably involves round-off errors because real numbers can have an infinite number of digits after the decimal point and no finite representation can hold them. This is false. Instead of representing a real number as a nearby rational number with an error introduced by rounding, we'll represent a real number as computer program that generates the digits. The number of digits generated is potentially infinite, but the program that generates them is definitely finite.

Here is Gosper's algorithm for computing the square root of a rational number.
(define (gosper-sqrt a b c d)
  ;;   Solve for
  ;; ax + b 
  ;; ------  = x
  ;; cx + d
  (define (newtons-method f f-prime guess)
    (let ((dy (f guess)))
      (if (< (abs dy) 1)
   guess
   (let ((dy/dx (f-prime guess)))
     (newtons-method f f-prime (- guess (/ dy dy/dx)))))))

  (define (f x)
    (+ (* c x x)
       (* (- d a) x)
       (- b)))

  (define (f-prime x)  
    (+ (* 2 c x)
       (- d a)))

  (let ((value (floor (newtons-method f f-prime (+ a c)))))
    (cons-stream value
   (gosper-sqrt (+ (* c value) d)
         c
         (+ (* (- a (* value c)) value) 
     (- b (* value d)))
         (- a (* value c))))))

1 ]=> (cf:render (gosper-sqrt 0 17 10 0))
1.303840481040529742916594311485836883305618755782013091790079369...

;; base 10, 100 digits
1 ]=> (cf:render (gosper-sqrt 0 17 10 0) 10 100)
1.303840481040529742916594311485836883305618755782013091790079369896765385576397896545183528886788497...

Clozure CL BlogClozure CL 1.10 pre-release available for testing

· 8 hours ago

Please see this openmcl-devel message if you would be interested in testing a pre-release version of CCL 1.10.

Ben HydeGraphical Programming and yEd

· 10 hours ago

Graphical programming languages are like red sports cars.  They have lots of curb appeal, but they are rarely safe and reliable.

I long worked for a company whose product featured a very rich graphic programming. It allowed an extremely effective sales process.  The salesman would visit the customer who would sketch a picture of his problem on the whiteboard, and the salesman would enquire about how bad things would get if the problem didn’t get solved.

Meanwhile in the corner the sales engineer would copy the drawing into his notebook.  That night he would create an app in our product who’s front page looked as much like that drawing as possible.  It didn’t really matter if it did anything, but it usually did a little simulation and some icons would animate and some charts’ would scroll.  The customers would be very excited by these little demos.

I consider those last two paragraphs a delightful bit of sardonic humor.  But such products do sell well.   Customers like how pretty they look.  Sales likes them.  Engineering gets to have mixed feelings.  The maintenance contracts can be lucrative.  Thathelps with buisness model volatility.  So yeah, there is plenty of value in graphical programming.

So one of the lightning talks at ILC 2014 caught my attention.  The speaker, Paul Tarvydas, mentioned in passing that he had a little hack based on a free drawing application called yEd.  That evening I wrote a similar little hack.

Using yEd you can make an illustrations, like this one showing the software release process for most startups.

My few lines of code will extract the topology from the drawing, at which point you can build whatever strikes your fancy: code, ontologies, data structures.  (Have I mentioned how much fun it is to use Optima to digest into a glob of XML?  Why yes I have.)

I was also provoked by Fare Rideaus‘ talk.  Fare is evangelizing the idea that we ought to start using Lisp for scripting.   He has a package, cl-launch, intended to support this.  Here’s an example script.   Let’s dump the edges in that drawing:

bash-3.2$ ./topology.sh abc.graphml
Alpha -> Beta
Beta -> Cancel
Beta -> Beta
Beta -> Beta
bash-3.2$

I’ve noticed, dear Reader, that you are very observant.  It’s one of the things I admire about you.  So you wondering: “Yeah Ben, you found too many edges!”   Well, I warned you that these sports cars are rarely safe.  Didn’t I?

Joe MarshallSolutions in search of problems

· 26 hours ago
Suppose you have a function like (define foo (lambda (x) (- (* x x x) 30))) and you want to find x such that (foo x) = 0. There are a few ways to go about this. If you can find two different x such that (foo x) is positive for one and negative for the other, then (foo x) must be zero somewhere in between. A simple binary search will find it.
(define (bisection-method f left right)
  (let* ((midpoint (average left right))
         (fmid     (f midpoint)))
    (if (< (abs fmid) 1e-8)
        midpoint
        (let ((fl (f left))
              (fr (f right)))
          (cond ((same-sign? fl fr) (error "Left and right not on opposite sides."))
                ((same-sign? fmid fr) (bisection-method f left midpoint))
                ((same-sign? fl fmid) (bisection-method f midpoint right))
                (else (error "shouldn't happen")))))))

(define (average l r) (/ (+ l r) 2))

(define (same-sign? l r)
  (or (and (positive? l)
           (positive? r))
      (and (negative? l)
           (negative? r))))

1 ]=> (cos 2)

;Value: -.4161468365471424

1 ]=> (cos 1)

;Value: .5403023058681398

1 ]=> (bisection-method cos 1.0 2.0)
1. 2.
1.5 2.
1.5 1.75
1.5 1.625
1.5625 1.625
1.5625 1.59375
1.5625 1.578125
1.5703125 1.578125
1.5703125 1.57421875
1.5703125 1.572265625
1.5703125 1.5712890625
1.5703125 1.57080078125
1.570556640625 1.57080078125
1.5706787109375 1.57080078125
1.57073974609375 1.57080078125
1.570770263671875 1.57080078125
1.5707855224609375 1.57080078125
1.5707931518554687 1.57080078125
1.5707931518554687 1.5707969665527344
1.5707950592041016 1.5707969665527344
1.570796012878418 1.5707969665527344
1.570796012878418 1.5707964897155762
1.570796251296997 1.5707964897155762
1.570796251296997 1.5707963705062866
1.5707963109016418 1.5707963705062866
1.5707963109016418 1.5707963407039642
;Value: 1.570796325802803
Rather than selecting the midpoint between the two prior guesses, you can pretend that your function is linear between the guesses and interpolate where the zero should be. This can converge quicker.
(define (secant-method f x1 x2)
  (display x1) (display " ") (display x2) (newline)
  (let ((f1 (f x1))
        (f2 (f x2)))
    (if (< (abs f1) 1e-8)
        x1
        (let ((x0 (/ (- (* x2 f1) (* x1 f2))
                     (- f1 f2))))
          (secant-method f x0 x1)))))

1 ]=> (secant-method cos 0.0 4.0)
0. 4.
2.418900874126076 0.
1.38220688493168 2.418900874126076
1.5895160570280047 1.38220688493168
1.5706960159120333 1.5895160570280047
1.5707963326223677 1.5706960159120333
;Value: 1.5707963326223677
If you know the derivative of f, then you can use Newton's method to find the solution.
(define (newtons-method f f-prime guess)
  (display guess) (display " ") (newline)
  (let ((dy (f guess)))
    (if (< (abs dy) 1e-8)
        guess
        (let ((dy/dx (f-prime guess)))
          (newtons-method f f-prime (- guess (/ dy dy/dx)))))))

1 ]=> (newtons-method cos (lambda (x) (- (sin x))) 2.0)
2. 
1.5423424456397141 
1.5708040082580965 
1.5707963267948966 
;Value: 1.5707963267948966
Here's another example. We'll find the cube root of 30 by solving (lambda (x) (- (* x x x) 30)).
(define (cube-minus-thirty x) (- (* x x x) 30))

1 ]=> (bisection-method cube-minus-thirty 0.0 4.0)
0. 4.
2. 4.
3. 4.
3. 3.5
3. 3.25
3. 3.125
3.0625 3.125
3.09375 3.125
3.09375 3.109375
3.1015625 3.109375
3.10546875 3.109375
3.10546875 3.107421875
3.1064453125 3.107421875
3.10693359375 3.107421875
3.107177734375 3.107421875
3.107177734375 3.1072998046875
3.107177734375 3.10723876953125
3.107208251953125 3.10723876953125
3.1072235107421875 3.10723876953125
3.1072311401367187 3.10723876953125
3.1072311401367187 3.1072349548339844
3.1072311401367187 3.1072330474853516
3.107232093811035 3.1072330474853516
3.107232093811035 3.1072325706481934
3.1072323322296143 3.1072325706481934
3.107232451438904 3.1072325706481934
3.107232451438904 3.1072325110435486
3.107232481241226 3.1072325110435486
3.1072324961423874 3.1072325110435486
3.107232503592968 3.1072325110435486
3.107232503592968 3.1072325073182583
3.107232505455613 3.1072325073182583
3.107232505455613 3.1072325063869357
;Value: 3.1072325059212744

1 ]=> (secant-method cube-minus-thirty 0.0 4.0)
0. 4.
1.875 0.
8.533333333333333 1.875
2.1285182547245376 8.533333333333333
2.341649751209406 2.1285182547245376
3.4857887202177547 2.341649751209406
3.0068542655016235 3.4857887202177547
3.0957153766467633 3.0068542655016235
3.1076136741672546 3.0957153766467633
3.1072310897513415 3.1076136741672546
3.1072325057801455 3.1072310897513415
;Value: 3.1072325057801455

1 ]=> (define (cube-minus-thirty-prime x) (* 3 x x))

1 ]=> (newtons-method cube-minus-thirty cube-minus-thirty-prime 4.0)
4. 
3.2916666666666665 
3.1173734622300557 
3.10726545916981 
3.1072325063033337 
3.107232505953859 
;Value: 3.107232505953859






Quicklisp newsAugust 2014 dist update now available

· 27 hours ago
New projects:
Updated projects: 3bmd, access, alexandria, architecture.hooks, architecture.service-provider, arnesi+, asdf-finalizers, bit-smasher, black-tie, caveman, chanl, cl+ssl, cl-ana, cl-autowrap, cl-charms, cl-cli, cl-csv, cl-custom-hash-table, cl-dbi, cl-dot, cl-gss, cl-indeterminism, cl-larval, cl-launch, cl-libevent2, cl-opengl, cl-project, cl-qrencode, cl-rethinkdb, cl-sdl2, cl-slp, cl-spark, cl-syntax, cl-test-more, cl-voxelize, cl-yaclyaml, clack, clfswm, clhs, clobber, closer-mop, closure-html, clsql-orm, clss, coleslaw, collectors, colleen, common-lisp-stat, conduit-packages, crane, css-selectors, daemon, datafly, defmacro-enhance, djula, docbrowser, drakma-async, equals, esrap, f2cl, fare-quasiquote, function-cache, gbbopen, graph, hash-set, hermetic, http-parse, hu.dwim.perec, inferior-shell, iolib, let-over-lambda, listoflist, lla, lol-re, marching-cubes, memoize, more-conditions, multiple-value-variants, ningle, nuclblog, optima, packet, parse-number, petit.package-utils, plump, postmodern, purl, qmynd, racer, rutils, scriptl, sdl2kit, shelly, slime, software-evolution, spatial-trees, stumpwm, sxql, trivial-gray-streams, uiop, weblocks-stores, weblocks-utils.

Not included in the summary above: I was able to get gtk3 into my test build environment, so gtk-cffi should now be fully available in Quicklisp. If you have the gtk3 C libraries installed, give it a try and let me know how it goes.

To get this update, use (ql:update-dist "quicklisp").

Enjoy!

GrueWeb scraping with Common Lisp: cookies and stuff

· 36 hours ago

It’s been a long time since my last post, but let’s pick up where I left off.

Read part 1 here!

Often you want to grab some data from a website but you can’t just send a get request to a page, you need to log in first. How does the site even know you’re logged in? Well, attached to each request is a bunch of cookies, which are essentialy name-value pairs. Moreover, the server’s response may update or add new cookies, which are faithfully stored by your browser for some period of time. So when you are logging in to a site the following happens:

  1. You send a POST request with your name and password as parameters.
  2. The server responds by setting up your cookies in a way that allows it to recognize your future requests. Usually it sets a cookie that contains your “session id”, which uniquely identifies your current browser session.
  3. When you make any requests after that, the cookie that contains session id is sent along with them, and the server assumes you are logged in.

As you can see, the whole algorithm hinges on the fact that your browser must store and resend the cookie that the server has set up. And when you are making requests through a library or a command-line tool such as curl or wget, the responsibility to store and pass the cookies lies upon you.

Ok, so with Common Lisp we’re using the DRAKMA library. By default it will not send any cookies, or do anything with received cookies. However if you pass a special cookie jar object as a keyword parameter to http-request, it will send cookies from it, and update them based on the server’s response. If you use the same cookie jar object to POST a login request and later to retrieve some data, usually this will be enough to trick the server into serving you the content behind the authentication wall.

    (let ((cookie-jar (make-instance 'drakma:cookie-jar)))
        (drakma:http-request login-url :method :post :parameters login-parameters :cookie-jar cookie-jar)
        (drakma:http-request data-url :cookie-jar cookie-jar))

I think it’s annoying to always write “:cookie-jar cookie-jar” for every request, so in my library webgunk a special variable *webgunk-cookie-jar* is passed as the requests’ cookie jar (it’s nil by default). So you can instead:

    (let ((*webgunk-cookie-jar* (make-instance 'drakma:cookie-jar)))
        (http-request login-url :method :post :parameters login-parameters)
        (http-request data-url))

Special variables are sure handy. In webgunk/modules I created an object-oriented API that uses this feature and webgunk/reddit is a simple reddit browser based on it. Here’s the code for authorization:

(defmethod authorize ((obj reddit-browser) &key login password)
  (let ((login-url "https://ssl.reddit.com/api/login"))
    (with-cookie-jar obj
      (http-request login-url :method :post
                    :parameters `(("api_type" . "json")
                                  ("user" . ,login)
                                  ("passwd" . ,password))))))

where with-cookie-jar is just

(defmacro with-cookie-jar (obj &body body)
  `(let ((*webgunk-cookie-jar* (get-cookie-jar ,obj)))
     ,@body))

Note that logging in isn’t always as easy. Sometimes the server’s procedure for setting the cookies is rather tricky (e.g. involving Javascript and redirects). However you almost always can trick the server that you’re logged in by logging in with your browser and then copying the cookie values from your browser (this is known as session hijacking, except you’re only hijacking your own session so it’s ok).

For example, I used to play an online game called SaltyBet, in which you place imaginary money bets on which character will win in a fight. The outcome could be predicted by analyzing the past fights of each character. After losing a million of SaltyBucks due to suboptimal betting, I have built a system that would collect the results of past fights from SaltyBet’s own website, calculate and display the stats for each character and also show their most recent fights, and the biggest upsets that they have been involved in. This was incredibly effective and I was able to recoup my lost money twice over!

But anyway, the data was available only to paid members so I needed to log in to scrape it. And the method described above did not work. In the end what worked was a simple:

(defparameter *cookies* 
  '(("PHPSESSID" . "4s5u76vufh0gt9hs6mrmjpioi0")
    ("__cfduid" . "dc683e3c2eb82b6c050c1446d5aa203dd1376731139271")))

(defmethod authorize ((obj saltybet-browser) &key)
  (clear-cookies obj)
  (loop for (name . value) in *cookies*
       do (add-cookie obj (make-instance 'drakma:cookie :name name :value value
                                         :domain ".saltybet.com"))))

How did I get these values? I just copy-pasted them from my Firefox! They were good for a few days, so it wasn’t much hassle at all. Sometimes a stupid solution is the most effective one.

PixelThe Terrible, Horrible, No-Good, Very-Bad Things I Do To PHP (Or: Greenspunning in PHP)

· 46 hours ago

Controller Methods

What we call a “controller method”, at least, is simply a function which is called on the web side via AJAX and returns some value back (generally either JSON or a snippet of HTML).

When I started at my current employer, controller methods looked like this:

class MyController extends Controller {
  function f() {
    if (!$this->required('foo', 'bar', 'baz')) return;
    if (!is_numeric($this->requestvars['foo'])) return;
    // lots of code
    if (isset($this->requestvars['quux'])) {
      // do something with quux
    }
    // more code
    return $someString;
  }
}

Aside from being hideous, this has a number of glaring problems:

  1. The error handling is terrible.
  2. Validation is hard, and thus incredibly easy to screw up or forget entirely.
  3. Even something that should be easy―merely figuring out how to call the method―requires reading and understanding the entire method.

This just won’t do.

Surely it would be much nicer if controller methods could simply be defined like a regular function. Fortunately, PHP offers some manner of reflexive capabilities, meaning we can ask it what arguments a function takes. We can then match up GET/POST parameters by name, and send the function the proper arguments.

In other words, we can define the function more like:

class MyController extends Controller {
  function f($foo, $bar, $baz, $quux = null) {
    // lots of code
    if (isset($quux)) {
      // do something with quux
    }
    // more code
    return new Response\HTML($someString);
  }
}

And have it actually work. That’s much nicer. Now, we can call the method from PHP as easily as we call it from JavaScript, and we don’t have to read the entire function to figure out what arguments it takes.

(The astute reader will also notice I’ve moved to returning an object, so the response has a type. This is super-handy, because now it’s easy to ensure we send the apropriate content-type, enabling the JS side to do more intelligent things with it.)

Of course, this only tells us which arguments it takes, and whether they’re optional or required. We still need easier data validation. PHP provides type hints, but they only work for classes. Or do they?

Type Hints

In a brazen display of potentially ill-advised hackery (our code is a little more involved, but that should give you the general idea), I added an error handler that enables us to define non-class types to validate things.

So now we can do this:

class MyController extends Controller {
  function f(
    int $foo,
    string $bar,
    string $baz,
    int $quux = null
  ) {
    // lots of code
    if (isset($quux)) {
      // do something with quux
    }
    // more code
    return new Response\HTML($someString);
  }
}

And all the machinery ensures that by the time f() is executing, $foo looks like an integer, as does $quux if it was provided.

Now the caller of the code can readily know what the value of the variables should look like, and the programmer of the function doesn’t really have an excuse for not picking a type because it’s so easy.

Of course, this isn’t sufficient yet either. For instance, if I’d like to be able to pass a date into the controller, it has to be a string. Then the writer of the controller has to convert it to an appropriate class. Surely it’d be much nicer if the author of the controller method could say “I want a DateTime object”, which would be automagically converted from a specially-formatted string sent by the client.

Type Conversion via Typehints

Because PHP provides references via the backtrace mechanism, we can modify the parameters a function was called with.

class MyController extends Controller {
  function f(
    int $foo,
    string $bar,
    DateTime $baz,
    int $quux = null
  ) {
    // lots of code
    if (isset($quux)) {
      // do something with quux
    }
    // more code
    return new Response\HTML($someString);
  }
}

So while $baz might be POSTed as baz=2014-08-16, what f() gets is a PHP DateTime object representing that date. Due to the implementation mechanism, even something as simple as:

$mycontroller->f(1, “bar”, “2014-08-16”);

Will result in $baz being a DateTime object inside f().

Caveat

There is an unfortunate caveat, and I have yet to figure out if it’s a quirk of the way I implemented things, or a quirk in the way PHP is implemented, but optional arguments do not change. That is, SomeClass $var = null will result in $var still being a string. func_get_args() will contain the altered value, however.

Multiple Inheritance and Method Combinations

PHP is a single inheritance language. Traits add some ability to build mixins, which is super-handy, but has some annoying restrictions. Particularly around calling methods―in particular, you can’t define a method in a trait, override it in a class which uses a trait, and then call the trait method from the class method. At least, not easily and generally.

Plus there’s no concept of method combinations. It’d be really handy to be able to say “hey, add this stuff to the return value” (e.g., by appending to an array) and have it just happen, rather than having to know how to combine your stuff with the parent method’s stuff.

While I’m sad to say I don’t have this working generally across any class, I have managed to get it working for a particular base class where it’s most useful to our codebase. Subclasses and traits can define certain methods, and when called, the class heirarchy will be automatically walked and the results of calling each method in the heirarchy will be combined.

trait BobsJams {
  static function BobsJams_getAdditionalJams() {
    return [ new CranberryJam(), new StrawberryJam() ];
  }
}

trait JimsJams {
  static function JimsJams_getAdditionalJams() {
    return [ new BlackberryJam() ];
  }
}

class Jams {
  function getJams() {
    return (new MethodCombinator([], 'array_merge'))
      ->execute(new ReflectionClass(get_called_class()), "getAdditionalJams");
  }
}

class FewJams extends Jams {
  static function getAdditionalJams() {
    return [ new PineappleJam() ];
  }
}

class LotsOJams extends FewJams {
  use BobsJams;
  use JimsJams;

  static function getAdditionalJams() {
    return [ new OrangeJam() ];
  }
}

(new LotsOJams())->getJams();
// => [ OrangeJam, CranberryJam, StrawberryJam, BlackberryJam, PineappleJam ]

(The somewhat annoying prefix on the traits’ method names is to avoid forcing users of a trait to deal with name collisions.)

Naturally, all the magic of the getJams() method is hidden away in the MethodCombinator class, but it just walks the class hierarchy―traits included―using the C3 Linearization algorithm, calls those methods, and then combines them all using the combinator function (in this case, array_merge).

This, as you might imagine, greatly simplifies some code.

Oh, but you’re not impressed by shoehorning some level of multiple inheritance into a singly-inherited language? Fine, how about…

Context-Sensitive Object Behavior

Web code tends to be live, while mobile code is harshly asynchronous (as in: still needs to function when you have no signal, and then do something reasonable with data changes when you do have signal again), so what we care about changes between our Mobile API and our Web code, and yet we’d still like to share the basic structure of any given piece of data so we don’t have to write things twice or keep twice as much in our heads.

Heavily inspired by Pascal Costanza’s Context-Oriented-Programming, we define our data structures something like this:

class MyThing extends Struct {
  public $partA;
  public $userID;
  // ...
  function getAdditionalDefaultContextualComponents() {
    return [ new MyThingWebUI(), new MyThingMobileAPI() ];
  }
}

class MyThingWebUI extends Contextual {
  public $isReadOnly;
  // ...
  function getApplicableLayer() { return "WebUI"; }
}

class MyThingMobileAPI extends Contextual {
  public $partB;
  // ...
  function getApplicableLayer() { return "MobileAPI"; }
}

The two Contextual subclasses define things that are only available within particular contexts (layers). Thus, within the context of WebUI, MyThing appears from the outside to look like:

{
  "partA": "foo",
  "userID": 12,
  "isReadOnly": false,
}

But within the Mobile API, that same $myThing object looks like:

{
  "partA": "foo",
  "userID": 12,
  "partB": "bar",
}

In addition to adding new properties, each layer can also exclude keys from JSON serialization, add aliases for keys (thus allowing mobiles to send/fetch data using old_key, when we rename something to new_key), and probably a few other things I’m forgetting.

Conclusion

PHP is remarkably malleable. error_handlers can be used as a poor-man’s handler-bind (unlike exceptions, they run before the stack is unwound, but you’re stuck dispatching on regular expressions if you want more than one); scalar type hints can be provided as a library; and traits can be abused to provide a level of multiple inheritance well beyond what was intended. While this malleability is certainly handy, I miss writing code in a language that doesn’t require jumping through hoops to provide what feel like basic facilities. But I’m also incredibly glad I can draw from the well of ideas in Common Lisp and bring some of that into the lives of developers with less exposure to the fantastic facilities Lisp provides.

Bonus!

My employer is desperate for user feedback, and as such is offering a free eight week trial. So if you want to poke at stuff and mock me when things don’t work very well (my core areas are nutritional analysis for recipes and food-related search results), that’s a thing you can do.

If you're outside the US, I should warn you that we have a number of known bugs and shortcomings you're much more likely to hit (we use a US-based product database; searching for things outside ASCII doesn't work due to MySQL having columns marked as the wrong charset; and there's a lot of weirdness around time because most user times end up stored as unix timestamps). The two bugs will be fixed eventually, but since they're complicated and as the US is our target market they're not exactly at the top of the list.

Don't you just love it when people move to a new blog? I'd 301 redirect you if I could, but since I can't you'll have to click through to read comment count unavailable comments or leave your own.

Dimitri FontaineTurn your PostgreSQL queries into Charts

· 2 days ago

Earlier this year we did compare compare Aggregating NBA data, PostgreSQL vs MongoDB then talked about PostgreSQL, Aggregates and histograms where we even produced a nice Histogram chart directly within the awesome psql console. Today, let's get that same idea to the next level, with pgcharts:

The new pgcharts application

The application's specifications are quite simple: edit an SQL query, set your categories and your data series, add in some legends, and get a nice chart. Currently supported are bar, column, pie and donut charts, and we should be able to add anything that http://www.highcharts.com/ has support for.

Currently, you need to compile the application yourself, and for that you need to install the SBCL compiler. Soon enough you will have a debian package to play with! The README at the pgcharts github place has the details to get you started. Enjoy!

Zach BeaneWhere to get help with Common Lisp

· 2 days ago
There are several options for getting help with Common Lisp.

First, some general sources of help.
Second, some implementation-specific help.

Every implementation has a mailing list. Some have multiple lists, depending on the topic of discussion. Here are some of the lists I know about:
Finally, there's a Quicklisp mailing list for Quicklisp issues. All questions about Quicklisp are welcome.



When appealing to any of these sources for help, asking good questions is critical to getting good results. In many cases, that requires three key bits of information:
Sometimes this info isn't applicable, like for "What is a good book for learning Common Lisp?" (Practical Common Lisp, Paradigms of AI Programming). But in many cases, having those three things readily available will save a lot of time.

There are dozens of people ready and willing to help you with your Common Lisp questions. This can work very well as you're getting oriented and learning the basics. After the basics, though, you may find questions going unanswered: "I'm compiling commonqt for ecls on raspberry pi and I'm getting a segfault in my custom gcc fork..." nets no helpful answers anywhere you ask. Don't worry! This is your chance to be a pioneer! When you do find a solution to your problem, share it in public so those in the future with the same, weird problem need not feel so lonely. And answer the question yourself the next time it comes up on a mailing list.

You may also get conflicting help as well. Some people believe that nobody should ever use LOOP, and others feel that for the right situation, nothing's better. Some people will tell you that you must use Emacs to write Common Lisp, and others feel there are other reasonable options. Some love the Common Lisp Object System, and others are wrong. It's up to you to sift through the information and decide for yourself what makes the most sense. And how boring would it be if everyone agreed about everything all the time?

I love to help people with Common Lisp. It's most rewarding when the questions show an interest in Common Lisp and a desire for progress and understanding. It's least rewarding when the questions show disdain for Common Lisp ("Why is this so convoluted and dumb?") and no interest in anything but a quick answer ("I'm taking this dumb course and after it's done I will never use LISP again. So can you just explain how to remove quote marks from a list?").

Have fun, and I hope the next time you need help with Common Lisp, you get what you need. Good luck!

Hans HübnerBerlin Lispers Meetup: Tuesday August 26th, 2014, 8.00pm

· 3 days ago
You are kindly invited to the next "Berlin Lispers Meetup", an informal gathering for anyone interested in Lisp, beer or coffee:

Berlin Lispers Meetup
Tuesday, August 26th, 2014
8 pm onwards

St Oberholz, Rosenthaler Straße 72, 10119 Berlin
U-Bahn Rosenthaler Platz

We will try to occupy a large table on the first floor, but in case you don't see us,
please contact Christian: 0157 87 05 16 14.

Please join for another evening of parentheses!

Zach BeaneStarting a Lisp project in 2014

· 4 days ago
If you're starting a project today and you want to make it easy to interact with the outside world, there are many, many, many services available. If you're feeling overwhelmed with all the options, here's what I'd recommend to get started:After a while you may find one or more of these options lacking. That's a good time to start shopping around and exploring other options. But when you're just getting started and you want to get up and running quickly, give them a shot.

Joe MarshallSmall puzzle solution

· 5 days ago
Before I give my solution, I'd like to describe the leftmost digit algorithm in a bit more detail.
(define (leftmost-digit base n)
  (if (< n base)
      n
      (let ((leftmost-pair (leftmost-digit (* base base) n)))
        (if (< leftmost-pair base)
            leftmost-pair
            (quotient leftmost-pair base)))))
The idea is this: if we have a one digit number, we just return it, otherwise we recursively call leftmost-digit with the square of the base. Squaring the base will mean gobbling up pairs of digits in the recursive call, so we'll get back either a one or two digit answer from the recursion. If it is one digit, we return it, otherwise it's two digits and we divide by the base to get the left one.

For example, if our number is 12345678 and the base is 10, we'll make a recursive call with base 100. The recursive call will deal with number as if it were written 12 34 56 78 in base 100 and return the answer 12. Then we'll divide that by 10 to get the 1.

Since we're squaring the base, we're doubling the number of digits we're dealing with on each recursive call. This leads to the solution in O(log log n) time. If we instrument quotient, you can see:
(leftmost-digit 10 816305093398751331727331379663195459013258742431006753294691576)
816305093398751331727331379663195459013258742431006753294691576 / 100000000000000000000000000000000
8163050933987513317273313796631 / 10000000000000000
816305093398751 / 100000000
8163050 / 10000
816 / 100
A sixty-three digit number trimmed down to one digit with only five divisions.

So a simple solution to the puzzle is:
(define (leftmost-digit+ base n)
  (if (< n base)
      (values n 0)
      (call-with-values (lambda () (leftmost-digit+ (* base base) n))
        (lambda (leftmost-pair count)
          (if (< leftmost-pair base)
              (values leftmost-pair (* count 2))
              (values (quotient leftmost-pair base) (+ (* count 2) 1)))))))
The second value is the count of how many digits we discard. If the number is less than the base, we return it and we discarded nothing. Otherwise, we make the recursive call with the base squared and get back two values, the leftmost pair and the number of pairs it discarded. If the leftmost pair is a single digit, we return it, otherwise we divide by the base. The number of digits discarded is simply twice the number discarded by the recursive call, plus one more if we had to divide.

But I don't see an easy way to separate finding the digit from finding the position. At first it seemed straightforward to just count the digits being discarded, but you can't decide whether to increment the count at each stage without determining if the leftmost part of the recursive call contains one or two digits.

Nicolas HafnerAdding Class-Bound Methods to CLOS - Confession 25

· 5 days ago

header This confession is out of sequence because I wrote the initial sketch for it earlier and can only now publish it because it is rather heavy in code for a change and that required the new blog version. Anyway.

One of the big changes when coming from more mainstream OOP languages to CL is that CLOS uses generic dispatch rather than methods that are bound to classes. I've now come to love and rejoice generic dispatch because it's both a simpler and more powerful system.

As I was browsing about my mind for ideas, I suddenly had the thought of implementing the other OOP idiom in CL as well. After all, it had to be possible, right? And surely enough it is. It didn't take me long to figure out how either, but instead of presenting a direct solution for you I'll walk through a basic prototyping approach to implement something like this in CL.

First we need to figure out what we want. For this, the answer to that is rather simple: We want methods that are bound to a specific class. Different classes can have methods with the same name but differing argument lists. Methods should be inheritable and overridable.

Next is the actual implementation difficulty. A first idea might be to create a ‘main superclass’ that has a class-allocated methods slot with a hash-table that contains the class method functions. This is problematic for two reasons. First, it leaks class information into the instances. Second, it doesn't give us a good way to compute the inheritance.

Enter MOP. The Meta Object Protocol gives us a wealth of extensions to CLOS that make the whole system a true wonder machine. Indeed, MOP allows us to do what we want and a lot more without too much of a hassle and it all integrates with the rest of CLOS. First we'll want to define our own metaclass that contains the methods slot.

(defclass method-class (standard-class)
  ((methods :initform (make-hash-table) :accessor class-methods)))

That's right, classes themselves are instances of classes. Before I found out about this I never even thought it possible, it never crossed my mind. But yet here it is and it is immensely powerful. In order to use our metaclass, we need to tell CLOS a bit more about it so that it can handle inheritance properly. From here on out we'll be using CLOSER-MOP, which is QL-able.

(defmethod c2mop:validate-superclass ((class method-class) (superclass t)) 
  nil)
(defmethod c2mop:validate-superclass ((class standard-class) (superclass method-class)) 
  nil)
(defmethod c2mop:validate-superclass ((class method-class) (superclass standard-class)) 
  t)
(defmethod c2mop:validate-superclass ((class method-class) (superclass method-class)) 
  t)

This basically tells CLOS what kind of superclass or inheritance order is allowed, since some things wouldn't quite make sense for our case. Next we'll add a few helper functions to add and remove methods for our classes.

(defun class-method (class-name method-name)
  (gethash method-name (class-methods (find-class class-name))))

(defun (setf class-method) (function class-name method-name)
  (setf (gethash method-name (class-methods (find-class class-name)))
  function))

(defun remove-class-method (class-name method-name)
  (remhash method-name (class-methods (find-class class-name))))

(defmacro define-class-method (class name args &body body)
  `(setf (class-method ',class ',name)
         #'(lambda ,args ,@body)))

Using these we can, although in a more lispy way, already define class-bound methods. Let's do some quick tests to see if it's all working:

(defclass test-class () ()
  (:metaclass method-class))

(define-class-method test-class greet (&optional name)
  (format T "Hello~@[, ~a~]!" name))

(funcall (class-method 'test-class 'greet))

(funcall (class-method 'test-class 'greet) "Lisper")

Now, calling funcall directly is a bit unwieldy and we'd also like to be able to call class methods on instances, so let's add a generic CALL function to do all that for us:

(defun call (instance method &rest args)
  (let ((class (etypecase instance
                 (standard-object (class-of instance))
                 (symbol (find-class instance))
                 (method-class instance))))
    (assert (typep class 'method-class))
    (let ((method (or (gethash method (class-methods class))
                      (error "No such class-method!"))))
      (apply method args))))

(call 'test-class 'greet "Reader")
(call (make-instance 'test-class) 'greet "You")

Neat. Now, one aspect that's missing is that, within a class-method you cannot refer to your own instance. That's not exactly great and something that is certainly direly needed in order to properly utilise classes and methods. We'll circumvent this by adding a special *THIS* that will be bound to the instance in CALL.

(defvar *this*)

(defun call (instance method &rest args)
  (let ((class (etypecase instance
                 (standard-object (class-of instance))
                 (symbol (find-class instance))
                 (method-class instance))))
    (assert (typep class 'method-class))
    (let ((method (or (gethash method (class-methods class))
                      (error "No such class-method!"))))
      (let ((*this* (typecase instance
                      (standard-object instance)
                      (T (c2mop:class-prototype class)))))
        (apply method args)))))

Thanks to CLASS-PROTOTYPE and the typecases we can also use our class-methods on classes themselves and still have access to class-allocated slots. Sort of like static fields and methods work in Java & co, except every method can be used statically and not.

Now, to make this all a bit less awkward to use, we'll add some more macros.

(defmacro -> (instance method &rest args)
  `(call ,instance ',method ,@args))

(defmacro <- (method &rest args)
  `(call *this* ',method ,@args))

(defmacro <s (slot)
  `(slot-value *this* ',slot))

Now I realise that this is all a lot of cosmetics and probably not the best style from a lisp viewpoint, but I'll excuse this with the fact that we're trying to emulate other languages anyway, so we might as well add some sugar to the mix.

“Ok, cool” I hear you think “but what about inheritance? Surely that isn't just already done for us, right?” And it certainly isn't, but we'll get to it now. If you subclass your test-class now, the new subclass won't have any of its parent's methods. In order to get this all rolling we'll first define a new slot on our class.

(defclass method-class (standard-class)
  ((direct-methods :initform (make-hash-table) :accessor class-direct-methods)
   (methods :initform (make-hash-table) :accessor class-methods)))

The DIRECT-METHODS slot will hold methods that belong directly to this class and the METHODS slot will hold all of the effective methods available to it, both from its own and the inherited. This means we have to change our simple accessor functions from earlier to direct to DIRECT-METHODS.

(defun class-method (class-name method-name)
  (gethash method-name (class-direct-methods (find-class class-name))))

(defun (setf class-method) (function class-name method-name)
  (setf (gethash method-name (class-direct-methods (find-class class-name)))
  function))

(defun remove-class-method (class-name method-name)
  (remhash method-name (class-direct-methods (find-class class-name))))

Next we need to have a function that can actually compute the effective methods.

(defun compute-effective-methods (class)
  (setf (class-methods class) (make-hash-table))
  (flet ((set-method (name method)
           (setf (gethash name (class-methods class)) method)))
    ;; Compute superclass combination
    (dolist (superclass (c2mop:class-direct-superclasses class))
      (when (typep superclass 'method-class)
        (maphash #'set-method (class-methods superclass))))
    ;; Compute override
    (maphash #'set-method (class-direct-methods class))))

As you can see this first maps all the direct superclasses' methods to the table and then the direct-methods on top. Since each superclass has their own effective methods slot we don't need to go up further than one level. Now we need to tie this into the actual inheritance computation of CLOS.

(defun cascade-method-changes (class)
  (compute-effective-methods class)
  (loop for sub-class in (c2mop:class-direct-subclasses class)
        when (and (typep sub-class 'method-class)
                  (c2mop:class-finalized-p sub-class))
          do (cascade-method-changes sub-class)))

(defmethod c2mop:finalize-inheritance :after ((class method-class))
  (dolist (super (c2mop:class-direct-superclasses class))
    (unless (c2mop:class-finalized-p super)
      (c2mop:finalize-inheritance super)))
  (cascade-method-changes class))

Let's test this:

(defclass sub-class (test-class) ()
  (:metaclass method-class))

(-> (make-instance 'sub-class) greet)

And it indeed works! If you are someone who likes to experiment first before following instructions you might have come across the following problem after defining the sub-class:

(-> 'sub-class greet)
; Evaluation aborted on #<SIMPLE-ERROR "No such class-method!" {1005558A33}>.

So it seems directly using the class after defining it doesn't work, but using an instance does. And after creating the instance, the above command will work as well. What happens here is that the inheritance of a class is not necessarily finalised until immediately before a class instance is made. This means that when we access the class before then, the inheritance might not have been computed and thus our method computation never actually happened! We can fix this by adding a check in our CALL function.

(defun call (instance method &rest args)
  (let ((class (etypecase instance
                 (standard-object (class-of instance))
                 (symbol (find-class instance))
                 (method-class instance))))
    (assert (typep class 'method-class))
    (unless (c2mop:class-finalized-p class)
      (c2mop:finalize-inheritance class))
    (let ((method (or (gethash method (class-methods class))
                      (error "No such class-method!"))))
      (let ((*this* (typecase instance
                      (standard-object instance)
                      (T (c2mop:class-prototype class)))))
        (apply method args)))))

Great, so with a bit of fiddling about we have added class-method capabilities to CLOS, full with inheritance and everything, in about 65 lines of simple code. Amazing. Now as a last treat I want to add a small extension to the class definition itself so that we can put methods in there directly, as you might know it from other languages as well. In order to do this we're going to define our own methods on RE/INITIALIZE-INSTANCE.

(defun initialize-method-class (class next-method &rest args &key &allow-other-keys)
  (let ((methods (getf args :methods)))
    (setf (class-direct-methods class) (make-hash-table))
    (dolist (definition methods)
      (destructuring-bind (name lambda-list &rest body) definition
        (let ((function (compile NIL `(lambda (,@lambda-list)
                                        ,@body))))
          (setf (gethash name (class-direct-methods class)) function)))))
  (remf args :methods)
  (apply next-method class args))

(defmethod initialize-instance :around ((class method-class) &rest args)
  (apply #'initialize-method-class class #'call-next-method args))

(defmethod reinitialize-instance :around ((class method-class) &rest args)
  (apply #'initialize-method-class class #'call-next-method args))

Sadly I am not aware of any other way of doing this that doesn't require invoking EVAL or COMPILE. However, this should be fine for most cases since most of the time your class definitions will be top-level forms, so the lexical environment should not be of consequence. As you can see though, by simply extending these two generic functions and grabbing the :METHODS argument from it we can change the way DEFCLASS is interpreted.

(defclass sub-class (test-class) ()
  (:metaclass method-class)
  (:methods (scream () (format NIL "AAAAAAA!!"))))

(-> 'sub-class scream)

CLOS and MOP are amazing creatures and there's still so much I have yet to explore of it. I hope this brief venture into the depths of Common Lisp have been enjoyable and informative to you. As always with these posts, if there are corrections, additions or questions, please do let me know and I'll see how I can help.

You can view the full code here.

edit: Thanks to Jean-Philippe Paradis for pointing out that using COMPILE instead of EVAL to create the lambda form is probably a better idea.

Zach BeaneCommon Lisp bits

· 5 days ago
The International Lisp Conference 2014 is history. I didn't make it, but Julian Squires did and provided a nice write-up. So did Nick Levine.

Reddit user FightAnArmedBearP started a discussion titled "Should my startup attempt to use ABCL in a production environment?" The ensuing feedback from Mikel Evins, Cyrus Harmon, Mark Evenson, and others is of extremely high quality, with excellent information about using ABCL and other solutions for working with Lisp on the JVM. Highly recommended reading even if you think you'll never be in the same situation.

cl-autowrap by Ryan Pavlik looks to me like a genius way to do FFI wrappers without needing to use stub C programs and a compiler at build time. It uses c2ffi, a standalone C++ program, to generate specification data files you can distribute with your project, after which neither c2ffi nor a C compiler is involved in using the FFI wrapper. It's a work in progress, one of the Lisp In Summer Projects projects, but I'm excited about the potential.

Speaking of Lisp In Summer Projects, Janne Nykopp's Notewhacker sounds fun: it's a game for learning sheet music notation, with MIDI instrument support.

elPrep is a LispWorks-olnly, BSD-style-licensed "high-performance tool for preparing .sam/.bam files for variant calling in sequencing pipelines." I don't know what that means, but it's a full Common Lisp application for the purpose, and it looks neat. From Charlotte Herzeel and Pascal Costanza.

Ezra Rush has written networked, OpenGL battleship and pong games. They use Patrick Stein's userial game protocol example.

Slugmage is a work-in-progress game from Alyssa Carter. "I hope to turn Slugmage into the game it was meant to be!" Uses SDL.

Testament of the White Cypress is "a fantasy role-playing adventure game for your Windows, Mac, or Linux PC. Using the mouse and keyboard, a single player controls a lone monk named Geoffrey as he travels through a post-apocalyptic wilderness." From David O'Toole, using his Xelf game engine. It has split licensing: the code is GPLv3 but the music and art assets are not freely redistributable.

Nicolas Hafner takes a shot at explaining CLOS to the uninitiated.

site-generator is a "command-line static site generator that supports arbitrary content and multiple languages." By Alex Charlton. (Not to be confused with Philip "Don't Call Me Phil" Greenspun's SITE CONTROLLER.)

qlot by Eitaro Fukamachi is a project-local library installer that uses Quicklisp. "This aims to be like Bundler of Ruby or Carton of Perl." Seems interesting, though it comes with a big "ALPHA quality" warning.

Joe MarshallJust a small puzzle

· 5 days ago
You can get the most significant digit (the leftmost) of a number pretty quickly this way
(define (leftmost-digit base n)
  (if (< n base)
      n
      (let ((leftmost-pair (leftmost-digit (* base base) n)))
        (if (< leftmost-pair base)
            leftmost-pair
            (quotient leftmost-pair base)))))
The puzzle is to adapt this code to return the position of the leftmost digit.

(leftmost-digit+ 10 46729885)  would return two values, 4 and 7

Common Lisp TipsDeclining to handle a condition

· 6 days ago

Occasionally it is convenient for a handler to decide whether to deal with a condition after it already has control.

Sometimes I see that idiom written with a `handler-case` that resignals the condition if it decides it can't take care of it. The downside of that approach is that `handler-case` only resignals the condition after unwinding the stack and removing any restarts that were in place.

`handler-bind` avoids those downsides. When a `handler-bind` handler does not transfer control it is said to "decline to handle" the condition. The condition will then percolate up to surrounding handlers or the debugger with the stack and restarts still in tact, as if the handler had never been entered.

(defun baz ()
  (handler-bind ((error (lambda (c)
                          (when (i-got-this-p c)
                            (return-from baz (quux))))))
    (foo)))

LispjobsCommon Lisp or Clojure Developer, Adelaide or remote

· 6 days ago

Common Lisp or Clojure Developer
A fantastic opportunity for a Common Lisp developer or Clojure developer that is fast, adaptable and can work independently or fit in well into a team

Experience with Common Lisp or Clojure is a must (could be non-commercial) as well as general knowledge of relational databases and web technologies.

This role could be 100% remote for the right person, to join a top class team and on a great product which could became the Common Lisp application with largest customer base in the world.   The successful applicant will join a small, focused team in maintaining and furthering the development of a leading multivariate testing platform.

Familiarity in the following areas would be considered a plus: backend web server technology, Javascript, PostgreSQL, SQL Server, statistics, distributed computing, Lispworks, any distributed version control system. A high degree of autonomy and self-motivation will be expected.

This is a great career building opportunity and salary package on offer! Although will consider contractors!

If this is of interest I’d be keen to discuss with you, please email me onstewart@totalresource.com.au or call 0061 (0)415 344 427


Nick LevineBrief teaching gig

· 7 days ago
If anyone knows anyone who'd be qualified and available to give a one day tutorial, in the Barcelona region, on the LispWorks development environment and in particular the debugger, could they get it touch? Thanks.

Nick LevineILC 2014

· 8 days ago

I counted about sixty people in the hall — really not very many for an ILC where one might typically hope for twice that. I didn't see anyone from the CL vendors, hardly anyone from any of the other CL implementations, few people I knew from previous outings, indeed really not many of the "usual suspects" at all. But note that some of this works two ways: I could equally be upbeat and say there wasn't much overlap between Montreal and the recent ELS in Paris: this conference had netted a different audience, which is fine.

My only fault with the program was that there wasn't enough of it. For an ILC there really should be enough material to fill four days. At two and a half, this gig felt like one of the European local meetings, translocated.

As for the presentations: the one that left me totally gaping in amazement was the lightning talk from a 14 year old (sorry kid, I didn't make a note of your name) who'd implemented his own lisp dialect along with embedded image processing and all manner of other bells and whistles. Of the named speakers, I should mention: Dave Cooper's hands-on Gendl tutorial; Christian Queinnec's Small (but Massive) Open Online Course; François-René Rideau's CL scripting; Dave Penkler's amalgam of LISP 1.5 and APL\360; and Robert Strandh's SICL implementation notes. All that time we spent building bigger and better caches is now just history.

My own (co-)talk about work on an NLP project went OK (I think). Judging by the questions, the audience found Michael Young's social science side much more interesting than my comments about the lisp, and I'm not going to disagree with them.

So for two and a half days, some part of the lisp community had come face-to-face. We presented and listened to the talks, we drank the coffee and ate the food, we explored Montreal from below. And when it was all over we all went away again, back to our separate corners. I think the next "lisp community" meet will be European Lisp Symposium 2015, in London next April / May. I mention this "community" idea, because it came up in the panel on the last day, and it's an interesting thought to mull over: is there one? (or more than one?) should there be one? and if you had it in front of you what would you do with it?

LispjobsClojure/ClojureScript and Datomic engineer at Listoria, London or remote

· 10 days ago

Listora is seeking a Clojure/ClojureScript and Datomic engineer

Reply to Henry dot ec at Gmail dot com

London based start up with highly experienced (and awesome) distributed team of researchers, engineers and designers. Although the project is still in its infancy (very greenfield), we have a big vision of being the global leader in high-quality structured events data, which will help to drive the contextual and personalised event discovery experiences of the future.

We're developing our platform along with applications that meet the needs (jobs/outcomes) of content data partners, event organisers, publishers and developers. It's both a huge CS and product challenge and we need exceptional and ambitious people to solve the problems that we'll come up against.

We've been developing our core platform with Clojure + Datomic/Cassandra and our applications with ClojureScript/Om. We have a very advanced stack that any passionate FP engineer would be excited about working on. We also regularly work in the open source community and are already releasing libraries.

In terms of product, we have an upfront investment in high quality research and concept evaluation taken from years of experience using both customer and outcome driven development methodologies. We are very open in what we do and have a toolset to build our products very closely with our customers. We don't work to deadlines, but we do spend a lot of time thinking about the prioritisation of what we are and could be building.

We are looking for engineers to join our team that can hit the ground running. The right person will be self-motivated, conscientious, humble and a great communicator. We are looking for people with many years FP experience in senior, lead or architectural roles and are used to working in a start up environment with start up tooling.

We want to work with fantastic engineers and passionate people. This is one of the things that motivates us. We don't mind where in the world you're based or whether you want a permanent or contracting relationship.

If you're the right fit with our team we will work hard to look after you - from giving you the flexibility to explore ideas and technologies for the job at hand to remuneration.

If you have any questions, we would love to hear from you.


LispjobsClojure/Clojurescript positions: DiligenceEngine, Toronto, Ontario, or remote

· 10 days ago

DiligenceEngine, a Toronto-based startup using machine learning to automate legal work, is hiring two Clojure/Clojurescript developers. They say:

We're looking for a developer to work on our clojure/clojurescript/om web stack. Our team is small, pragmatic, and inquisitive; we love learning new technologies and balance adoption with good analysis. We prefer to hire near us, but also welcome remote work in a time zone within North America.

See the full job descriptions on the DiligenceEngine website.


Paul KhuongHow to Define New Intrinsics in SBCL

· 10 days ago

This Stack Overflow post points out an obscure and undocumented weakness in Intel’s implementation of the POPCNT instruction: although the population count (number of bits equal to 1) is only a function of the source argument, hardware schedules it as though it also depended on the destination. GCC, clang and MSVC all fail to take this issue into account.

Until a new patched version of my favourite C compiler is released, there aren’t many tasteful workarounds for this performance bug. I’d have to switch to inline asm, and either force the compiler to allocate the same register to the input and the result, or force different registers and clear the spurious dependency with a xor. Ideally, I wouldn’t impose any additional constraint on the register allocator and only insert a xor if the destination and source registers don’t match.

SBCL easily supports this use case, without having to re-release or even recompile the implementation: VOPs (virtual operations) execute arbitrary CL code during code generation and they can be defined at runtime.

The first step is to make sure that SBCL’s assembler knows how to emit popcnt: the assembler can also be extended at runtime, but that’s more hairy and a topic for another post. Instruction encodings are defined in src/compiler/$ARCH/insts.lisp, and a quick grep reveals (define-instruction popcnt (segment dst src) ...): the x86-64 backend learned about popcnt in May 2013 (thanks to Douglas Katzman).

We define VOPs via define-vop, a macro that exposes many options. Most of the time, it’s easiest to look at a pre-existing definition for an operation that’s similar to the one we want to add. Popcount looks like integer negation: it has a single (machine integer) argument and returns another integer. Integer negation is defined in src/compiler/$ARCH/arith.lisp:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
;;;; unary operations

(define-vop (fast-safe-arith-op)
  (:policy :fast-safe)
  (:effects)
  (:affected))

(define-vop (fixnum-unop fast-safe-arith-op)
  (:args (x :scs (any-reg) :target res))
  (:results (res :scs (any-reg)))
  (:note "inline fixnum arithmetic")
  (:arg-types tagged-num)
  (:result-types tagged-num))

(define-vop (signed-unop fast-safe-arith-op)
  (:args (x :scs (signed-reg) :target res))
  (:results (res :scs (signed-reg)))
  (:note "inline (signed-byte 64) arithmetic")
  (:arg-types signed-num)
  (:result-types signed-num))

(define-vop (fast-negate/fixnum fixnum-unop)
  (:translate %negate)
  (:generator 1
    (move res x)
    (inst neg res)))

(define-vop (fast-negate/signed signed-unop)
  (:translate %negate)
  (:generator 2
    (move res x)
    (inst neg res)))

(define-vop (fast-negate/unsigned signed-unop)
  (:args (x :scs (unsigned-reg) :target res))
  (:arg-types unsigned-num)
  (:translate %negate)
  (:generator 3
    (move res x)
    (inst neg res)))

The code snippet above includes a bit of boilerplate to factor out commonalities via inheritance. The first definition introduces fast-safe-arith-op, VOPs that apply in both high speed and high safety settings (the rest is copy/pasted noise from earlier ports that sport a scheduler); the second one extends fast-safe-arith-op to define fixnum-unop, a base definition for single-argument operations on fixnums, while the third one is the same, but for machine integers. The last three definitions fill in the blanks so the compiler can compile %negate of fixnum, signed and unsigned integers. The (:translate %negate) bit means that these VOPs can be emitted instead of calls to %negate. The integer after :generator defines the “cost” of each variant; the compiler will choose the (applicable) variant with the least cost and execute the code sequence that follows to convert a call to %negate into machine code.

This kind of implementation inheritance is fine for an SBCL backend, where we define many VOPs and expect developers to understand the system. I doubt it’s a didactic win. Let’s do something simpler for popcnt. In the interest of simplicity, I’ll also completely disregard powerful details in define-vop that are rarely relevant when defining intrinsics that map directly to machine instructions.

First, we need to tell the compiler that we’re about to do special things to a function named popcnt (and to blow away any pre-existing information if the defknown form is re-evaluated).

1
2
3
4
5
6
7
8
9
(defpackage "POPCNT"
  (:use "CL")
  (:export "POPCNT"))

(in-package "POPCNT")

(sb-c:defknown popcnt ((unsigned-byte 64)) (integer 0 64)
    (sb-c:foldable sb-c:flushable sb-c:movable)
  :overwrite-fndb-silently t)

This says that popcnt accepts a 64-bit unsigned integer and returns an integer between 0 and 64 (inclusively), and that the function can be constant-folded, flushed (eliminated as dead code) and moved around (it’s pure).

Now, to define a VOP that implements popcnt:

1
2
3
4
5
6
7
8
9
10
11
12
13
(in-package "SB-VM")

(define-vop (popcnt:popcnt)
  (:policy :fast-safe)
  (:translate popcnt:popcnt)
  (:args (x :scs (unsigned-reg) :target r))
  (:arg-types unsigned-num)
  (:results (r :scs (unsigned-reg)))
  (:result-types unsigned-num)
  (:generator 3
    (unless (location= r x) ; only break the spurious dep. chain
      (inst xor r r))       ; if r isn't the same register as x.
    (inst popcnt r x)))

We define a new VOP named popcnt:popcnt (the name is arbitrary, as long as it doesn’t collide with another VOP) that is applicable at all optimization policies (both high speed and high debug level), and that implements popcnt:popcnt. Its first and only argument, x, is an unsigned-num, an unsigned machine integer, that can only be stored in a register. Moreover, if possible, we’d like x to be allocated the same register as the result, r. There’s only one result (r) and it’s an unsigned machine integer in a register, just like x. The generator, of cost 3 (a common default for arithmetic operations), breaks any dependency chain in r if necessary, and stores the population count of x in r.

At first sight, the defknown form seems to conflict with the VOP. We declare that the return value of popcnt is a small integer, clearly a fixnum, and then define a VOP that returns a machine integer. The subtlety is that defknown is concerned with IR1, the higher level intermediate representation, which works on CL types (i.e, types as sets) and abstract values. VOPs, on the other hand, are defined for the lower level IR2, where types describe concrete representations (like C). It is perfectly meaningful to say that a small integer will be represented as an untagged machine integer.

The next step isn’t strictly necessary, but helps people who like their REPL. The compiler knows how to compile calls to popcnt, so we can define popcnt… as a call to popcnt. Our new function is now a first-class value that can be called from interpreted code and passed to higher-order functions, like the compiler’s constant-folding pass.

1
2
3
4
(in-package "POPCNT")

(defun popcnt (x)
  (popcnt x))
CL-USER> (disassemble 'popcnt:popcnt)
; disassembly for POPCNT:POPCNT
; Size: 25 bytes
; 07FCDB6E:       4831D2           XOR RDX, RDX               ; no-arg-parsing entry point
;       71:       F3480FB8D1       POPCNT RDX,RCX
;       76:       48D1E2           SHL RDX, 1
;       79:       488BE5           MOV RSP, RBP
;       7C:       F8               CLC
;       7D:       5D               POP RBP
;       7E:       C3               RET
[ error trap noise ]
CL-USER> (popcnt:popcnt 42)
3

The disassembly shows that we get the code that we expect, including the dependency-breaking workaround, and the smoke test passes. There’s one interesting detail: we only defined a VOP that returns a machine integer. However, popcnt returns a tagged value (a fixnum), and does so with an efficient shift. IR2 takes care of inserting any coercion needed between VOPs (e.g., between popcnt and the VOP used to return boxed values from functions), and the IR1 defknown guarantees that the result of popcnt, despite being represented in an unsigned machine integer, is small enough for a fixnum.

Let’s see what happens when we feed arithmetic into popcnt, e.g.:

CL-USER> (disassemble (lambda (x y)
                        (declare (type (unsigned-byte 32) x y))
                        (popcnt:popcnt (+ x y))))
; disassembly for (LAMBDA (X Y))
; Size: 55 bytes
; 0752BD59:       4801FA           ADD RDX, RDI               ; no-arg-parsing entry point
;       5C:       48D1FA           SAR RDX, 1
;       5F:       F3480FB8D2       POPCNT RDX,RDX
;       64:       48D1E2           SHL RDX, 1
;       67:       488BE5           MOV RSP, RBP
;       6A:       F8               CLC
;       6B:       5D               POP RBP
;       6C:       C3               RET

After adding two fixnums, an automatic coercion unboxes the resulting fixnum into a machine integer which is then passed to popcnt (note the lack of dependency-breaking xor now that the source and destination are the same register).

That’s pretty good code, but we can do better: fixnums are tagged with 0, so we can simply feed fixnums to popcnt without untagging.

This is where the cost parameter to :generator comes in: we can define another VOP for popcnt of fixnums and bias the compiler to prefer the fixnum VOP.

1
2
3
4
5
6
7
8
9
10
11
12
13
(in-package "SB-VM")

(define-vop (popcnt/fx)
  (:policy :fast-safe)
  (:translate popcnt:popcnt)
  (:args (x :scs (any-reg) :target r))
  (:arg-types positive-fixnum)
  (:results (r :scs (unsigned-reg)))
  (:result-types unsigned-num)
  (:generator 2 ; 2 is lower than 3, so popcnt/fx is preferable to popcnt
    (unless (location= r x)
      (inst xor r r))
    (inst popcnt r x)))
CL-USER> (disassemble (lambda (x y)
                        (declare (type (unsigned-byte 32) x y))
                        (popcnt:popcnt (+ x y))))
; disassembly for (LAMBDA (X Y))
; Size: 47 bytes
; 07BEABE9:       4801FA           ADD RDX, RDI               ; no-arg-parsing entry point
;      BEC:       F3480FB8D2       POPCNT RDX,RDX
;      BF1:       48D1E2           SHL RDX, 1
;      BF4:       488BE5           MOV RSP, RBP
;      BF7:       F8               CLC
;      BF8:       5D               POP RBP
;      BF9:       C3               RET

Unlike many low-level languages, CL includes a standard function for population count, logcount. SBCL includes a VOP for logcount (with a cost of 14), which we can supersede with our own popcnt-based VOPs: we only have to replace (:translate popcnt:popcnt) with (:translate logcount). That’s an easy improvement but isn’t in trunk because popcnt is a recent x86 extension.

Adding VOPs for (ad-hoc) polymorphic or otherwise generic functions can be surprising: a VOP will only be considered if the arguments and the return values are known to have CL types that are compatible with the VOP’s representation specification. For popcnt, we guarantee that the return value is a positive integer between 0 and 64; for cl:logcount, the defknown guarantees that the return value is a positive fixnum. In both cases, the return values can always be represented as an unsigned machine integer, so our new VOPs will always match if the argument fits in positive fixnums or unsigned machine integers (and will have priority over the generic x86-64 VOP because their cost is lower). More complex cases depend on derive-type optimizers, but that’s rarely necessary when defining instrinsics for low-level code.

Colin LuptonQuantum Computing and Lisp

· 13 days ago

Quantum Computing is a fascinating field, but currently a contentious one. The only examples we have of real-world, hardware quantum computers are the line of adiabatic quantum computers from D-Wave Systems—and many voices in the scientific community still protest its identification as such simply because it is not a full-fledged gate-model quantum computer complete with persistent quantum data storage and QRAM. However, by the strictest definition, any machine which exploits quantum mechanical phenomena for the purpose of computation is a quantum computer, and the D-Wave One and Two meet this definition.

For us in the Lisp community, Quantum Computing is even more important; one of the most surprising secrets of the D-Wave line of adiabatic quantum computers is that their low-level operating system is programmed in Common Lisp. Specifically, D-Wave uses SBCL. This choice is not accidental or arbitrary—Common Lisp is uniquely suited to the task of quantum computer programming.

Lambda Calculus, Functional Programming, and Quantum Computing

Peter Selinger, a Professor of Mathematics at Dalhousie University, has been publishing papers regarding Quantum Computer programming languages and Lambda Calculus for a number of years, extending the work of van Tonder and others. In particular, he formalized his argument in favor of Lambda Calculus as a natural expression of quantum algorithms for classically-controlled quantum computers in the following papers:

Selinger made one mistake, in my opinion: he chose Haskell to implement his quantum computer simulator and quantum computer programming language, Quipper. While he could have chosen Scheme without any complaint, he should have chosen Common Lisp, just like D-Wave—and to prove this point, I took my work on a Quantum Common Lisp I originally designed for my science-fiction novel and started the BLACK-STONE open-source project to create a faster quantum computer simulator and programming environment, in less lines of code. While the BLACK-STONE project is still in its infancy (and I haven’t had the time to work on it at all in recent months), the simplicity, elegance, clarity, and succinctness of the Common Lisp source compared to Haskell is already heavily apparent.

D-Wave One and Two are rudimentary Quantum Lisp Machines

I was surprised and pleased to discover in my personal conversations with the lead physicists, engineers, and developers at D-Wave, that they had come to the same conclusion as me, but had the means to act on those insights. They had already accomplished what I set out to do with Quantum Common Lisp and BLACK-STONE; unfortunately, their source code is very much proprietary, and even as a registered D-Wave developer, I had no access to their Lisp operating system for the D-Wave One and Two.

All I can do, as an outsider looking in, is make certain informed assumptions. I could easily be completely wrong, but it seems to me fairly self-evident that the D-Wave platforms qualify as rudimentary prototype Quantum Lisp Machines. The D-Wave hardware was clearly designed with Lisp in mind, and the low-level Operating System of the D-Wave hardware is written entirely in Common Lisp. Personally, I don’t think it would have even been possible for them to build a quantum computer at all without Lisp.

As I understand the integration model, the D-Wave platforms rely on classical supercomputers for their interface, memory, and persistent storage—so that limits the types of quantum algorithms that can be run to those that must accept from and return measured, classical data to the interface; algorithms which expect unmeasured, raw quantum data for input, and persistence of such data existing unmeasured in memory are not currently possible.

Still, any quantum computer at all is an amazing feat—and certainly D-Wave’s customer base seems quite happy with the platform. They are purpose built for a specific class of optimization problems, which classical computers have a great deal of difficulty solving.

Regarding their former developer program, which has now been closed for some time, it is interesting to ponder why—when the core platform is 100% Lisp—they would only release a Python Pack as their developer API and not a Lisp interface. I suspect it came down to the matter of perceived value and a hope for rapid adoption: they put a lot of time and effort into writing a quantum computer simulator for Python, and a number of excellent tutorials to go with it, but still they did not get the adoption they hoped for—and as a result, they closed the developer program and scrapped the Quantum Cloud platform that I was relying on and waiting for, to finish some of my more interesting (to me at least), software projects.

The problem with the choice of Python, however, is that Quantum Computer programming only actually makes sense in Lisp, and as a result only Lisp Hackers can understand Quantum Computer Programming. Other programming languages only serve to conflate the simple elegance of quantum energy programming into a terrifying, obtuse, impenetrable subject, while in Lisp it is expressed so naturally and intuitively—it’s almost as if Lisp itself was purpose designed for quantum computing.

You can see this for yourself in my project SILVER-SWORD, a Common Lisp bridge to the D-Wave Python Pack. Unfortunately, as I’ve said before, you can’t actually use the library since D-Wave no longer distributes their Python Pack, but you can view the translated tutorial examples in the repo and see for yourself—quantum energy programming is really easy in Lisp. And SILVER-SWORD would be even better if the underlying Lisp–Python bridge, BURGLED-BATTERIES, supported Python Class to CLOS translation.

Cons-cells, qubits, chimera-graphs, and the human brain

The reason I say that only Lispers can understand Quantum Computer programming is based on the observation of the fundamental structural similarities between a generalized model Lisp program, the D-Wave hardware, and the human brain. From an experiential perspective, learning and using one of the many Lisp-family languages offers the individual programmer specific insight into the functioning of their own internal platform.

Consider a general, recursive function in Common Lisp. Its internal representation within the Lisp run-time is an acyclic graph of cons-cells, pairs of pointers that map to memory or other cons-cells. Every Lisper eventually learns to think in terms of cons-cells, and is concerned about the efficiency of their code in terms of tree-walking—which path through all possible cons-cells to the desired return value is the shortest?—and, which path reduces the number of conses to the absolute minimum?

Now consider a learned skill, such as the art of programming; it can be a lengthy process for some, a seemingly effortless task for others. Many people brush this off as a simple matter of intelligence—but in fact, it is due to another learned skill: the art of learning itself, whereby the individual learns to integrate and categorize new information more efficiently than others, thus appearing smarter. Technically speaking, as we have been learning from the field of neuroscience, all human beings are born with roughly equal potential, but they are shaped and molded into individuals by their experiences and environment; in short, since so few of us know any better, we allow ourselves and our children to be automatically programmed by effectively random, chaotic, and unpredictable perceptions, instead of learning and teaching a methodology of self-mastery where the individual programs themselves. At the moment, intelligence and an aptitude for the sciences, engineering, mathematics and programming in individuals is more or less an accident, much like all talents; but in the near future, all talents could easily be engineered by the individual into themselves.

Then consider the concept of Quantum Computer energy programming, introduced by D-Wave as the programming paradigm to support their novel adiabatic quantum computer hardware. Because the underlying flux-qubits of the D-Wave processors exist in superposition until they are measured, they effectively process every probable result of a program simultaneously. The most efficient answer, the lowest energy solution, is returned first; even though all other results returned are also correct, from a traditional standpoint, the lowest energy solution is the most correct, even when other results have a higher probability. This point corresponds to both the question of intelligence, and the most efficient recursive function in Lisp, above. The most obvious path is not always the most correct, but a strong case can always be made to favor efficiency over all other factors.

These three points correspond to a psychological/computational Occam’s Razor—when faced with multiple solutions of high probability, the most efficient solution is the most correct.

Alongside a cursory study of neuroscience and theoretical physics, you can begin to see the similarities between the structure of Lisp programs, the implementation of the D-Wave quantum annealing processor, and the structure of the human brain itself.

As I have said before, Lisp is the language of the Universe, the Voice and Will of the True Self. This is simply a poetic expression of super-symmetry, and how it relates to the concept of Grokking in the Lisp community. The point is, the acyclic graph structure of cons-cells allows for a natural description of the fundamental (and inherently quantum) phenomenon of the physical universe, as well as of the humain brain itself.

Thus, when programmed in Lisp, a sufficiently complex neural-net application running natively on D-Wave style hardware of equal complexity and efficiency as the human brain is capable of emergent machine intelligence. The less it is programmed to behave intelligently, the better—it only requires a diverse selection of sensory input to perceive its external environment, a means to differentiate the internal from the external, and a core low-level operating system to manage its internal state. Experiments at D-Wave have already confirmed this.

One might even be so bold as to say that the super-symmetry is so perfectly expressed, that we human beings are naturally-occurring, organic quantum lisp machines. And this point holds whether you are an evolutionist, creationist, or otherwise.

The Future of Computing and Lisp

If quantum computing is the future of computer science as a whole, then by extension, so is Lisp. As Lisp Hackers, we have a responsibility to push computing to its limits, remind the world that Common Lisp is still the most advanced and powerful programming language, and ensure that the next generation of consumer-grade computers are all—every single one of them—Quantum Lisp Machines.

The inherent super-symmetry of Lisp programs, the central nervous system, and the physical universe is perhaps the strongest argument in favor of this. After all, human evolution has been marked out since the beginning of history not by advantageous genetic mutation, but by technological innovation—and what tool is more powerful than a language which can naturally express the fundamental laws of physics, the underlying structure of the human brain, and the ultimate model of computation?

Together, Quantum Computing and Lisp can help us better understand ourselves, our true nature, the universe we live in, and the limitless potential of our species—that the combination will almost certainly lead to emergent machine intelligence and the technological singularity is pure gravy, after that. Some days it is truly staggering to live in such a time in human history, living with the knowledge that we Lisp Hackers hold the future of the entire human race in our hands, at our keyboards.

The next time you fire up Emacs and type M-x slime, remember this. Hack like the whole world is counting on you and every line of code you write; hack like you’re channeling the Will of the universe itself. Because the future is here, now—the future is Quantum Common Lisp.


Colin LuptonLET-OVER-LAMBDA fixed for SBCL 1.2.2

· 13 days ago

Thanks go out to Orivej Desh—he pointed out what I overlooked, and the LET-OVER-LAMBDA package now works with full functionality restored in SBCL 1.2.2. I have preserved the :safe-sbcl feature used for testing the version of SBCL, so that descending into comma-expr of sb-impl::comma is only enabled for SBCL 1.2.2+.

The updated code should be available in the August release of Quicklisp. If you have a fork or clone, please be certain to pull the latest changes from the master branch.


Colin LuptonLET-OVER-LAMBDA broken in SBCL 1.2.2

· 15 days ago

As expected, the Quicklisp distribution of LET-OVER-LAMBDA is broken by the changes to the backquote reader macro in SBCL 1.2.2; although I expect this change breaks a good portion of Paul Graham’s macro code examples from On Lisp, as well.

A quick-fix suggested on Reddit is to use a “pseudo-flatten” for SBCL that also descends into sb-impl::comma-expr of sb-impl::comma. I will be testing this fix today, and hopefully pushing an updated version for the August release of Quicklisp.

Stay tuned.

UPDATE: modified LOL:FLATTEN to descend into comma-expr of sb-impl::comma objects, but no joy. I have currently disabled DEFMACRO! based code in LET-OVER-LAMBDA until I can find a better solution, and tested this against both v1.2.2 and v1.2.0-1 of SBCL (so if nothing else, it will at least build without errors).

If anyone knows of a better solution, feel free to leave a comment here or on the GitHub Issue thread.


Joe MarshallMini regex golf 3: set cover

· 19 days ago
I'm computing the set cover by incrementally adding items to be covered. Naturally, the order in which you add items changes the way the program progresses. I added code that picks an item to be added each iteration rather than just pulling the car off the front of a list.
(define (cover8 value->keys-table better-solution)

  (define (add-v-k-entry solution-set v-k-entry)
    (let ((value (car v-k-entry))
          (keys  (cdr v-k-entry)))

      (write-string "Adding value ") (write value) (newline)
      (write-string "   with keys ") (write keys) (newline)
      (write-string "   to ") (write (length solution-set))
      (write-string " partial solutions.") (newline)

      (let ((new-solutions
             (map make-new-solution (cartesian-product solution-set keys))))

        (let ((trimmed-solutions 
                (trim-partial-solutions value->keys-table new-solutions)))

          (write-string "Returning ") (write (length trimmed-solutions))
          (write-string " of ") (write (length new-solutions))
          (write-string " new partial solutions.") (newline)

          trimmed-solutions))))

  (define (cover v-k-entries)
    (cond ((pair? v-k-entries)
           (pick-v-k-entry value->keys-table v-k-entries
                           (lambda (selected remaining)
                             (add-v-k-entry (cover remaining) selected))))
          ((null? v-k-entries)
           (list '()))
          (else (improper-list-error 'cover v-k-entries))))

  (let ((minimized (minimize-vktable value->keys-table better-solution)))
    (least-elements (cover minimized) better-solution)))

(define (pick-v-k-entry value->keys-table v-k-entries receiver)
  (define (score v-k-entry)
    (let* ((matched-all 
     (count-matching-items value->keys-table
      (lambda (other)
        (there-exists? (cdr v-k-entry)
                 (lambda (key) (member key (cdr other)))))))
           (matched-remaining
            (count-matching-items v-k-entries
                                  (lambda (other)
                                    (there-exists? (cdr v-k-entry)
                                       (lambda (key) (member key (cdr other)))))))
           (matched-forward (- matched-all matched-remaining)))
      (cons matched-remaining matched-forward)))

  (let ((scored (map (lambda (v-k-entry) (cons (score v-k-entry) v-k-entry))
                      v-k-entries)))

    (let ((picked 
    (cdar
     (least-elements scored
       (lambda (left right)
         (let* ((len-l (length (cdr left)))
         (len-r (length (cdr right)))
         (lmr (caar left))
         (lmf (cdar left))
         (rmr (caar right))
         (rmf (cdar right)))
    (or (> len-l len-r)
        (and (= len-l len-r)
      (or (> lmf rmf)
          (and (= lmf rmf)
        (< lmr rmr)))))
    ))))))

      (display "Picking ") (write picked) (newline)
      (receiver picked (delete picked v-k-entries)))))

(define (trim-partial-solutions value->keys-table partial-solutions)
    (let ((equivalent-solutions
           (map (lambda (entry) (cons (cdr entry) (car entry)))
                (collect-equivalent-partial-solutions value->keys-table
                                                      partial-solutions))))
      (write-string "  Deleting ")
      (write (- (length partial-solutions) (length equivalent-solutions)))
      (write-string " equivalent partial solutions.")
      (newline)

      (remove-dominated-solutions value->keys-table
                                  (map lowest-scoring-equivalent-partial-solution
                                       equivalent-solutions))))
Finally, it turns out that computing dominating partial solutions is expensive, so I changed the set operations to use a bitmap representation:
(define (remove-dominated-solutions value->keys-table partial-solutions)
  (let ((before-length (length partial-solutions))
        (all-values (get-values value->keys-table))) 
    (let ((table
           ;; put the long ones in first
           (sort
            (map (lambda (partial-solution)
                   (cons partial-solution
                     (lset->bset all-values 
                       (map car (partial-solution-matches value->keys-table 
                                                          partial-solution)))))
                 partial-solutions)
            (lambda (left right)
              (> (length (bset->lset all-values (cdr left)))
                 (length (bset->lset all-values (cdr right))))))))

      (let ((answer (map car
                         (fold-left (lambda (answer solution)
                                      (if (there-exists? answer 
                                                         (dominates-solution? solution))
                                          answer
                                          (cons solution answer)))
                                    '()
                                    table))))
        (let ((after-length (length answer)))
          (write-string "  Removing ") (write (- before-length after-length))
          (write-string " dominated solutions.")
          (newline)
          answer)))))

(define (dominates-solution? solution)
  (let* ((partial-solution (car solution))
         (partial-solution-score (score partial-solution))
         (solution-matches-raw (cdr solution)))
    (lambda (other-solution)
      (let* ((other-partial-solution (car other-solution))
             (other-matches-raw (cdr other-solution)))
        (and
         (bset-superset? other-matches-raw solution-matches-raw)
         (<= (score other-partial-solution) partial-solution-score))))))

(define (get-values v-k-table)
  (fold-left (lambda (answer entry) (lset-adjoin equal? answer (car entry)))
             '()
             v-k-table))

(define (bset-element->bit universe element)
  (cond ((null? element) 0)
        (else (expt 2 (list-index (lambda (item) (eq? item element)) universe)))))

(define (bset-adjoin universe bset element)
  (bset-union bset (bset-element->bit universe element)))

(define (lset->bset universe lset)
  (fold-left (lambda (answer element)
               (bset-adjoin universe answer element))
             0
             lset))

(define (bset->lset universe bset)
  (cond ((zero? bset) '())
        ((even? bset) (bset->lset (cdr universe) (/ bset 2)))
        (else (cons (car universe) (bset->lset (cdr universe) (/ (- bset 1) 2))))))

(define (bset-union left right) (bitwise-ior left right))

(define (bset-superset? bigger smaller)
  ;; Is every element of smaller in bigger?
  (zero? (bitwise-andc2 smaller bigger)))
This code can now find the shortest regular expression consisting of letters and dots (and ^$) that matches one set of strings but not another.

Depending on the strings, this can take quite a bit of time to run. Dotted expressions cause a combinatorical explosion in matching regexps (or substrings), but what makes it worse is that the dotted expressions tend to span different sets of strings. If two different dotted expressions, each with different matching sets of strings, appear in a single string, then the number of partial solutions will be multiplied by two as we try each different dotted expression.

It is characteristic of NP problems that it is easy to determine if you have a good solution, but quite hard to find it among a huge number of other, poor solutions. This problem exhibits this characteristic, but there is a bit more structure in the problem that we are exploiting. The word lists are drawn from the English language. This makes some bigrams, trigrams, etc. far, far, more likely to appear than others.

Short words are much easier to process than longer ones because they simply contain fewer things to match. On the other hand, longer words tend to be dominated by shorter ones anyway.

To be continued...

Joe MarshallMini regex golf 2: adding regular expressions

· 20 days ago
It wasn't too hard to add regular expressions to the substring version. What took a while was just tinkering with the code, breaking it, fixing it again, noticing an optimization, tinkering, etc. etc. In any case it works and here is some of it.
(define (make-extended-ngram-table winners losers)
  (let* ((initial-ngrams (generate-ngrams winners losers)))
    (write-string "Initial ngrams: ") (write (length initial-ngrams))
    (newline)
    (map (lambda (winner)
           (cons winner
                 (keep-matching-items initial-ngrams
                    (lambda (ngram) (re-string-search-forward ngram winner)))))
         winners)))

(define (generate-ngrams winners losers)
  (write-string "Generating ngrams...")(newline)
  (let ((losing-ngram? (string-list-matcher losers)))
    (fold-left (lambda (answer winner)
                 (lset-union equal? answer (extended-ngrams losing-ngram? winner)))
               '()
               winners)))

(define (string-list-matcher string-list)
  (lambda (test-ngram)
    (there-exists? string-list
                   (lambda (string)
                     (re-string-search-forward test-ngram string)))))

(define *dotification-limit* 4)
(define *generate-ends-of-words* #t)
(define *generate-dotted* #t)

(define (ngrams-of-length n string)
  (do ((start    0 (1+ start))
       (end      n (1+ end))
       (answer '() (lset-adjoin string=? answer (substring string start end))))
      ((> end (string-length string)) answer)))

(define (generate-dotted answer losing-ngram?)
  (do ((tail answer (cdr tail))
       (answer '() (let ((item (car tail)))
                     (fold-left (lambda (answer dotted)
                                  (if (losing-ngram? dotted)
                                      answer
                                      (lset-adjoin string=? answer dotted)))
                                answer
                                (dotify item)))))
      ((not (pair? tail))
       (if (null? tail)
           answer
           (improper-list-error 'generate-dotted tail)))))

(define (dotify word)
  (cond ((string=? word "") (list ""))
        ((> (string-length word) *dotification-limit*) (list word))
        (else
         (fold-left (lambda (answer dotified)
                      (fold-left (lambda (answer replacement)
                                   (lset-adjoin equal? answer 
                                        (string-append replacement dotified)))
                                 answer
                                 (replacements (substring word 0 1))))
                    '()
                    (dotify (substring word 1 (string-length word)))))))

(define (replacements string)
  (if (or (string=? string "^")
          (string=? string "$"))
      (list string)
      (list string ".")))

(define (extended-ngrams losing-ngram? string)
  (let ((string (if *generate-ends-of-words*
                    (string-append "^" string "$")
                    string)))
    (do ((n 1    (+ n 1))
         (answer '() (lset-union
                      string=? answer
                      (delete-matching-items (ngrams-of-length n string)
                                             losing-ngram?))))
        ((> n (string-length string))
         (if *generate-dotted*
             (generate-dotted answer losing-ngram?)
             answer)))))
Adding the dotification greatly increases the number of ways to match words:
1 ]=> (extended-ngrams (string-list-matcher losers) "lincoln")

;Value 15: ("li" "ln" "ln$" "oln" ".ln" "col" "lin" "li." "^li" "o.n$" "oln$" ".ln$" "col." "c.ln" "..ln" "coln" ".oln" "co.n" "n.ol" "..ol" "ncol" ".col" "nc.l" "i.co" "inco" "i..o" "in.o" "lin." "li.." "l.nc" "linc" "l..c" "li.c" "^li." "^lin" "coln$" "ncoln" "incol" "linco" "^linc" "ncoln$" "incoln" "lincol" "^linco" "incoln$" "lincoln" "^lincol" "lincoln$" "^lincoln" "^lincoln$")
The table that maps words to their extended ngrams is quite large, but it can be reduced in size without affecting the solution to the set cover problem. If two regexps match exactly the same set of winning strings, then one can be substituted for the other in any solution, so we can discard all but the shortest of these. If a regexp matches a proper superset of another regexp, and the other regexp is at least the same length or longer, then the first regexp dominates the second one, so we can discard the second one.
(define (minimize-keys value->keys-table better-solution)
  (let* ((all-keys (get-keys value->keys-table))
         (equivalents (collect-equivalent-partial-solutions value->keys-table
                         (map list all-keys)))
         (reduced (map (lambda (equivalent)
                         (cons (car equivalent)
                               (car (least-elements (cdr equivalent)
                                                    better-solution))))
                       equivalents))
         (dominants (collect-dominant-partial-solutions reduced better-solution))
         (good-keys (fold-left (lambda (answer candidate)
                                 (lset-adjoin equal? answer (cadr candidate)))
                               '()
                               dominants)))

    (define (rebuild-entry entry)
      (cons (car entry) (keep-matching-items (cdr entry)
                             (lambda (item) (member item good-keys)))))

    (write-string "Deleting ") (write (- (length all-keys) (length good-keys)))
    (write-string " of ") (write (length all-keys)) (write-string " keys.  ")
    (write (length good-keys)) (write-string " keys remain.")(newline)
    (map rebuild-entry value->keys-table)))

(define (partial-solution-matches value->keys-table partial-solution)
  (keep-matching-items
   value->keys-table
   (lambda (entry)
     (there-exists? partial-solution (lambda (key) (member key (cdr entry)))))))

(define (collect-equivalent-partial-solutions value->keys-table partial-solutions)
  (let ((answer-table (make-equal-hash-table)))

    (for-each (lambda (partial-solution)
                (hash-table/modify! answer-table
                                   (map car (partial-solution-matches 
                                               value->keys-table 
                                               partial-solution))
                                    (list)
                                    (lambda (other)
                                      (lset-adjoin equal? other partial-solution))))
              partial-solutions)

    (hash-table->alist answer-table)))

(define (collect-dominant-partial-solutions equivalents better-solution)
  (define (dominates? left right)
    (and (superset? (car left) (car right))
         (not (better-solution (cdr right) (cdr left)))))

  (let ((sorted (sort equivalents 
                      (lambda (l r) (> (length (car l)) (length (car r)))))))
    (fold-left (lambda (answer candidate)
                 (if (there-exists? answer (lambda (a) (dominates? a candidate)))
                     answer
                     (lset-adjoin equal? answer candidate)))
               '()
               sorted)))
We can minimize the value->key-table in another way. If two values in the table are matched by the exact same set of keys, then we can delete one without changing the solution. If a value is matched by a small set of keys, and if another values is matched by a superset of these keys, then we can delete the larger one because if the smaller one matches, the larger one must match as well.
(define (minimize-values v-k-table)
  (let ((size-before (length v-k-table)))

    (define (dominated-value? entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? v-k-table
          (lambda (other-entry)
            (and (not (eq? entry other-entry))
                 (let ((other-value (car other-entry))
                       (other-keylist (cdr other-entry)))
                   (let ((result (and (superset? entry-keylist other-keylist)
                                      (not (superset? other-keylist entry-keylist)))))
                     (if result
                         (begin (display "Removing ")
                                (write entry-value)
                                (display " dominated by ")
                                (write other-value)
                                (display ".")
                                (newline)
                                ))
                     result)))))))

    (define (equivalent-value-in-answer? answer entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? answer
          (lambda (other-entry)
            (let ((other-value (car other-entry))
                  (other-keylist (cdr other-entry)))
              (let ((result (equal? entry-keylist other-keylist)))
                (if result
                    (begin (display "Removing ")
                           (write entry-value)
                           (display " equivalent to ")
                           (write other-value)
                           (display ".")
                           (newline)
                           ))
                result))))))

    (define (add-entry answer entry)
      (if (or (equivalent-value-in-answer? answer entry)
              (dominated-value? entry))
          answer
          (cons entry answer)))

    (let ((answer (fold-left add-entry '() v-k-table)))
      (write-string "Removed ") (write (- size-before (length answer)))
      (write-string " dominated and equivalent values.")
      (newline)
      answer)))
Each time we remove values or keys, we might make more keys and values equivalent or dominated, so we iterate until we can no longer remove anything.
(define (minimize-vktable value->keys-table better-solution)
  (let* ((before-size (fold-left + 0 (map length value->keys-table)))
         (new-table
          (minimize-values
           (minimize-keys value->keys-table better-solution)))
         (after-size (fold-left + 0 (map length new-table))))
    (if (= before-size after-size)
        value->keys-table
        (minimize-vktable new-table better-solution))))
The minimized table for the presidents looks like this:
(("washington" "sh" "g..n" "n..o" ".h.n" "a..i")
 ("adams" "a.a" "am" "ad")
 ("madison" "m..i" "i..n" "is." "i.o" "di" "ma" "ad")
 ("monroe" "r.e$" "oe")
 ("van-buren" "u..n" "r.n" ".b" "bu" "-")
 ("harrison" "r..s" "r.i" "i..n" "is." "i.o" "a..i")
 ("polk" "po")
 ("taylor" "ay." "ta")
 ("pierce" "ie." "rc" "r.e$")
 ("buchanan" "bu" "a.a" ".h.n")
 ("lincoln" "i..o" "li")
 ("grant" "an.$" "a.t" "ra" "r.n" "g..n")
 ("hayes" "h..e" "ye" "ay.")
 ("garfield" "el.$" "i.l" "ga" "ie." "r.i" ".f" "a..i")
 ("cleveland" "v.l" "an.$")
 ("mckinley" "n.e" "nl" "i.l" "m..i")
 ("roosevelt" ".se" "oo" "v.l" "el.$" "r..s")
 ("taft" "a.t" "ta" ".f")
 ("wilson" "ls" "i..o")
 ("harding" "r.i" "di" "a..i")
 ("coolidge" "oo" "li")
 ("hoover" "ho" "oo")
 ("truman" "u..n" "ma")
 ("eisenhower" "ho" ".se" "h..e" "i..n" "is.")
 ("kennedy" "nn" "n.e")
 ("johnson" "j")
 ("nixon" "^n" "i..n" "i.o" "n..o")
 ("carter" "rt" "a.t")
 ("reagan" "ga" "a.a")
 ("bush" "bu" "sh")
 ("obama" ".b" "ma" "a.a" "am"))
As you can see, we have reduced the original 2091 matching regexps to fifty.

Changes to the set-cover code coming soon....

Nick LevineMontréal

· 21 days ago
I'm arriving on Tuesday. Will anyone else be around before the lisp conference starts, and are they interested in a little touristing / dining experiences?

Joe MarshallMini regex golf

· 26 days ago
I was intrigued by Peter Norvig's articles about regex golf.

To make things easier to think about, I decided to start with the simpler problem of looking for substrings. Here's code to extract the ngrams of a string:
(define (ngrams-of-length n string)
  (do ((start    0 (1+ start))
       (end      n (1+ end))
       (answer '() (lset-adjoin string=? answer (substring string start end))))
      ((> end (string-length string)) answer)))

(define (ngrams string)
  (do ((n 1 (+ n 1))
       (answer '() (append (ngrams-of-length n string) answer)))
      ((> n (string-length string)) answer)))
A solution is simply a list of ngrams. (Although not every list of ngrams is a solution!)
(define (solution? solution winners losers)
  (let ((matches-solution? (ngram-list-matcher solution)))
    (and (for-all? winners matches-solution?)
         (not (there-exists? losers matches-solution?)))))

(define (ngram-list-matcher ngram-list)
  (lambda (test-string)
    (there-exists? ngram-list 
     (lambda (ngram)
       (string-search-forward ngram test-string)))))
We also want to know if an ngram appears in a given list of strings.
(define (string-list-matcher string-list)
  (lambda (test-ngram)
    (there-exists? string-list
     (lambda (string)
       (string-search-forward test-ngram string)))))

(fluid-let ((*unparser-list-breadth-limit* 10))
    (let ((matches-loser? (string-list-matcher losers)))
      (for-each
       (lambda (winner) (write-string winner) (write-string ": ") 
        (write (reverse (delete-matching-items (ngrams winner) matches-loser?)))
        (newline))
       winners)))

washington: ("sh" "hi" "gt" "to" "was" "ash" "shi" "hin" "ngt" "gto" ...)
adams: ("ad" "am" "ms" "ada" "dam" "ams" "adam" "dams" "adams")
jefferson: ("j" "je" "ef" "ff" "fe" "rs" "jef" "eff" "ffe" "fer" ...)
madison: ("ma" "ad" "di" "mad" "adi" "dis" "iso" "madi" "adis" "diso" ...)
monroe: ("oe" "onr" "nro" "roe" "monr" "onro" "nroe" "monro" "onroe" "monroe")
jackson: ("j" "ja" "ac" "ks" "jac" "ack" "cks" "kso" "jack" "acks" ...)
van-buren: ("-" "va" "n-" "-b" "bu" "van" "an-" "n-b" "-bu" "bur" ...)
harrison: ("har" "arr" "rri" "ris" "iso" "harr" "arri" "rris" "riso" "ison" ...)
polk: ("po" "pol" "olk" "polk")
taylor: ("ta" "yl" "lo" "tay" "ayl" "ylo" "lor" "tayl" "aylo" "ylor" ...)
pierce: ("rc" "ce" "pie" "ier" "erc" "rce" "pier" "ierc" "erce" "pierc" ...)
buchanan: ("bu" "uc" "ch" "na" "buc" "uch" "cha" "ana" "nan" "buch" ...)
lincoln: ("li" "ln" "lin" "col" "oln" "linc" "inco" "ncol" "coln" "linco" ...)
grant: ("ra" "gra" "ran" "ant" "gran" "rant" "grant")
hayes: ("ye" "hay" "aye" "yes" "haye" "ayes" "hayes")
garfield: ("ga" "rf" "fi" "gar" "arf" "rfi" "fie" "iel" "eld" "garf" ...)
cleveland: ("lev" "vel" "ela" "clev" "leve" "evel" "vela" "elan" "cleve" "level" ...)
mckinley: ("nl" "mck" "inl" "nle" "mcki" "kinl" "inle" "nley" "mckin" "ckinl" ...)
roosevelt: ("oo" "os" "lt" "roo" "oos" "ose" "sev" "vel" "elt" "roos" ...)
taft: ("ta" "af" "ft" "taf" "aft" "taft")
wilson: ("ls" "ils" "lso" "wils" "ilso" "lson" "wilso" "ilson" "wilson")
harding: ("di" "har" "ard" "rdi" "din" "hard" "ardi" "rdin" "ding" "hardi" ...)
coolidge: ("oo" "li" "coo" "ool" "oli" "lid" "cool" "ooli" "olid" "lidg" ...)
hoover: ("ho" "oo" "hoo" "oov" "hoov" "oove" "hoove" "oover" "hoover")
truman: ("tr" "ru" "ma" "tru" "rum" "uma" "man" "trum" "ruma" "uman" ...)
eisenhower: ("ei" "nh" "ho" "ow" "eis" "ise" "sen" "enh" "nho" "how" ...)
kennedy: ("nn" "ed" "dy" "ken" "enn" "nne" "ned" "edy" "kenn" "enne" ...)
johnson: ("j" "jo" "oh" "hn" "joh" "ohn" "hns" "john" "ohns" "hnso" ...)
nixon: ("ni" "ix" "xo" "nix" "ixo" "xon" "nixo" "ixon" "nixon")
carter: ("rt" "car" "art" "rte" "cart" "arte" "rter" "carte" "arter" "carter")
reagan: ("ea" "ag" "ga" "rea" "eag" "aga" "gan" "reag" "eaga" "agan" ...)
bush: ("bu" "us" "sh" "bus" "ush" "bush")
clinton: ("li" "to" "cli" "lin" "int" "nto" "ton" "clin" "lint" "into" ...)
obama: ("ob" "ba" "am" "ma" "oba" "bam" "ama" "obam" "bama" "obama")
We can discard ngrams like "shi" because the shorter ngram "sh" will also match.
(define (dominant-ngrams string losing-ngram?)
  (do ((n 1 (+ n 1))
       (answer '() (append
                     (delete-matching-items
                      (ngrams-of-length n string)
                      (lambda (item)
                        (or (there-exists? answer
                                           (lambda (ngram)
                                             (string-search-forward ngram item)))
                            (losing-ngram? item))))
                    answer)))
      ((> n (string-length string)) answer)))


(fluid-let ((*unparser-list-breadth-limit* 10))
    (let ((matches-loser? (string-list-matcher losers)))
      (for-each
       (lambda (winner) (write-string winner) (write-string ": ") 
        (write (dominant-ngrams winner matches-loser?))
        (newline))
       winners)))

washington: ("was" "to" "gt" "hi" "sh")
adams: ("ms" "am" "ad")
jefferson: ("rs" "fe" "ff" "ef" "j")
madison: ("iso" "di" "ad" "ma")
monroe: ("nro" "onr" "oe")
jackson: ("ks" "ac" "j")
van-buren: ("ren" "ure" "bu" "va" "-")
harrison: ("iso" "ris" "rri" "arr" "har")
polk: ("olk" "po")
taylor: ("lo" "yl" "ta")
pierce: ("ier" "pie" "ce" "rc")
buchanan: ("na" "ch" "uc" "bu")
lincoln: ("inco" "col" "ln" "li")
grant: ("ant" "ra")
hayes: ("hay" "ye")
garfield: ("eld" "iel" "fi" "rf" "ga")
cleveland: ("ela" "vel" "lev")
mckinley: ("mck" "nl")
roosevelt: ("vel" "sev" "lt" "os" "oo")
taft: ("ft" "af" "ta")
wilson: ("ls")
harding: ("ard" "har" "di")
coolidge: ("li" "oo")
hoover: ("oo" "ho")
truman: ("ma" "ru" "tr")
eisenhower: ("wer" "sen" "ise" "ow" "ho" "nh" "ei")
kennedy: ("ken" "dy" "ed" "nn")
johnson: ("hn" "oh" "j")
nixon: ("xo" "ix" "ni")
carter: ("car" "rt")
reagan: ("ga" "ag" "ea")
bush: ("sh" "us" "bu")
clinton: ("int" "to" "li")
obama: ("ma" "am" "ba" "ob")
It's time to tackle the set cover problem. We want a set of ngrams that match all the strings. Obviously, if we pick an ngram from each of the strings we want to cover, we'll have a solution. For instance,
(let ((matches-loser? (string-list-matcher losers)))
  (solution? (delete-duplicates
                 (map
                    (lambda (winner) (car (dominant-ngrams winner matches-loser?)))
                    winners))
                winners losers))
;Value: #t
We can cycle through all the possible solutions and then select the best one.
(define (mini-golf0 winners losers)
  (lowest-scoring
   (cover0 (make-dominant-ngram-table
            winners
            (delete-losing-superstrings winners losers)))))

(define (delete-losing-superstrings winners losers)
  (delete-matching-items
   losers
   (lambda (loser)
     (there-exists? winners
                    (lambda (winner)
                      (string-search-forward winner loser))))))

(define (make-dominant-ngram-table winners losers)
  (let ((losing-ngram? (string-list-matcher losers)))
    (map (lambda (winner)
           (cons winner (dominant-ngrams winner losing-ngram?)))
         winners)))

(define (cover0 v-k-table)
  (let ((empty-solution-set (list '())))
    (fold-left add-v-k-entry0 empty-solution-set v-k-table)))

(define (add-v-k-entry0 solution-set v-k-entry)
  (let ((value (car v-k-entry))
        (keys  (cdr v-k-entry)))

    (write-string "Adding value ") (write value) (newline)
    (write-string "   with keys ") (write keys) (newline)
    (write-string "   to ") (write (length solution-set))
    (write-string " partial solutions.") (newline)

    (let ((new-solutions
           (map make-new-solution (cartesian-product solution-set keys))))

      (write-string "Returning ") (write (length new-solutions))
      (write-string " new partial solutions.") (newline)

      new-solutions)))

(define (lowest-scoring list)
  (least-elements list (lambda (l r) (< (score l) (score r)))))

(define (cartesian-product left-list right-list)
  (fold-left (lambda (answer left)
               (fold-left (lambda (answer right)
                            (cons (cons left right) answer))
                          answer
                          right-list))
             '()
             left-list))

(define (make-new-solution cp-term)
  (let ((solution (car cp-term))
        (key (cdr cp-term)))
    (lset-adjoin equal? solution key)))

(define (improper-list-error procedure thing)
  (error (string-append "Improper list found by " procedure ": ") thing))

(define (least-elements list <)
  (define (accumulate-least answer item)
    (cond ((< (car answer) item) answer)
          ((< item (car answer)) (cons item '()))
          (else (cons item answer))))

  (cond ((pair? list) (fold-left accumulate-least
                                 (cons (car list) '())
                                 (cdr list)))
        ((null? list) (error "List must have at least one element." list))
        (else (improper-list-error 'LEAST-ELEMENTS list))))

(define (score solution)
  (do ((tail solution (cdr tail))
       (score -1      (+ score (string-length (car tail)) 1)))
      ((not (pair? tail))
       (if (null? tail)
           score
           (improper-list-error 'score solution)))))
This works for small sets:
1 ]=> (mini-golf0 boys girls)
Adding value "jacob"
   with keys ("ob" "c" "j")
   to 1 partial solutions.
Returning 3 new partial solutions.
Adding value "mason"
   with keys ("as")
   to 3 partial solutions.
Returning 3 new partial solutions.
Adding value "ethan"
   with keys ("an" "ha")
   to 3 partial solutions.
Returning 6 new partial solutions.
Adding value "noah"
   with keys ("ah" "oa" "no")
   to 6 partial solutions.
Returning 18 new partial solutions.
Adding value "william"
   with keys ("lia" "lli" "ill" "am" "w")
   to 18 partial solutions.
Returning 90 new partial solutions.
Adding value "liam"
   with keys ("lia" "am")
   to 90 partial solutions.
Returning 180 new partial solutions.
Adding value "jayden"
   with keys ("en" "de" "yd" "ay" "j")
   to 180 partial solutions.
Returning 900 new partial solutions.
Adding value "michael"
   with keys ("ae" "ha" "c")
   to 900 partial solutions.
Returning 2700 new partial solutions.
Adding value "alexander"
   with keys ("de" "nd" "an" "le" "al" "r" "x")
   to 2700 partial solutions.
Returning 18900 new partial solutions.
Adding value "aiden"
   with keys ("en" "de" "id")
   to 18900 partial solutions.
Returning 56700 new partial solutions.
;Value 41: (("de" "am" "ah" "ha" "as" "j")
            ("de" "am" "ah" "ha" "as" "j")
            ("de" "am" "oa" "ha" "as" "j")
            ("de" "am" "oa" "ha" "as" "j")
            ("de" "am" "no" "ha" "as" "j")
            ("de" "am" "no" "ha" "as" "j")
            ("de" "am" "ah" "ha" "as" "c")
            ("de" "am" "ah" "ha" "as" "c")
            ("de" "am" "oa" "ha" "as" "c")
            ("de" "am" "oa" "ha" "as" "c")
            ("de" "am" "no" "ha" "as" "c")
            ("de" "am" "no" "ha" "as" "c")
            ("de" "am" "ah" "an" "as" "c")
            ("de" "am" "ah" "an" "as" "c")
            ("en" "am" "ah" "an" "as" "c")
            ("de" "am" "oa" "an" "as" "c")
            ("de" "am" "oa" "an" "as" "c")
            ("en" "am" "oa" "an" "as" "c")
            ("de" "am" "no" "an" "as" "c")
            ("de" "am" "no" "an" "as" "c")
            ("en" "am" "no" "an" "as" "c"))
But you can see that we won't be able to go much beyond this because there are just too many combinations. We can cut down on the intermediate partial solutions by noticing that many of them are redundant. We don't need to keep partial solutions that cannot possibly lead to a shortest final solution. The various partial solutions each (potentially) match different sets of words. We only need keep the shortest solution for each different set of matched words. Furthermore, if a solution's matches are a superset of another's matches, and the other is the same length or longer, then the solution is dominated by the other and will always be at least the length of the longer.
(define (mini-golf1 winners losers)
  (cover1
   (make-dominant-ngram-table winners (delete-losing-superstrings winners losers))
   lowest-scoring))

(define (cover1 v-k-table lowest-scoring)
  (let ((empty-solution-set (list '())))

    (define (add-v-k-entry solution-set v-k-entry)
      (let ((value (car v-k-entry))
            (keys  (cdr v-k-entry)))

        (write-string "Adding value ") (write value) (newline)
        (write-string "   with keys ") (write keys) (newline)
        (write-string "   to ") (write (length solution-set))
        (write-string " partial solutions.") (newline)

        (let ((new-solutions
               (map make-new-solution (cartesian-product solution-set keys))))

          (let ((trimmed-solutions (trim-partial-solutions new-solutions)))

            (write-string "Returning ") (write (length trimmed-solutions))
            (write-string " of ") (write (length new-solutions))
            (write-string " new partial solutions.") (newline)

            trimmed-solutions))))

    (define (trim-partial-solutions partial-solutions)
      (let ((equivalent-solutions (collect-equivalent-partial-solutions partial-solutions)))
        (write-string "  Deleting ")
        (write (- (length partial-solutions) (length equivalent-solutions)))
        (write-string " equivalent partial solutions.")
        (newline)

        (remove-dominated-solutions
         (map lowest-scoring-equivalent-partial-solution equivalent-solutions))))

    (define (lowest-scoring-equivalent-partial-solution entry)
      (first (lowest-scoring (car entry))))

    (define (collect-equivalent-partial-solutions alist)
      ;; Add each entry in turn.
      (fold-left (lambda (equivalents partial-solution)
                   (add-equivalent-partial-solution
                    partial-solution
                    (partial-solution-matches partial-solution)
                    equivalents))
                 '() alist))

    (define (partial-solution-matches partial-solution)
      (keep-matching-items v-k-table
        (lambda (entry)
          (there-exists? partial-solution
                         (lambda (key) (member key (cdr entry)))))))

    (define (remove-dominated-solutions partial-solutions)
      (let ((before-length (length partial-solutions)))
        (let ((answer  (map car (fold-left (lambda (answer solution)
                                             (if (there-exists? answer (dominates-solution? solution))
                                                 answer
                                                 (cons solution answer)))
                                           '()
                                           (map (lambda (partial-solution)
                                                  (cons partial-solution (partial-solution-matches partial-solution)))
                                                partial-solutions)))))
          (let ((after-length (length answer)))
            (write-string "  Deleting ") (write (- before-length after-length))
            (write-string " dominated solutions.")
            (newline)
            answer))))

    (lowest-scoring
     (fold-left add-v-k-entry empty-solution-set v-k-table))))

(define (dominates-solution? solution)
  (let ((partial-solution (car solution))
        (solution-matches (cdr solution)))
    (lambda (other-solution)
      (let ((other-partial-solution (car other-solution))
            (other-matches (cdr other-solution)))
        (and (not (equal? solution-matches other-matches))
             (superset? other-matches solution-matches)
             (<= (score other-partial-solution) (score partial-solution)))))))

(define (add-equivalent-partial-solution solution value alist)
  (cond ((pair? alist)
         (let ((entry (car alist))
               (tail (cdr alist)))
           (let ((entry-solutions (car entry))
                 (entry-value (cdr entry)))
             (if (equal? value entry-value)
                 (if (member solution entry-solutions)
                     alist
                     (cons (cons (cons solution entry-solutions) value)
                           tail))
                 (cons entry (add-equivalent-partial-solution solution value tail))))))
        ((null? alist) (list (cons (list solution) value)))
        (else (improper-list-error 'collect-equivalents alist))))
1 ]=> (mini-golf1 winners losers)
Adding value "washington"
   with keys ("was" "to" "gt" "hi" "sh")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 1 dominated solutions.
Returning 2 of 5 new partial solutions.
Adding value "adams"
   with keys ("ms" "am" "ad")
   to 2 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 4 of 6 new partial solutions.
Adding value "jefferson"
   with keys ("rs" "fe" "ff" "ef" "j")
   to 4 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 4 dominated solutions.
Returning 4 of 20 new partial solutions.
Adding value "madison"
   with keys ("iso" "di" "ad" "ma")
   to 4 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 12 of 16 new partial solutions.
Adding value "monroe"
   with keys ("nro" "onr" "oe")
   to 12 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 36 new partial solutions.
Adding value "jackson"
   with keys ("ks" "ac" "j")
   to 12 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 36 new partial solutions.
Adding value "van-buren"
   with keys ("ren" "ure" "bu" "va" "-")
   to 12 partial solutions.
  Deleting 36 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 24 of 60 new partial solutions.
Adding value "harrison"
   with keys ("iso" "ris" "rri" "arr" "har")
   to 24 partial solutions.
  Deleting 96 equivalent partial solutions.
  Removing 12 dominated solutions.
Returning 12 of 120 new partial solutions.
Adding value "polk"
   with keys ("olk" "po")
   to 12 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 24 new partial solutions.
Adding value "taylor"
   with keys ("lo" "yl" "ta")
   to 12 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 12 dominated solutions.
Returning 12 of 36 new partial solutions.
Adding value "pierce"
   with keys ("ier" "pie" "ce" "rc")
   to 12 partial solutions.
  Deleting 36 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 48 new partial solutions.
Adding value "buchanan"
   with keys ("na" "ch" "uc" "bu")
   to 12 partial solutions.
  Deleting 39 equivalent partial solutions.
  Removing 3 dominated solutions.
Returning 6 of 48 new partial solutions.
Adding value "lincoln"
   with keys ("inco" "col" "ln" "li")
   to 6 partial solutions.
  Deleting 15 equivalent partial solutions.
  Removing 6 dominated solutions.
Returning 3 of 24 new partial solutions.
Adding value "grant"
   with keys ("ant" "ra")
   to 3 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 3 of 6 new partial solutions.
Adding value "hayes"
   with keys ("hay" "ye")
   to 3 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 3 of 6 new partial solutions.
Adding value "garfield"
   with keys ("eld" "iel" "fi" "rf" "ga")
   to 3 partial solutions.
  Deleting 9 equivalent partial solutions.
  Removing 3 dominated solutions.
Returning 3 of 15 new partial solutions.
Adding value "cleveland"
   with keys ("ela" "vel" "lev")
   to 3 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 9 new partial solutions.
Adding value "mckinley"
   with keys ("mck" "nl")
   to 6 partial solutions.
  Deleting 6 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 12 new partial solutions.
Adding value "roosevelt"
   with keys ("vel" "sev" "lt" "os" "oo")
   to 6 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 30 new partial solutions.
Adding value "taft"
   with keys ("ft" "af" "ta")
   to 6 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 18 new partial solutions.
Adding value "wilson"
   with keys ("ls")
   to 6 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 6 new partial solutions.
Adding value "harding"
   with keys ("ard" "har" "di")
   to 6 partial solutions.
  Deleting 12 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 4 of 18 new partial solutions.
Adding value "coolidge"
   with keys ("li" "oo")
   to 4 partial solutions.
  Deleting 4 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 4 of 8 new partial solutions.
Adding value "hoover"
   with keys ("oo" "ho")
   to 4 partial solutions.
  Deleting 4 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 2 of 8 new partial solutions.
Adding value "truman"
   with keys ("ma" "ru" "tr")
   to 2 partial solutions.
  Deleting 4 equivalent partial solutions.
  Removing 1 dominated solutions.
Returning 1 of 6 new partial solutions.
Adding value "eisenhower"
   with keys ("wer" "sen" "ise" "ow" "ho" "nh" "ei")
   to 1 partial solutions.
  Deleting 6 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 7 new partial solutions.
Adding value "kennedy"
   with keys ("ken" "dy" "ed" "nn")
   to 1 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 4 new partial solutions.
Adding value "johnson"
   with keys ("hn" "oh" "j")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "nixon"
   with keys ("xo" "ix" "ni")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "carter"
   with keys ("car" "rt")
   to 1 partial solutions.
  Deleting 1 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 2 new partial solutions.
Adding value "reagan"
   with keys ("ga" "ag" "ea")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "bush"
   with keys ("sh" "us" "bu")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "clinton"
   with keys ("int" "to" "li")
   to 1 partial solutions.
  Deleting 2 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 3 new partial solutions.
Adding value "obama"
   with keys ("ma" "am" "ba" "ob")
   to 1 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 4 new partial solutions.
;Value 47: (("rt" "ni" "nn" "ho" "ls" "nl" "vel" "ga" "ye" "ra" "li" "rc" "ta" "po" "har" "bu" "oe" "ma" "j" "ad" "sh"))
The cover procedure takes a table that maps values to the keys that cover them. If we can reduce the size of that table without changing the solution, we'll run faster. If there are two entries in the table such that the keys of one are a superset of the keys of the other, we can discard the superset: the smaller of the two entries will be in the solution, and any key that matches the smaller one will automatically match the larger one as well. Also, if two values have the same set of keys that match them, we need only include one of the values in the table.
(define (delete-dominated-values v-k-table)
  (let ((size-before (length v-k-table)))

    (define (dominated-value? entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? v-k-table
          (lambda (other-entry)
            (and (not (eq? entry other-entry))
                 (let ((other-value (car other-entry))
                       (other-keylist (cdr other-entry)))
                   (and (superset? entry-keylist other-keylist)
                        (not (equal? other-keylist entry-keylist)))))))))

    (define (equivalent-value-in-answer? answer entry)
      (let ((entry-value (car entry))
            (entry-keylist (cdr entry)))
        (there-exists? answer
          (lambda (other-entry)
            (let ((other-value (car other-entry))
                  (other-keylist (cdr other-entry)))
              (equal? entry-keylist other-keylist))))))

    (define (add-entry answer entry)
      (if (or (equivalent-value-in-answer? answer entry)
              (dominated-value? entry))
          answer
          (cons entry answer)))

    (let ((answer (fold-left add-entry '() v-k-table)))
      (write-string "Removed ") (write (- size-before (length answer)))
      (write-string " dominated and equivalent values.")
      (newline)
      answer)))

(define (superset? bigger smaller)
  (for-all? smaller (lambda (s) (member s bigger))))

(define (mini-golf2 winners losers)
  (cover1
   (delete-dominated-values
    (make-dominant-ngram-table winners (delete-losing-superstrings winners losers)))
   lowest-scoring))

;;;;;;;;
;; Delete dominated keys from the keylists.

(define (mini-golf3 winners losers)
  (cover1
   (delete-dominated-keys-and-values
    (make-dominant-ngram-table winners (delete-losing-superstrings winners losers))
    (lambda (left right)
      (or (< (string-length left) (string-length right))
          (and (= (string-length left) (string-length right))
               (string<? left right)))))
   lowest-scoring))

(define (delete-dominated-keys-and-values v-k-table better-key)
  (let ((before-size (fold-left * 1 (map length v-k-table))))
    (let ((new-table (delete-dominated-values
                      (delete-dominated-keys v-k-table better-key))))
      (let ((after-size (fold-left * 1 (map length new-table))))
        (if (= before-size after-size)
            v-k-table
            (delete-dominated-keys-and-values new-table better-key))))))

(define (delete-dominated-keys v-k-table better-key)
  (let ((all-keys (get-all-keys v-k-table)))

    (define (lookup-key key)
      (cons key
            (map car
                 (keep-matching-items v-k-table
                                      (lambda (v-k-entry)
                                        (member key (cdr v-k-entry)))))))

    (let ((k-v-table (map lookup-key all-keys)))

      (define (dominated-key? key)
        (let ((values (cdr (assoc key k-v-table))))
          (there-exists? k-v-table
                         (lambda (entry)
                           (let ((entry-key (car entry))
                                 (entry-values (cdr entry)))
                             (and (superset? entry-values values)
                                  (not (equal? values entry-values))
                                  (or (< (string-length entry-key) (string-length key))
                                      (and (= (string-length entry-key) (string-length key))
                                           (string<? entry-key key)))))))))

      (define (equivalent-key-in-answer? answer key)
        (let ((values (cdr (assoc key k-v-table))))
          (there-exists? answer
                         (lambda (entry-key)
                           (let ((entry-values (cdr (lookup-key entry-key))))
                             (equal? values entry-values))))))

      (define (add-keys answer key)
        (if (or (dominated-key? key)
                (equivalent-key-in-answer? answer key))
            answer
            (cons key answer)))

      (let ((good-keys (fold-left add-keys '() (sort all-keys better-key))))
        (write-string "Removed ") (write (- (length all-keys) (length good-keys)))
        (write-string " of ") (write (length all-keys)) (write-string " keys.")(newline)

        (map (lambda (entry)
               (cons (car entry)
                     (keep-matching-items (cdr entry) (lambda (key) (member key good-keys)))))
             v-k-table)))))

(define (get-all-keys v-k-table)
  (fold-left (lambda (answer entry)
               (fold-left (lambda (answer key)
                            (lset-adjoin equal? answer key))
                          answer
                          (cdr entry)))
             '()
             v-k-table))
Trimming the table this way helps a lot. We can now compute the dogs vs. cats.
1 ]=> (mini-golf3 dogs cats)

Removed 294 of 405 keys.
Removed 44 dominated and equivalent values.
Removed 25 of 93 keys.
Removed 15 dominated and equivalent values.
Removed 7 of 62 keys.
Removed 0 dominated and equivalent values.
Removed 0 of 55 keys.
Removed 0 dominated and equivalent values.
Adding value "BORZOIS"
   with keys ("OIS" "BOR" "RZ")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 3 of 3 new partial solutions.
Adding value "GIANT SCHNAUZERS"
   with keys ("SCH" "HN")
   to 3 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 6 new partial solutions.
Adding value "BASENJIS"
   with keys ("JI")
   to 6 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 6 of 6 new partial solutions.
Adding value "ENGLISH SETTERS"
   with keys ("TERS" "ETT")
   to 6 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 12 new partial solutions.
Adding value "JAPANESE CHIN"
   with keys ("CHI")
   to 12 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 12 of 12 new partial solutions.
Adding value "BOUVIERS DES FLANDRES"
   with keys ("S F" "DES" " DE" "IER" "FL" "VI")
   to 12 partial solutions.
  Deleting 8 equivalent partial solutions.
  Removing 8 dominated solutions.
Returning 56 of 72 new partial solutions.
Adding value "PEKINGESE"
   with keys ("EKI")
   to 56 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 56 of 56 new partial solutions.
Adding value "BELGIAN MALINOIS"
   with keys (" MAL" "OIS" "LG")
   to 56 partial solutions.
  Deleting 96 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 72 of 168 new partial solutions.
Adding value "GERMAN WIREHAIRED POINTERS"
   with keys ("TERS" "D P")
   to 72 partial solutions.
  Deleting 108 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 144 new partial solutions.
Adding value "CHOW CHOWS"
   with keys ("W ")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "SAMOYEDS"
   with keys ("DS")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "DOGUES DE BORDEAUX"
   with keys ("BOR" " DE" "GU")
   to 36 partial solutions.
  Deleting 88 equivalent partial solutions.
  Removing 2 dominated solutions.
Returning 18 of 108 new partial solutions.
Adding value "DALMATIANS"
   with keys ("ANS" "LM")
   to 18 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "LHASA APSOS"
   with keys ("LH")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 36 of 36 new partial solutions.
Adding value "CANE CORSO"
   with keys (" COR" "ORS")
   to 36 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 72 of 72 new partial solutions.
Adding value "ALASKAN MALAMUTES"
   with keys (" MAL" "TES" "LAS" "KA")
   to 72 partial solutions.
  Deleting 184 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 104 of 288 new partial solutions.
Adding value "WHIPPETS"
   with keys ("IP")
   to 104 partial solutions.
  Deleting 0 equivalent partial solutions.
;GC #199: took:   0.20   (1%) CPU time,   0.10   (1%) real time; free: 16754359
  Removing 0 dominated solutions.
Returning 104 of 104 new partial solutions.
Adding value "SHIBA INU"
   with keys ("SHI" " I")
   to 104 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 208 of 208 new partial solutions.
Adding value "AKITAS"
   with keys ("AK")
   to 208 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 208 of 208 new partial solutions.
Adding value "RHODESIAN RIDGEBACKS"
   with keys ("DES" "DG" "OD")
   to 208 partial solutions.
  Deleting 304 equivalent partial solutions.
  Removing 144 dominated solutions.
Returning 176 of 624 new partial solutions.
Adding value "BICHONS FRISES"
   with keys ("S F" "FR")
   to 176 partial solutions.
  Deleting 224 equivalent partial solutions.
  Removing 16 dominated solutions.
Returning 112 of 352 new partial solutions.
Adding value "PAPILLONS"
   with keys ("API")
   to 112 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 112 of 112 new partial solutions.
Adding value "COLLIES"
   with keys ("IES")
   to 112 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 112 of 112 new partial solutions.
Adding value "VIZSLAS"
   with keys ("LAS" "IZ" "VI")
   to 112 partial solutions.
;GC #200: took:   0.10   (0%) CPU time,   0.10   (1%) real time; free: 16757322
  Deleting 272 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 336 new partial solutions.
Adding value "BRITTANYS"
   with keys ("ITT")
   to 64 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 64 new partial solutions.
Adding value "PUGS"
   with keys ("GS")
   to 64 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 64 new partial solutions.
Adding value "HAVANESE"
   with keys ("HAVANE")
   to 64 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 64 of 64 new partial solutions.
Adding value "COCKER SPANIELS"
   with keys ("ANI" "LS")
   to 64 partial solutions.
  Deleting 80 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 48 of 128 new partial solutions.
Adding value "MASTIFFS"
   with keys ("FS")
   to 48 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 48 of 48 new partial solutions.
Adding value "MALTESE"
   with keys ("TES" "LT")
   to 48 partial solutions.
  Deleting 72 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 24 of 96 new partial solutions.
Adding value "PEMBROKE WELSH CORGIS"
   with keys (" COR" "LS")
   to 24 partial solutions.
  Deleting 32 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 16 of 48 new partial solutions.
Adding value "BOSTON TERRIERS"
   with keys ("IER" " T")
   to 16 partial solutions.
  Deleting 24 equivalent partial solutions.
  Removing 4 dominated solutions.
Returning 4 of 32 new partial solutions.
Adding value "POMERANIANS"
   with keys ("ANS" "ANI")
   to 4 partial solutions.
  Deleting 6 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 2 of 8 new partial solutions.
Adding value "GREAT DANES"
   with keys ("GR")
   to 2 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 2 of 2 new partial solutions.
Adding value "DOBERMAN PINSCHERS"
   with keys ("SCH" " PI")
   to 2 partial solutions.
  Deleting 3 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 4 new partial solutions.
Adding value "SHIH TZU"
   with keys ("SHI" " T")
   to 1 partial solutions.
  Deleting 1 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 2 new partial solutions.
Adding value "ROTTWEILERS"
   with keys ("EI")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
Adding value "POODLES"
   with keys ("DL" "OD")
   to 1 partial solutions.
  Deleting 1 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 2 new partial solutions.
Adding value "BOXERS"
   with keys ("OX")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
Adding value "BEAGLES"
   with keys ("AGL")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
Adding value "LABRADOR RETRIEVERS"
   with keys ("VE")
   to 1 partial solutions.
  Deleting 0 equivalent partial solutions.
  Removing 0 dominated solutions.
Returning 1 of 1 new partial solutions.
;Value 50: (("VE" "AGL" "OX" "EI" "GR" " T" "FS" "LS" "HAVANE" "GS" "ITT" "IES" "API" "FR" "OD" "AK" " I" "IP" "TES" "ORS" "LH" "ANS" "GU" "DS" "W " "EKI" "VI" "CHI" "TERS" "JI" "SCH" "OIS"))
We appear to have the substring version of regex golf under control. Can we extend it to actual regular expressions? Of course we can. In the next installment...

Nicolas HafnerTemplating the World - Confession 21

· 27 days ago

image I have yet to find a single templating system I like, and I've even written my own. Multiple times. Yet, every time I do and every time I look at an existing one, there's just always so many things that bother me and I have yet to figure out a system that I might even begin to like.

One of the major gripes I have with a lot of them is that they mix their own completely different, strange and extremely dumbed-down language into the mix with HTML. This has several glaring disadvantages, the main two being that since it is very featureless you're very limited in what you can do, but also because there is now a different language in there the browser won't be able to display the document properly anymore, which means you can't actually look at the template in any way without either stripping it of code or putting something in it.

Some systems avoid this extra-language kludge by putting all transformations into code somewhere else (e.g. lQuery, HTML-generators). This is already much better, but in the case of lQuery-like systems it means you now have two places with intricate knowledge about the template, the HTML itself and the code that transforms it. In the case of HTML-generators the issue is that now everything is code, so you can't look at it anymore without generating it and it is completely unsuitable for quick designing.

Another approach is to add special HTML tags and attributes that are recognised by an engine that then performs transformations accordingly. This allows you to mix in template code with HTML without making it unable to be loaded by a browser directly. However, unlike the HTML-generators this shares a problem with the other template systems in that there needs to be a way to reference, indicate or access data in the template. Figuring out a way to keep a good symbiosis between HTML and your template engine too is a major issue here.

Out of all the systems I've encountered I prefer the last best as it seems to offer the possibility of a good compromise. However, the issues that remain are still rather bothersome. Template systems should at the same time be expressive and short-handed enough for you to write what you need with ease, but they also shouldn't be too complex so that they can still be compiled with speed and that the templates don't become just another DSL.

In my latest iteration of this arduous endeavour I've finally gotten to working on Clip. Clip's main idea is that any tag and attribute can potentially serve as a way to trigger a template engine action. This allows the structure to look ‘innocent’ and expressive. Another main feature is the integration with lQuery (through an lquery attribute) which allows complex, but simple transforming of elements and filling in of data. Clip uses a central ‘clipboard’ that serves as a data storage. Tags can rebind this clipboard to other objects or modify it and values can be retrieved from it in most cases as if by a locally-bound symbol. Finally, any tag can control the transformation process, so flow- and environment-changing tag ‘macros’ are possible too.

Let's look at an example. As you can see, this is displayed like a normal web page. View its source to see the template definition. This is a very small thing that basically only does one thing: Populate the list with voting options. Important here are the ITERATE and LQUERY attributes. The iterate attribute tells Clip to call the iterate transformer, which then copies the first inner element and transforms it for each element in the named variable. In this case, the variable storing the options must be a list retrievable through a call to CLIP (a generic accessor) from the clipboard. Values for the lquery calls are similarly retrieved. As you can see, it looks like locally bound variables, which is a nice aesthetic effect. In the case of the lquery attribute you can put in complicated lisp snippets that are then evaluated to retrieve the proper value. This allows for a very flexible environment. Since Clip is extensible you can also add your own special tags and attributes to ease the template parsing.

Once I get more time I'll root out my main irks (how attributes are processed, no splicing) with Clip so it can become a fully-fledged templating system. For now it's used in Staple, my new documentation generation app that I've had a long time coming. Now I can finally replace lQuery-Doc!

Anyway, this blog seems a lot less coherent in thought than I'd like and that's mainly down to the fact that I'm still very much a confused man myself. I don't know how to write a template system that I would truly find appealing and everything I've written for Clip and Staple today is still bugging me. I desperately hope someone out there has a better idea about all of this than I and is going to or already has written something that I would want to use as well.

But I'm not going to bet on it.


For older items, see the Planet Lisp Archives.


Last updated: 2014-08-27 18:30