Once resorted by the order of the powers of a generator , the multiplication table look the same regardless of the . The addition, however, looks different for different generators. Below are the addition tables for two of them: on the right and on the left. They make as decent a stereo as any of the other pairs so far.

 

Here’s the code that I used to generate the remapping for a given generator.

(defun make-cyclic-remapping (fn generator &optional (limit 256))
  (let ((to (make-array (list limit) :initial-element 0))
        (from (make-array (list limit) :initial-element 0))
        (used (make-hash-table :test #'equal)))
    ;; fill up the lookup tables
    (setf (gethash 0 used) t)
    (nlet fill-tables ((exp 1) (acc 1))
      (when (< exp limit)
        (setf (aref to exp) acc
              (aref from acc) exp
              (gethash acc used) t)
        (fill-tables (1+ exp) (funcall fn acc generator))))
    ;; return a closure around the lookup tables
    (when (= (hash-table-count used) limit)
      (lambda (direction n)
        (ecase direction
          (:to (aref to n))
          (:from (aref from n)))))))

If you’ve read it, you can probably tell by my code that I’m still under the influence of Let Over Lambda. If you haven’t read it, it is quite worth the read.

Then, I used a modified version of the draw-heightmap function which also takes in the remapping function.

(defun draw-mapped-heightmap (op map filename &optional (limit 256))
  (let ((png (make-instance 'zpng:pixel-streamed-png
                            :color-type :grayscale
                            :width limit
                            :height limit)))
    (with-open-file (stream filename
                            :direction :output
                            :if-does-not-exist :create
                            :element-type '(unsigned-byte 8))
      (zpng:start-png png stream)
      (dotimes (xx limit)
        (dotimes (yy limit)
          (let* ((a (funcall map :to xx))
                 (b (funcall map :to yy))
                 (c (funcall map :from (funcall op a b))))
            (zpng:write-pixel (list c) png))))
      (zpng:finish-png png)))
  (values))

I no longer remember what led me to this page of synthetic division implemented in various languages. The author provides a common lisp implementation for taking a list representing the coefficients of a polynomial in one variable and a number and returning the result of dividing the polynomial by .

The author states: I’m very sure this isn’t considered Lispy and would surely seem like an awkward port from an extremely Algol-like mindset in the eyes of a seasoned Lisper. In the mood for the exercise, I reworked his code snippet into slightly more canonical lisp while leaving the basic structure the same:

(defun synthetic-division (polynomial divisor)                                  
  (let* ((result (first polynomial))                                            
         (quotient (list result)))                                              
    (dolist (coefficient (rest polynomial))                                     
      (setf result (* result divisor))                                          
      (incf result coefficient)                                                 
      (push result quotient))                                                   
    (let ((remainder (pop quotient)))                                           
      (list :quotient (nreverse quotient) :remainder remainder))))

From there, I went on to implement it using tail recursion to get rid of the #'setf and #'incf and #'push:

(defun synthetic-division-2 (polynomial divisor)                                
  (labels ((divide (coefficients remainder quotient)                            
             (if coefficients                                                   
                 (divide (rest coefficients)                                    
                         (+ (* divisor remainder) (first coefficients))         
                         (list* remainder quotient))                            
               (list :quotient (reverse quotient) :remainder remainder))))      
    (divide (rest polynomial) (first polynomial) nil)))

What I didn’t like about this was the complexity of calling the tail-recursive portion. If I just called it like I wished to (divide polynomial 0 nil) then I ended up with one extra coefficient in the answer. This wouldn’t do.

The Joke

There’s an old joke about a physicist, a biologist, and a mathematician who were having lunch at an outdoor café. Just as their food was served, they noticed a couple walk into the house across the street. As they were finishing up their meal, they saw three people walk out of that very same house.

The physicist said, We must have miscounted. Three must have entered before.

The biologist said, They must have pro-created.

The mathematician said, If one more person enters that house, it will again be empty.

The Anti-Cons

What I needed was a more-than-empty list. I needed a negative cons-cell. I needed something to put in place of the nil in (divide polynomial 0 nil) that would annihilate the first thing it was cons-ed to.

I haven’t come up with the right notation to make this clear. It is somewhat like a quasigroup except that there is only one inverse element for all other elements. Let’s denote this annihilator: . Let’s denote list concatenation with .

Only having one inverse-ish element means we have to give up associativity. For lists and , evaluating equals , but equals .

Associativity is a small price to pay though for a prettier call to my tail-recursive function, right?

The Basic Operations

For basic operations, I’m going to need the anti-cons itself and a lazy list of an arbitrary number of anti-conses.

(defconstant anti-cons 'anti-cons)
 
(defclass anti-cons-list ()
  ((length :initarg :length :reader anti-cons-list-length))
  (:default-initargs :length 1))
 
(defmethod print-object ((obj anti-cons-list) stream)
  (print-unreadable-object (obj stream)
    (prin1 (loop :for ii :from 1 :to (anti-cons-list-length obj)
              :collecting 'anti-cons)
           stream)))

Then, I’m going to make some macros to define generic functions named by adding a minus-sign to the end of a Common Lisp function. The default implementation will simply be the common-lisp function.

(defmacro defun- (name (&rest args) &body methods)
  (let ((name- (intern (concatenate 'string (symbol-name name) "-"))))
    `(defgeneric ,name- (,@args)
       (:method (,@args) (,name ,@args))
       ,@methods)))

I’m even going to go one step further for single-argument functions where I want to override the body for my lazy list of anti-conses using a single form for the body:

(defmacro defun1- (name (arg) a-list-form &body body)
  `(defun- ,name (,arg)
     (:method ((,arg anti-cons-list)) ,a-list-form)
     ,@body))

I need #'cons- to set the stage. I need to be able to cons an anti-cons with a normal list. I need to be able to cons an anti-cons with a list of anti-conses. And, I need to be able to cons something other than an anti-cons with a list of anti-conses.

(defun- cons (a b)
  (:method ((a (eql 'anti-cons)) (b list))
    (if (null b)
        (make-instance 'anti-cons-list)
        (cdr b)))
 
  (:method ((a (eql 'anti-cons)) (b anti-cons-list))
    (make-instance 'anti-cons-list :length (1+ (anti-cons-list-length b))))
 
  (:method (a (b anti-cons-list))
    (let ((b-len (anti-cons-list-length b)))
      (when (> b-len 1)
        (make-instance 'anti-cons-list :length (1- b-len))))))

Now, I can go on to define some simple functions that can take either anti-cons lists or regular Common Lisp lists.

(defun1- length (a) (- (anti-cons-list-length a))
 
(defun1- car (a) :anti-cons)
 
(defun1- cdr (a)
  (let ((a-len (anti-cons-list-length a)))
    (when (> a-len 1)
      (make-instance 'anti-cons-list :length (1- a-len)))))
 
(defun1- cadr (a) (when (> (anti-cons-list-length a) 1) :anti-cons))
(defun1- caddr (a) (when (> (anti-cons-list-length a) 2) :anti-cons))

To give a feel for how this all fits together, here’s a little interactive session:

ANTI-CONS> (cons- anti-cons nil)
#<(ANTI-CONS)>
 
ANTI-CONS> (cons- anti-cons *)
#<(ANTI-CONS ANTI-CONS)>
 
ANTI-CONS> (cons- :a *)
#<(ANTI-CONS)>
 
ANTI-CONS> (length- *)
-1

Denouement

Only forty or fifty lines of code to go from:

(divide (rest polynomial) (first polynomial) nil)

To this:

(divide polynomial 0 (cons anti-cons nil))

Definitely worth it.

• The with- pattern which makes sure a special variable is bound for the body and makes sure the tied resources are released at the end of the block.
• Macros which collect content (usually into a special variable) so they can do something with the content at the end of the close of the macro.

Then, I was working on something tonight when I re-discovered a favorite pattern that I’d forgotten about: Putting multiple wrappers on the same body.

I am working on an HTML+JavaScript+CSS project. In the end, I need static files. But, I thought I would use the opportunity to really experience CL-Who, Parenscript, and CSS-Lite.

I have now made a macro called define-web-file which takes a CL-Who or Parenscript body and wraps it up as both a Hunchentoot handler and a write-to-file wrapper. Now, I can test interactively with Hunchentoot and generate the whole web application when I’m ready.

Whenever I write client-server applications, I run into the same problem trying to separate the code. To send a message from the server to the client, the server has to serialize that message and the client has to unserialize that message. The server doesn’t need to unserialize that message. The client doesn’t need to serialize that message.

It seems wrong to include both the serialization code and the unserialization code in both client and server when each side will only be using 1/2 of that code. On the other hand, it seems bad to keep the serialization and unserialization code in separate places. You don’t want one side serializing A+B+C and the other side trying to unserialize A+C+D+B.

One approach: data classes

Some projects deal with this situation by making every message have its own data class. You take all of the information that you want to be in the message and plop it into a data class. You then serialize the data class and send the resulting bytes. The other side unserializes the bytes into a data class and plucks the data out of the data class.

The advantage here is that you can have some metaprogram read the data class definition and generate a serializer or unserializer as needed. You’re only out-of-sync if one side hasn’t regenerated since the data class definition changed.

The disadvantage here is that I loathe data classes. If my top-level interface is going to be (send-login username password), then why can’t I just serialize straight from there without having to create a dippy data structure to hold my opcode and two strings?

Another approach: suck it up

Who cares if the client contains both the serialization and unserialization code? Heck, if you’re really all that concerned, then fmakunbound half the universe before you save-lisp-and-die.

Of course, unless you’re using data classes, you’re either going to have code in your client that references a bunch of functions and variables that only exist in your server or your client and server will be identical except for:

(defun main ()
  #+server (server-main)
  #-server (client-main))

Now, of course, your server is going to accidentally depend on OpenGL and OpenAL and SDL and a whole bunch of other -L’s it never actually calls. Meanwhile, your client is going to accidentally depend on Postmodern and Portable-Threads and a whole bunch of other Po-’s it never actually calls.

Another approach: tangle and weave, baby

Another way that I’ve got around this is to use literate programming tools to let me write the serialiization and unserialization right next to each other in my document. Then, anyone going to change the serialize code would be immediately confronted with the unserialize code that goes with it.

The advantage here is that you can tangle the client code through an entirely separate path than the server code keeping only what you need in each.

The disadvantage here is that now both your client code and your server code have to be in the same document or both include the same sizable chunk of document. And, while there aren’t precisely name-capturing problems, trying to include the “serialize-and-send” chunk in your function in the client code still requires that you use the same variable names that were in that chunk.

How can Lisp make this better?

In Lisp, we can get the benefits of a data-definition language and data classes without needing the data classes. Here’s a snippet of the data definition for a simple client-server protocol.

;;;; protocol.lisp
(userial:make-enum-serializer :opcode (:ping :ping-ack))
(defmessage :ping     :uint32 ping-payload)
(defmessage :ping-ack :uint32 ping-payload)

I’ve declared there are two different types of messages, each with their own opcode. Now, I have macros for define-sender and define-handler that allow me to create functions which have no control over the actual serialization and unserialization. My functions can only manipulate the named message parameters (the value of ping-payload in this case) before serialization or after unserialization but cannot change the serialization or unserialization itself.

With this protocol, the client side has to handle ping messages by sending ping-ack messages. The define-sender macro takes the opcode of the message (used to identify the message fields), the name of the function to create, the argument list for the function (which may include declarations for some or all of the fields in the message), the form to use for the address to send the resulting message to, and any body needed to set fields in the packet based on the function arguments before the serialization. The define-handler macro takes the opcode of the message (again, used to identify the message fields), the name of the function to create, the argument list for the function, the form to use for the buffer to unserialize, and any body needed to act on the unserialized message fields.

;;;; client.lisp
(define-sender  :ping-ack send-ping-ack (ping-payload) *server-address*)
(define-handler :ping     handle-ping   (buffer) buffer
  (send-ping-ack ping-payload))

The server side has a bit more work to do because it’s going to generate the sequence numbers and track the round-trip ping times.

;;;; server.lisp
 
(defvar *last-ping-payload* 0)
(defvar *last-ping-time*    0)
 
(define-sender :ping send-ping (who) (get-address-of who)
  (incf *last-ping-payload*)
  (setf *last-ping-time*    (get-internal-real-time)
        ping-payload        *last-ping-payload*))
 
(define-handler :ping-ack handle-ping-ack (who buffer) buffer
  (when (= ping-payload *last-ping-payload*)
    (update-ping-time who (- (get-internal-real-time) *last-ping-time*))))

Problems with the above

It feels strange to leave compile-time artifacts like the names and types of the message fields in the code after I’ve generated the functions that I’m actually going to use. But, I guess that’s just part of Lisp development. You can’t (easily) unload a package. I can makunbound a bunch of stuff after I’m loaded if I don’t want it to be convenient to modify senders or handlers at run-time.

There is intentional name-capture going on. The names of the message fields become names in the handlers. The biggest problem with this is that the defmessage calls really have to be in the same namespace as the define-sender and define-handler calls.

I still have some work to do on my macros to support &key and &optional and &aux and &rest arguments properly. I will post those macros once I’ve worked out those kinks.

Anyone care to share how they’ve tackled client-server separation before?

After a whole bunch of running in circles, I have discovered a combination that works (with these clues). I have my TERM variable set to xterm-color. I configured the Terminal.app using its Keyboard settings to have it send the string “\033[1;5C” for C-<right arrow> and “\033[1;5D” for C-<left arrow>. (The “\033″ is the escape key.)

This works for me even through screen.

Bonus.

(in-package :unet)
 
(defvar *logger-function* nil)
 
(defmacro log-it (category thing-to-log)
  `(when *logger-function*
     (funcall *logger-function* ,category ,thing-to-log)))

This seems simple enough, right? Now, throughout my code, I can do things like:

(log-it :incoming-packet packet)
(log-it :list-of-unacked-packets (get-list-of-unacked-packets))
(etc)

The application can register a *logger-function* something like this:

(defun app-log-network-msgs (category thing-to-log)
  (cl-log:log-message category thing-to-log))

Here’s the problem though: most (all?) logging libraries are good about not evaluating any arguments beyond the category unless something is actually listening for messages of that category. This makes it reasonable to do stuff like this and only take the speed hit when it’s actually important to do so:

(log-it :excruciating-detail
        (mapcar #'get-excrutiating-detail (append everyone everything)))

With my macro above, I have no way of knowing whether something is listening on a particular category or not. Further, most logging libraries don’t offer a way to query that sort of information.

What to do?

What I wanted to do was to pass a macro from the application package into my networking library instead of passing a function. I spent way too long trying to find a way to make this work (especially considering I ran into the same trouble in October, 2009 trying to use some combination of (macroexpand ...) and (eval ...) to let the caller decide which forms to execute).

All it took was posting to comp.lang.lisp to answer my own question: Closures. I changed my macro to create a closure:

(defmacro log-it (category thing-to-log)
  `(when *logger-function*
     (funcall *logger-function* ,category #'(lambda () ,thing-to-log))))

Now, the application’s logger function changes slightly and my forms are only evaluated when the logging library evaluates them:

(defun app-log-network-msgs (category thing-to-log-generator)
  (cl-log:log-message category (funcall thing-to-log-generator))

Hopefully, I will remember next time I run into this.

As I move forward programming a game with my UNet library, I want to make sure that I can easily log all the network traffic during testing runs at least.

In looking through the various Lisp logging packages out there, I decided on Nick Levine’s cl-log library.

I installed it in no time with quicklisp.

Then, I set to work trying to figure out how I could use it to log binary data.

Here’s what I ended up with. If you want to do something similar, this should give you a good starting point.

Serializing, unserializing, and categorizing

With my USerial library, I defined a serializer to keep track of the different categories of log messages. And, I made corresponding categories in cl-log.

(make-enum-serializer :log-category (:packet :error :warning :info))
 
(defcategory :packet)
(defcategory :error)
(defcategory :warning (or :error :warning))
(defcategory :info (or :warning :info))

Specializing the classes

There are two major classes that I specialized: base-message and base-messenger. For my toying around, I didn’t end up adding any functionality to the base-message class. I will show it here though so that you know you can do it.

(defclass serialized-message (base-message)
  ())
 
(defclass serialized-messenger (base-messenger)
  ((filename :initarg :filename :reader serialized-messenger-filename)))

Then, I overrode the messenger-send-message generic function to create a binary header with my USerial library and then write the header and the message out.

(defmethod messenger-send-message ((messenger serialized-messenger)
                                   (message serialized-message))
  (let ((header (make-buffer 16)))
    (serialize* (:uint64 (timestamp-universal-time
                              (message-timestamp message))
                 :log-category (message-category message)
                 :uint64 (buffer-length :buffer (message-description message)))
             :buffer header)
    (with-open-file (stream (serialized-messenger-filename messenger)
                            :direction :output
                            :if-does-not-exist :create
                            :if-exists :append
                            :element-type '(unsigned-byte 8))
      (write-sequence header stream)
      (write-sequence (message-description message) stream))))

Using it

To get things going, I then made a log manager that accepts my serialized-message type and started one of my serialized-messenger instances.

(setf (log-manager)
      (make-instance 'log-manager
                     :message-class 'serialized-message))
 
(start-messenger 'serialized-messenger :name "binary-logger"
                                       :filename "/tmp/binary-log.dat")

Once these were started, I made a little utility function to make it easy for me to make test messages and then invoked log-message a few times.

(defun make-info (string)
  (serialize :string string :buffer (make-buffer)))
 
(log-message :warning (make-info "Warning"))
(log-message :info (make-info "This is info"))

Conclusions

In all, it has taken me about four times as long to write blog post as it did to install cl-log with quicklisp, peek through the cl-log documentation and source code enough to figure out how to do this, and write all of the code.

To really use this, I will probably separate out the category of a message from the serialized type of the message. This will probably involve adding a field to the serialized-message class to track the message type, adding an initialize-instance :before method for that class to look through the arguments to pull out the type, and then adding the type as an extra argument to log-message.

Lisp: Conditions and Restarts from Patrick Stein on Vimeo.

Screencast tutorial on basic conditions and restarts in Common Lisp.

Here is the source code generated during this tutorial.

I had to derive it again on Friday and thought, I should make sure more people get this tool into their utility belts.

First, a quick refresher on what we’re talking about here. The mean of a data set is defined to be . The variance is defined to be .

A naïve approach to calculating the variance then goes something like this:

(defun mean-variance (data)
  (flet ((square (x) (* x x)))
    (let* ((n (length data))
           (sum (reduce #'+ data :initial-value 0))
           (mu (/ sum n))
           (vv (reduce #'(lambda (accum xi)
                           (+ accum (square (- xi mu))))
                       data :initial-value 0)))
      (values mu (/ vv n)))))

This code runs through the data list once to count the items, once to calculate the mean, and once to calculate the variance. It is easy to see how we could count the items at the same time we are summing them. It is not as obvious how we can calculate the sum of squared terms involving the mean until we’ve calculated the mean.

If we expand the squared term and pull the constant outside of the summations it ends up in, we find that:

When we recognize that and , we get:

This leads to the following code:

(defun mean-variance (data)
  (flet ((square (x) (* x x)))
    (destructuring-bind (n xs x2s)
        (reduce #'(lambda (accum xi)
                    (list (1+ (first accum))
                          (+ (second accum) xi)
                          (+ (third accum) (square xi))))
                data :initial-value '(0 0 0))
      (let ((mu (/ xs n)))
        (values mu (- (/ x2s n) (square mu)))))))

The code is not as simple, but you gain a great deal of flexibility. You can easily convert the above concept to continuously track the mean and variance as you iterate through an input stream. You do not have to keep data around to iterate through later. You can deal with things one sample at a time.

The same concept extends to higher-order moments, too.

Happy counting.

Edit: As many have pointed out, this isn’t the most numerically stable way to do this calculation. For my part, I was doing it with Lisp integers, so I’ve got all of the stability I could ever want. But, yes…. if you are intending to use these numbers for big-time decision making, you probably want to look up a really stable algorithm.

The Goal

I wanted to accomplish something like this without all of the SETF action and verbiage:

(let (vv)
  (setf vv (serialize 'real xx vv))
  (setf vv (serialize 'real yy vv))
  (setf vv (serialize 'real zz vv))
  vv)

The First Attempt

Well, also thanks to Haskell, my instinct was to make a CURRY-PIPELINE macro that gets called something like this:

(curry-pipeline nil
  (serialize 'real xx)
  (serialize 'real yy)
  (serialize 'real zz))

and expands into something like this:

(serialize 'real zz (serialize 'real yy (serialize 'real xx nil)))

Unfortunately, this changes the order of evaluation of xx, yy, and zz entirely. So, this was suboptimal. It also involved a fifteen-line macro with macro recursion and two conditionals.

Slightly Cleaner

My next attempt was about a ten-line macro with one conditional that turned it into a bunch of nested LET statements.

(let ((#:V-1 nil))
  (let ((#:V-1 (serialize 'real xx #:V-1)))
    (let (#:V-1 (serialize 'real yy #:V-1)))
      (let (#:V-1 (serialize 'real zz #:V-1)))
        #:V-1))))

Cleaner Still

Then, I realized that most of my simple examples would be simplest if I curried into the first argument instead of the last. (In fact, it would have even fixed my order of evaluation problem in the initial version.) And, I realized that I could abandon the nested LET if I used a LET*. Now, I have a six-line macro that I really like.

(defmacro curry-pipeline (initial &body body)
  (let ((vv (gensym "VARIABLE-")))
    (labels ((curry-and-store (line)
               `(,vv (,(first line) ,vv ,@(rest line)))))
      `(let* ((,vv ,initial)
              ,@(mapcar #'curry-and-store body))
         ,vv))))

So, here is an example that does one of those grade school magic tricks. Pick a number, multiply by five, add six, multiply by four, add nine, and multiply by five. Tell me the answer. I subtract 165 and divide by one hundred to tell you your original number.

(defun magic-trick (n)
  (let ((rube (curry-pipeline n
                (* 5)
                (+ 6)
                (* 4)
                (+ 9)
                (* 5))))
    (curry-pipeline rube
      (- 165)
      (/ 100))))

Back to the Original Problem

Now, my serialize functions can simply take a buffer and return a buffer which is the concatenation of the input buffer and the bytes required to encode the given value. The unserialize is not as nice since I will have to return both a buffer and a value, but I am sure I can work something out using a CONS as an accumulator. And, heck, it is going to kill my performance anyway if I really copy the buffer every time I want to add another item to it. I am probably going to ditch the functional aspect anyway. *shrug*

A New Tack

If you don’t like currying or need to have more control over where the accumulator goes in each step of the chain, you can still get the same kind of chaining if you require a declaration of the variable. And, it simplifies the macro:

(defmacro let-pipeline ((var initial) &body body)
  `(let* ((,var ,initial)
          ,@(mapcar #'(lambda (line) `(,var ,line)) body))
     ,var))
 
(defun magic-trick (n)
  (let ((rube (let-pipeline (r n)
                (* 5 r)
                (+ 6 r)
                (* 4 r)
                (+ 9 r)
                (* 5 r))))
    (let-pipeline (a rube)
      (- a 165)
      (/ a 100))))

From there, it is not too big of a leap to allow MULTIPLE-VALUE-BIND instead. To accomplish the unserialize, as I mentioned, I will need to track multiple values. I am now down to a four line macro:

(defmacro mv-pipeline ((vars call &rest rest-pipeline) &body body)
  `(multiple-value-bind ,vars ,call
     ,(if rest-pipeline
          `(mv-pipeline ,rest-pipeline ,@body)
          `(progn ,@body))))

Here is an easy to follow example that returns the first five Fibonacci numbers:

(mv-pipeline ((f0 f1) (values 0 1)
              (f2) (+ f1 f0)
              (f3) (+ f2 f1)
              (f4) (+ f3 f2))
  (list f0 f1 f2 f3 f4))

Now, my unserialize case might look something like this:

(defmethod unserialize ((type (eq 'vector)) buffer)
  (mv-pipeline ((xx buffer) (unserialize 'real buffer)
                (yy buffer) (unserialize 'real buffer)
                (zz buffer) (unserialize 'real buffer))
    (values (vector xx yy zz) buffer)))

Conclusion

Luckily, I am not paying myself based on lines of code per hour. Almost every time I have done more work, I have reduced the number of lines of code. I am reminded of this quote from Blaise Pascal: I have made this letter longer, because I have not had the time to make it shorter.