Preamble; choice of implementation

I decided to go with the latest and greatest version of Scheme: R⁶RS. There are currently two implementations available under Ubuntu Linux: Ikarus and Ypsilon. I installed both so I wouldn’t be swayed by any tempting extensions to the standard. Despite this, I ended up using Ikarus for most testing, as it ran quite a lot faster, although Ypsilon gave much better stack traces.

I also used the streams library for dealing with infinite lists (SRFI 41), which is included with both implementations.

Note: I’ll be providing all the code so that you should be able to copy-paste it into a new file and run it.

(import (rnrs)
    (rnrs r5rs (6)) ; provides 'delay' & 'force'
    (streams))

The Machine

Turing sought to capture the essence of computation. For this purpose he constructed an idealized machine, which can read and write symbols to an infinitely long piece of tape. We are going to model these idealized machines and see what they can do.

First, we want some types to represent the a-machines (the a is for automatic). Each machine has a set of states (m-configurations) it can be in, each of which contains a mapping from a set of symbols to a list of actions and a new m-configuration. I decided that the state would be my basic unit of construction, but twiddled the meaning of m-configuration a tiny bit so that instead of having each configuration contain a mapping from symbols, I would instead have a list of configurations, each one with a list of which symbols activate it. I ended up with the following:

; type for a configuration
(define-record-type m-cfg
            (fields symbols operations next))

This defines a new record type called m-cfg with the fields symbols, operations and next. The define-record-type form defines a constructor (make-m-cfg) and accessors for each field (m-cfg-*). Rather than have a ‘machine’ type, I decided that this would just be left implicit; if we know what the current state is then we can follow the links to next whenever we want to.

The Tape

Now, each machine operates upon an infinitely long ‘tape’. To model this, I use two streams, which are infinite lists. One is the infinite length of the tape to the left of the machine, and the other is the infinite length of the tape to the right of the machine. I decided that the first item in the right list would be the current item that the machine is reading.

; type for a tape (modeled as two stacks)
(define-record-type tape
            (fields left right min max index))

You will note that there are also the fields min, max, and index. These are solely used to track how much of the tape the machine has “visited”. Without this information, we would not know how much of the tape to show when we want to look at it; and since it is infinitely long, this could be a problem!

Representing operations

The operations that a machine can perform consist of:

• Move right
• Move left
• Print symbol
• Erase symbol
• Halt

I implemented these as an enumeration, just in case, but I didn’t actually end up utilizing any of the enumeration features.

; the operations available
(define-enumeration op
  (right left erase print halt)
  op-set)

There is a small difficulty with this representation: the ‘print’ operation needs to be able to take an argument. I decided that operations would always be passed around as lists, and that only ‘print’ would have a second element in the list: its argument. Here is a little shorthand to make this representation easier:

; these need to be lists, because print takes an argument
(define L (list (op left)))
(define R (list (op right)))
(define P (lambda (c) (list (op print) c)))
(define E (list (op erase)))
(define H (list (op halt)))

Thus, we can represent a list of operations like this: (list R R (P #\A) L E H)—that’s right, right, print ‘A’ (Scheme’s syntax for characters is a little weird), left, erase, halt.

Moving around on the tape

Here is a simple tape; it is completely empty. Note that I use the symbol 'empty to represent empty places on the tape. stream-constant makes an infinite stream of the value(s) supplied.

(define empty-tape
  (make-tape (stream-constant 'empty) (stream-constant 'empty) 0 0 0))

Next we need code to actually implement the operations described above. It is fairly straightforward, but we also have to keep track of the index and max/min points on the tape:

; Tape manipulation:
(define (current-symbol tape)
  (stream-car (tape-right tape)))
 
(define (move-item from to)
  (values (stream-cdr from)
      (stream-cons (stream-car from) to)))
 
(define (move-right tape)
  (let-values (
      [(right left) (move-item (tape-right tape) (tape-left tape))]
      [(min max) (update-min-max (tape-min tape) (tape-max tape) (+ 1 (tape-index tape)))])
    (make-tape left right min max (+ 1 (tape-index tape)))))
 
(define (move-left tape)
  (let-values (
      [(left right) (move-item (tape-left tape) (tape-right tape))]
      [(min max) (update-min-max (tape-min tape) (tape-max tape) (- (tape-index tape) 1))])
    (make-tape left right min max (- (tape-index tape) 1))))
 
(define (print tape symbol)
  (make-tape
    (tape-left tape)
    (stream-cons symbol (stream-cdr (tape-right tape)))
    (tape-min tape)
    (tape-max tape)
    (tape-index tape)))
 
(define (erase tape)
  (print tape 'empty))
 
(define (update-min-max min max i)
  (cond 
    [(< i min) (values i max)]
    [(> i max) (values min i)]
    [else      (values min max)]))

Notice that erase is actually redundant because we can just print 'empty. We also want a “dispatcher” of sorts that takes a value representing an operation and performs that operation. This is where passing the argument around with the ‘print’ came in useful:

; performs an operation on a tape, returns new tape
(define (perform-op tape oper)
  (case (car oper)
    [(op left) (move-left tape)]
    [(op right) (move-right tape)]
    [(op print) (print tape (cadr oper))]
    [(op erase) (erase tape)]
    [(op halt) #f])) ; ungraceful halt!

Running the machine

Now that we have the operations implemented, we can almost run a state against a tape. First we need to figure out just which of the configurations of the state to run. This procedure receives a list of configurations (but they are all part of the same ‘state’) and a symbol, and picks the first configuration that has a matching symbol. Note that the configurations can also have the symbol 'any, which matches anything.

; finds the correct rule to follow for this symbol
(define (find-cfg machine symbol)
  (find (lambda (cfg) (or
                (find [lambda (s) (eqv? symbol s)]
                  (m-cfg-symbols cfg))
                (find [lambda (s) (eqv? 'any s)]
                  (m-cfg-symbols cfg))))
        machine))

Now that we have a way to find out which rule to perform, and how to perform it, we can run it against a tape. This procedure advances the machine to the next state, performing all the operations needed. It returns the new state and a new tape.

; runs a machine forward one step
(define (run-machine tape machine)
  (let ([cfg (find-cfg (force machine) (current-symbol tape))])
    (list (fold-left perform-op tape (m-cfg-operations cfg))
          (m-cfg-next cfg))))

Displaying the tape

Being able to run the machine against a tape isn’t much good if we can’t see the result, so here’s a procedure to print out what it looks like. This is where we need the indexes we kept track of on the tape, so we know when to stop printing.

(define (print-tape tape)
  ; move as far left as possible
  (let ([leftTape (go-far-left tape)])
    ; now go right
    (do ([t leftTape])
      ((> (tape-index t) (tape-max tape)) t)
      (when (eqv? (tape-index tape) (tape-index t))
              (display "["))
      (cond
          [(eqv? (current-symbol t) 'empty) (display ".")]
          [else (display (current-symbol t))])
      (when (eqv? (tape-index tape) (tape-index t))
              (display "]"))
      (set! t (move-right t)))))
 
; moves to the far left of the tape (as far as has been travelled)
(define (go-far-left tape)
  (do ([t tape])
    ((= (tape-index t) (tape-min tape)) t)
     (set! t (move-left t))))

I print out a ‘.’ for each blank, and surround the current symbol with square brackets (actually I’ve changed that to be underlining in this blog post).

Turing Machines!

Now we can test it! Here is my definition of Turing’s first published machine:

; Turing's first published machine!
(define m1 (letrec 
  ([b (delay (list
       (make-m-cfg (list 'any) (list (P #\0) R) c)))]
   [c (delay (list
       (make-m-cfg (list 'any) (list R) e)))]
   [e (delay (list
       (make-m-cfg (list 'any) (list (P #\1) R) f)))]
   [f (delay (list
       (make-m-cfg (list 'any) (list R) b)))])
  b))

Now you see why we needed to import ‘delay’… since Scheme is a strictly-evaluated language, we can’t just letrec each state in terms of the others, so I wrap each one up in delay, then force it in one place; just before we use it in the run-machine procedure.

Other than that it is fairly straightforward, each state has a list of m-configurations, each of which has a list of what symbols it accepts, the actions to take, and the next state to move to. After we letrec, we have the initial state defined as the ‘machine’—in this case, b.

We can run this machine like so:

(define (go t m)
 (do ([tm (list t m)])
  ((eqv? tm #f) (car tm))
  (print-tape (car tm))
  (newline)
  (set! tm (run-machine (car tm) (cadr tm)))))
 
(go empty-tape m1)

This gives us the following output:

.
0.
0..
0.1.
0.1..
0.1.0.
0.1.0..
0.1.0.1.
0.1.0.1..
0.1.0.1.0.
...

This looks correct: P0, R, R, P1, R, R, etc.

Machine redux

The next machine Turing gives is the same as the first one, only in a different form:

; the same machine, only smaller
(define m2 (letrec
         ([b (delay (list
           (make-m-cfg (list 'empty) (list (P #\0)) b)
           (make-m-cfg (list #\0) (list R R (P #\1)) b)
           (make-m-cfg (list #\1) (list R R (P #\0)) b)))])
         b))

It has only one state, but changes depending on what the current symbol is. This produces the same output as the first machine, but in fewer steps:

.
0
0.1
0.1.0
0.1.0.1
0.1.0.1.0
0.1.0.1.0.1
0.1.0.1.0.1.0
0.1.0.1.0.1.0.1
0.1.0.1.0.1.0.1.0
...

You may be wondering why Turing leaves blanks between each printed symbol. He used the convention that only the ‘even’ squares (termed F-squares) would be the output. The ‘odd’ squares (termed E-squares) would be used as a scratch-pad.

Machine-à-trois

The third machine is a little more interesting. Whereas the first two printed out 01010101..., this prints 01011011101111011111...:

; Turing's third machine
(define m3 (letrec
         ([b (delay (list
                   (make-m-cfg (list 'any) (list (P #\ǝ) R (P #\ǝ) R (P #\0) R R (P #\0) L L) o)))]
          [o (delay (list
                  (make-m-cfg (list #\1) (list R (P #\x) L L L) o)
                  (make-m-cfg (list #\0) (list) q)))]
          [q (delay (list
                  (make-m-cfg (list #\0 #\1) (list R R) q)
                  (make-m-cfg (list 'empty) (list (P #\1) L) p)))]
          [p (delay (list
                  (make-m-cfg (list #\x) (list E R) q)
                  (make-m-cfg (list #\ǝ) (list R) f)
                  (make-m-cfg (list 'empty) (list L L) p)))]
          [f (delay (list
                  (make-m-cfg (list 'empty) (list (P #\0) L L) o)
                  (make-m-cfg (list 'any) (list R R) f)))])
         b))

With the output:

.
ǝǝ0.0
ǝǝ0.0
ǝǝ0.0
ǝǝ0.0..
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1
ǝǝ0.0.1..
ǝǝ0.0.1.0
ǝǝ0.0.1x0
ǝǝ0.0.1x0
ǝǝ0.0.1x0
ǝǝ0.0.1x0
ǝǝ0.0.1x0..
ǝǝ0.0.1x0.1
ǝǝ0.0.1x0.1
ǝǝ0.0.1.0.1
ǝǝ0.0.1.0.1
ǝǝ0.0.1.0.1..
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1
ǝǝ0.0.1.0.1.1..
ǝǝ0.0.1.0.1.1.0
ǝǝ0.0.1.0.1.1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0
ǝǝ0.0.1.0.1x1x0..
ǝǝ0.0.1.0.1x1x0.1
ǝǝ0.0.1.0.1x1x0.1
ǝǝ0.0.1.0.1x1.0.1
ǝǝ0.0.1.0.1x1.0.1
ǝǝ0.0.1.0.1x1.0.1..
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1.1..
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1..
ǝǝ0.0.1.0.1.1.0.1.1.1.0
ǝǝ0.0.1.0.1.1.0.1.1.1x0
ǝǝ0.0.1.0.1.1.0.1.1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0
ǝǝ0.0.1.0.1.1.0.1x1x1x0..
ǝǝ0.0.1.0.1.1.0.1x1x1x0.1
ǝǝ0.0.1.0.1.1.0.1x1x1x0.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1..
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1x1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1..
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1x1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1..
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1
ǝǝ0.0.1.0.1.1.0.1.1.1.0.1.1.1.1

Here we can see the scratch-pad being used. We can also see the beginnings of a pattern of execution; notice how the machine returns to the beginning of the tape after completing each set of 1s.

Opus Magnum

Next up was my main challenge. One of the major contributions of Turing’s paper was to display a machine which could emulate any other machine you wanted. In essence, you don’t actually need lots of different machines. You can just build one, and it can do anything any of the other machines can do! This is the principle behind modern general-purpose computers.

This is a very big, and complex machine. Some of the intricacies not involved in the other machines are:

• m-functions; that is, configurations which accept parameters—luckily, this was surprisingly easy to implement using Scheme; I simply wrap the delayed code inside another lambda
• m-configurations which are parametrized over all symbols on the machine—this is solved by just mapping a lambda over the list of symbols
• variadic m-functions—solved by the magic of case-lambda
• poorly-scanned journal document containing Fraktur and Greek letters

But not only was this by far the biggest and most complex machine supplied by Turing, I had read texts mentioning unspecified bugs in the program.

… and sure enough, I ran into a ‘bug’. There were some configurations used in the machine which weren’t defined in the paper! At first I thought this was due to the low resolution of the PDF, but even enhancing the image didn’t help.

After much supplication and burnt offerings to the God of the Internet, I managed to find that:

Someone else did the work already

Yay!

More specifically, I found a paper entitled Understanding Turing’s Universal Machine — Personal Style in Program Description (which is unfortunately not available to the public), a marvelous paper that not only explains the errors made in detail, but also provides a nice, corrected version of Turing’s exposition of his machine.

After painstakingly re-checking all the states again, I arrived at this:

; need this to generate a couple of cfgs
(define u-symbols (list
		   #\A #\C #\D #\0 #\1
		   #\u #\v #\w #\x #\y #\z
		   #\; #\L #\R #\N
		   #\∷ #\:
		   ))
 
; yo dawg
(define u (letrec
        (
         [f (lambda (C B a) (delay (list
                (make-m-cfg (list #\ǝ) (list L) (f1 C B a))
                (make-m-cfg (list 'any) (list L) (f C B a)))))]
         [f1 (lambda (C B a) (delay (list
                (make-m-cfg (list a) (list) C)
                (make-m-cfg (list 'empty) (list R) (f2 C B a))
                (make-m-cfg (list 'any) (list R) (f1 C B a)))))]
         [f2 (lambda (C B a) (delay (list
                (make-m-cfg (list a) (list) C)
                (make-m-cfg (list 'empty) (list R) B)
                (make-m-cfg (list 'any) (list R) (f1 C B a)))))]
         [fdash (lambda (C B a) (delay (list
                (make-m-cfg (list 'any) (list) (f (l C) B a)))))]
         [fdashdash (lambda (C B a) (delay (list
                (make-m-cfg (list 'any) (list) (f (r C) B a)))))]
         [r (lambda (C) (delay (list
                (make-m-cfg (list 'any) (list R) C))))]
         [l (lambda (C) (delay (list
                (make-m-cfg (list 'any) (list L) C))))]
         [q (case-lambda
              [(C) (delay (list
                (make-m-cfg (list 'empty) (list R) (q1 C))
                (make-m-cfg (list 'any) (list R) (q C))))]
         [(C a) (delay (list
                (make-m-cfg (list 'any) (list) (q (q1 C a)))))])]
         [q1 (case-lambda
               [(C) (delay (list
                (make-m-cfg (list 'empty) (list) C)
                (make-m-cfg (list 'any) (list R) (q C))))]
               [(C a) (delay (list
                (make-m-cfg (list a) (list) C)
                (make-m-cfg (list 'any) (list L) (q1 C a))))])]
         [pe (lambda (C b) (delay (list
                (make-m-cfg (list 'any) (list) (f (pe1 C b) c #\ǝ)))))]
         [pe1 (lambda (C b) (delay (list
                (make-m-cfg (list 'empty) (list (P b)) C)
                (make-m-cfg (list 'any) (list R R) (pe1 C b)))))]
         [pe2 (lambda (C a b) (delay (list
                (make-m-cfg (list 'any) (list) (pe (pe C b) a)))))]
         [c (lambda (C B a) (delay (list
                (make-m-cfg (list 'any) (list) (fdash (c1 C) B a)))))]
         [c1 (lambda (C) (delay (map
                    (lambda (b) (make-m-cfg (list b) (list) (pe C b)))
                      u-symbols)))]
         [ce (case-lambda
               [(C B a) (delay (list
                (make-m-cfg (list 'any) (list) (c (e C B a) B a))))]
               [(B a) (delay (list
                (make-m-cfg (list 'any) (list) (ce (ce B a) B a))))])]
         [ce2 (lambda (B a b) (delay (list
                (make-m-cfg (list 'any) (list) (ce (ce B b) a)))))]
         [ce3 (lambda (B a b g) (delay (list
                (make-m-cfg (list 'any) (list) (ce (ce2 B b g) a)))))]
         [ce5 (lambda (B a b g d e) (delay (list
                (make-m-cfg (list 'any) (list) (ce3 (ce2 B d e) a b g)))))] ; added
         [cp (lambda (C U F a b) (delay (list
                (make-m-cfg (list 'any) (list) (fdash (cp1 C U b) (f U F b) a)))))]
         [cp1 (lambda (C U b) (delay (map
                   (lambda (g) (make-m-cfg (list g) (list) (fdash (cp2 C U g) U b)))
                     u-symbols)))]
         [cp2 (lambda (C U g) (delay (list
                (make-m-cfg (list g) (list) C)
                (make-m-cfg (list 'any) (list) U))))]
         [cpe (case-lambda 
                [(C U F a b) (delay (list
                 (make-m-cfg (list 'any) (list) (cp (e (e C C b) C a) U F a b))))]
                [(U F a b) (delay (list
                 (make-m-cfg (list 'any) (list) (cpe (cpe U F a b) U F a b))))])]
         [e (case-lambda
               [(C) (delay (list
                (make-m-cfg (list #\ǝ) (list R) (e1 C))
                (make-m-cfg (list 'any) (list L) (e C))))]
               [(B a) (delay (list 
                (make-m-cfg (list 'any) (list) (e (e B a) B a))))]
               [(C B a) (delay (list 
                (make-m-cfg (list 'any) (list) (f (e1 C B a) B a))))])]
         [e1 (case-lambda
               [(C) (delay (list
                (make-m-cfg (list 'empty) (list) C) 
                (make-m-cfg (list 'any) (list R E R) (e1 C))))]
               [(C B a) (delay (list
                (make-m-cfg (list 'any) (list E) C)))])]
         [con (lambda (C a) (delay (list
                (make-m-cfg (list #\A) (list L (P a) R) (con1 C a))
                (make-m-cfg (list 'any) (list R R) (con C a)))))]
         [con1 (lambda (C a) (delay (list
                (make-m-cfg (list #\A) (list R (P a) R) (con1 C a))
                (make-m-cfg (list #\D) (list R (P a) R) (con2 C a)))))]
         [con2 (lambda (C a) (delay (list
                (make-m-cfg (list #\C) (list R (P a) R) (con2 C a))
                (make-m-cfg (list 'any) (list R R) C))))]
         [b (delay (list
                (make-m-cfg (list 'any) (list) (f b1 b1 #\∷))))]
         [b1 (delay (list
                (make-m-cfg (list 'any) (list R R (P #\:) R R (P #\D) R R (P #\A) R R (P #\D)) anf)))] ; added "R R PD"
         [anf (delay (list
                (make-m-cfg (list 'any) (list) (q anf1 #\:))))] ; corrected from "(g ..."
         [anf1 (delay (list
                (make-m-cfg (list 'any) (list) (con fom #\y))))]
         [fom (lambda () (list
                (make-m-cfg (list #\;) (list R (P #\z) L) (con fmp #\x))
                (make-m-cfg (list #\z) (list L L) fom)
                (make-m-cfg (list #\ǝ) (list H) fom)
                (make-m-cfg (list 'any) (list L) fom)))]
         [fmp (delay (list
                (make-m-cfg (list 'any) (list) (cpe (e (e anf #\x) #\y) sim #\x #\y))))] ; corrected
         [sim (delay (list
                (make-m-cfg (list 'any) (list) (fdash sim1 sim1 #\z))))]
         [sim1 (delay (list
                (make-m-cfg (list 'any) (list) (con sim2 'empty))))]
         [sim2 (delay (list
                (make-m-cfg (list #\A) (list) sim3)
                (make-m-cfg (list 'any) (list L (P #\u) R R R) sim2)))] ; corrected from "R ..."
         [sim3 (delay (list
                (make-m-cfg (list #\A) (list L (P #\y) R R R) sim3)
                (make-m-cfg (list 'any) (list L (P #\y)) (e mf #\z))))]
         [mf (delay (list
                (make-m-cfg (list 'any) (list) (q mf1 #\:))))] ; corrected from "(g mf ..."
         [mf1 (delay (list
                (make-m-cfg (list #\A) (list L L L L) mf2)
                (make-m-cfg (list 'any) (list R R) mf1)))]
         [mf2 (delay (list
                (make-m-cfg (list #\C) (list R (P #\x) L L L) mf2)
                (make-m-cfg (list #\:) (list) mf4)
                (make-m-cfg (list #\D) (list R (P #\x) L L L) mf3)))]
         [mf3 (delay (list
                (make-m-cfg (list #\:) (list) mf4)
                (make-m-cfg (list 'any) (list R (P #\v) L L L) mf3)))]
         [mf4 (delay (list
                (make-m-cfg (list 'any) (list) (con (l (l mf5)) 'empty))))]
         [mf5 (delay (list
                (make-m-cfg (list 'empty) (list (P #\:)) sh)
                (make-m-cfg (list 'any) (list R (P #\w) R) mf5)))]
         [sh (delay (list
                (make-m-cfg (list 'any) (list) (f sh1 inst #\u))))]
         [sh1 (delay (list
                (make-m-cfg (list 'any) (list L L L) sh2)))]
         [sh2 (delay (list
                (make-m-cfg (list #\D) (list R R R R) sh3) ; corrected from "sh2"
                (make-m-cfg (list 'any) (list) inst)))]
         [sh3 (delay (list
                (make-m-cfg (list #\C) (list R R) sh4)
                (make-m-cfg (list 'any) (list) inst)))]
         [sh4 (delay (list
                (make-m-cfg (list #\C) (list R R) sh5)
                (make-m-cfg (list 'any) (list) (pe2 inst #\0 #\:))))]
         [sh5 (delay (list
                (make-m-cfg (list #\C) (list) inst)
                (make-m-cfg (list 'any) (list) (pe2 inst #\1 #\:))))]
         [inst (delay (list                                 ; note that inst1 is forced here!
                                                            ; this is because it is a zero-arity varargs
                (make-m-cfg (list 'any) (list) (q (l (inst1)) #\u))))] ; corrected from "(g ..." 
         [inst1 (case-lambda
                 [() (delay (map
                       (lambda (a) (make-m-cfg (list a) (list R E) (inst1 a)))
                       u-symbols))]
                 [(x) (case x
                      [(#\L) (delay (list (make-m-cfg (list 'any) (list) (ce5 ov #\v #\y #\x #\u #\w))))]
                      [(#\R) (delay (list (make-m-cfg (list 'any) (list) (ce5 ov #\v #\x #\u #\y #\w))))]
                      [(#\N) (delay (list (make-m-cfg (list 'any) (list) (ce5 ov #\v #\x #\y #\u #\w))))])])]
         [ov (delay (list
               (make-m-cfg (list 'any) (list) (q (r (r ov1)) #\A))))] ; changed from original
         [ov1 (delay (list
               (make-m-cfg (list #\D) (list) (e anf))
               (make-m-cfg (list 'empty) (list (P #\D)) (e anf))))]
         ) b)) ;; start in state 'b'

I don’t think I can blame Turing much for the errors in the paper. It seems as though some arose through printing typos, and attempting to debug this baroque machine by hand, on paper, would have been a difficult task. (I don’t think he even had Visual Studio!)

A machine in a machine

Of course, the final test of this is to see whether this machine can actually emulate another like it is supposed to. I defined a short procedure to set up a machine on a tape according to Turing’s ingenious encoding.

(define (setup-tape tape inits) 
  (let ([t (move-right (print (move-right (print tape #\ǝ)) #\ǝ))]
  	[inits (append inits (list #\∷))])
   (go-far-left (fold-left (lambda (tape init)
  	       (move-right (move-right (print tape init)))) 
	     t inits))))

A quick explanation of Turing’s encoding

The idea is to first simplify, then encode the states. Turing noted that many of the m-configurations’ operations could be considered redundant:

• as mentioned above, instead of having “erase” we can simply print the ‘blank’ symbol
• instead of not modifying the symbol, we simply print the symbol already present

There are then only three types of operation each state needs to perform:

1. print something and go left
2. print something and go right
3. print something and stay put

States which have a sequence of operations can be split into a series of states, each of which transfers control to the next one.

Now, if we encode all the symbols and configurations as numbers, we can write them out. Turing chose to encode them via this scheme:

• configurations’ numbers are the symbol ‘D’ followed by n ‘A’s, where n is the number of the state
• symbols’ numbers are similar, with ‘D’ followed by n ‘C’s. (Turing set ‘blank’ to always be symbol 0, represented as simply “D”)

So to encode each configuration, we write down its number, the symbol it accepts, the symbol it outputs, which direction to move, and which state to go to next. We prefix each configuration with ‘;’. (When we input it into the machine we also sandwich the whole thing between ‘ǝǝ’ and ‘∷’.)

Here is the example which Turing gives in his paper. I have formatted it to make it easier to read. Can you tell what it does?

(define example (setup-tape empty-tape (list 
			     #\; #\D #\A             #\D #\D #\C     #\R #\D #\A #\A
			     #\; #\D #\A #\A         #\D #\D         #\R #\D #\A #\A #\A
			     #\; #\D #\A #\A #\A     #\D #\D #\C #\C #\R #\D #\A #\A #\A #\A
			     #\; #\D #\A #\A #\A #\A #\D #\D         #\R #\D #\A)))

If we translate the symbols to get numbers we have the following:

; 1 0 0 R 2
; 2 0 . R 3
; 3 0 1 R 4
; 4 0 . R 1

This machine prints alternately 0.1.0.1.. In fact, when I first typed it up, I left off an ‘A’ on the 3rd state and couldn’t figure out why the machine was printing 0.11111...!

Just to show it works

Here is some output of the universal machine running the ’0101′ machine. I have only included a snippet as the machine takes a while to get to this stage. You’ll also notice the output format is different from the other machines; this one outputs some state information and the output of the emulated machine (in this case, 0 and 1), separated by colons. So far, after a minute or so, the machine has output 010

.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C
.ǝǝ;.D.A.D.DuCuR.DyAyAy;.D.A.A.D.D.R.D.A.A.A.;.D.A.A.A.D.D.C.C.R.D.A.A.A.A.;.D.A.A.A.A.D.D.R.D.A.∷.:.D.A.D.:.0.:.D.C.D.A.A.D.:.D.C.D.D.A.A.A.D.:.1.:.D.C.D.D.C.C.D.A.A.A.A.D.:.D.CvDvDvCvCvDxD.A.D.:.0.:.D.C

And that’s enough for today! Feel free to post corrections, additions, your own Turing machines, and so on

If we want to restrict ourselves to assigned, non-control, non-private Unicode characters, then by my reckoning that gives us 129,775 available characters.

wget http://unicode.org/Public/UNIDATA/UnicodeData.txt
awk -F ';' UnicodeData.txt -f countUnichars.awk | bc

countUnichars.awk source:

BEGIN { print "ibase=16" } # set bc to hex mode
 
$2 ~ /Private/ { # skip any lines with "private" in the description
    getline;
}
 
n { # if n is set, then print the range for bc to calculate
    printf("(%s-%s+1)+",$1,n);
    n="";
}
 
$2 ~ /First>/ { # set n if the start of a range
    n=$1;
    getline;
}
 
$3 !~ "C." { # otherwise count anything that isn't some kind of a control character
    i++;
}
 
END { # print out the count of everything else
    printf("%X\n",i)
}

This means we can store exactly 2377 bits (297 bytes) per message (this is ), so if we use a 16-colour palette we can store about 594 pixels (), which can almost reproduce the Mona Lisa thumbnail in the contest page.

So here is a very quick and simple plugin; it simply puts a button on the toolbar that you can click when you want to stop playback after the current song. I based the toolbar button code on Alexandre Rosenfeld’s lastfm-queue plugin, since I had no idea where to start with that

Download it here, and put it into ~/.gnome2/rhythmbox/plugins/stop_after_song/. Activate it in Rhythmbox’s plugin dialog.

s = cmds.sphere()
r = cmds.sphere(s, query=True, radius=True)
cmds.sphere(s, edit=True, radius=10)

Nasty.

So, here is a wrapper to make things nicer:

import maya.cmds as cmds
 
class Wrapper(object):
	def __init__(self, other):
		self.__dict__['me'] = other()
 
	def __getattr__(self, thing):
		i = 0 if cmds.attributeQuery(thing, node=self.__dict__['me'][0], exists=True) else 1
		return cmds.getAttr(self.__dict__['me'][i] + "." + thing)
 
	def __setattr__(self, thing, value):
		i = 0 if cmds.attributeQuery(thing, node=self.__dict__['me'][0], exists=True) else 1
		cmds.setAttr(self.__dict__['me'][i] + "." + name, value)

The above example is now:

s = Wrapper(cmds.sphere)
r = s.radius
s.radius = 10

David R. MacIver has recently written this blog post about cleaning up a set of tags. This blog post, on the other hand, is about a nice old Unix tool called ‘awk’.

Awk is one of those programs that is often overlooked. It is really a small domain-specific language for processing text. In some ways it resembles sed, but it is more powerful, and it especially excels at processing line- and field-structured input.

Processing cite-u-like’s data

First of all, before we begin I want to say this this isn’t a criticism of David’s work. Using a general-purpose language like Ruby to process data comes with several benefits. This post is to explain the benefits of awk and what it excels at doing.

Now, cite-u-like’s tag data comes in a pipe-separated format, so we have input like this:

42|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:25:05.373798+00|ecoli
42|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:25:05.373798+00|metabolism
42|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:25:05.373798+00|barabasi
42|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:25:05.373798+00|networks
43|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:25:51.839281+00|control
43|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:25:51.839281+00|engineering
43|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:25:51.839281+00|robustness
44|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:26:33.156319+00|networks
44|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:26:33.156319+00|strogatz
44|61baaeba8de136d9c1aa9c18ec3860e8|2004-11-04 02:26:33.156319+00|survey

From now on, whenever you see x-separated data, I want you to scream ‘USE AWK!’

Awk scripts look something like this:

pattern { expression }

pattern is used to match against a record, and if successful, the action in the braces (expression) will be carried out. But what is a record? Awk allows you to define what a line is using the variable RS (short for ‘record separator’). By default it is set to \n (so that each line is a record), which is what we want here.

Within the expression you can refer to fields of the current record, using the syntax $n. $0 refers to the whole record, while $1,$2… refer to individual fields.

Awk also allows you to define what the field separator will be via the variable FS.

So how do we set these variables? Awk has two special patterns BEGIN and END, which run before and after everything else. In this case, we want the fields to be separated by |, so we use the pattern:

BEGIN { FS = "|" }

This is rather long-winded, so mawk (an implementation of awk) also allows you to set FS via a command-line option -F.

For this application, we want the last field of the record (we could hard-code it as $4, but we’re exploring awk!). Awk provides the number of fields in the record as the variable NF (number of fields), so we want to access this field. We do so using the record syntax $ and the variable NF.

So to put all this together, what we want is the command:

awk -F "|" '{ print $NF }'

We set the field separator to “|”, and write an awk expression to print the last field of each record. Since we left the pattern empty, this expression is evaluated on every record.

Awk vs. Ruby

So what good is learning all this, anyway? There are a couple of reasons:

• awk is standard on *nix operating systems. In order to use David’s code I had to install Ruby; with awk you can generally count on it being there.
• awk is fast (I should say at least in the interpreter ‘mawk’ which is the standard for Ubuntu). On my machine the awk version completes in under a third of the time that it takes for David’s Ruby version to complete. An interesting thing was that the awk version didn’t even max out the CPU, indicating that it is IO-bound and would go faster if I had faster disks (I’m currently on a laptop).
• Awk is ideal for record- and field-based input, as I hope this post will show you

Filtering data with awk

After the above we use sort and uniq the same as David does to get the results in the following form:

 212595 bibtex-import
 157136 no-tag
  27926 elegans
  27887 celegans
  27825 c_elegans
  27795 nematode
  27738 wormbase
  27736 caenorhabditis_elegans
  18933 review
  15280 all-articles

David uses the following to filter out lines with no alphabetical content:

ruby -ne 'puts $_ if !($_ =~ /^[^a-z]+$/)'

We can use awk’s patterns to do the same thing:

$0 ~ /[a-zA-Z]/

Here we use the ~ (match) operator to write a pattern that matches only the records with an alphabetical character in them. (Remember that $0 refers to the entire record.) Notice also that we can leave off the expression after the pattern, because it defaults to { print }, which is exactly what we want.

In this case, awk really shines. On my machine it outperforms the Ruby version by a factor of 8–9.

Programming with awk

The third task that David does is to consolidate all tags which are differentiated only by hyphens or underscores. That is, ‘a-tag’, ‘atag’, and ‘a_tag’ should all be considered the same. We choose which one to put into the output by whichever one is used the most times (and then we normalize the tag by replacing ‘-’ with ‘_’ so there are only underscores in the output).

Here is David’s code to do the job:

tag_counts = {}
STDIN.lines.each{|l| c, t = l.split; tag_counts[t.strip] = c.to_i }
duplicates = Hash.new{|h, k| h[k] = []}
tag_counts.keys.each{|k| duplicates[k.gsub(/-|_/, "")] << k }
duplicates.values.each{|vs| vs.sort!{|x, y| tag_counts[y] <=> tag_counts[x]} }
 
new_tag_counts = {}
duplicates.values.each{|vs| new_tag_counts[vs[0].gsub(/(_|-)+/, "_")] = vs.map{|v| tag_counts[v]}.inject(0, &:+)}
puts new_tag_counts.to_a.sort{|x, y| y[1] <=> x[1]}.map{|t, c| " #{c} #{t}" }

I’m not going to explain it here, because that’s not the point of the post

Here’s my awk script:

{ tag_counts[$2] = $1 }
END {
	for (tag in tag_counts)
	{
		normtag=tag
		gsub(/-|_/,"",normtag)
 
		count=tag_counts[tag]
		sum[normtag]+=count
 
		if (count > max[normtag])
		{
			names[normtag]=tag
			max[normtag]=count
		}
	}
 
	for (tag in names)
	{
		finaltag=names[tag]
		gsub(/(-|_)+/,"_",finaltag)
		print " " sum[tag] " " finaltag
	}
}

That’s right, you can use awk to do some ordinary programming tasks! Arrays are used using the usual syntax, and awk even has a foreach-style loop for looping over them. I’ll walk through the rest of the script slowly.

First we apply an expression to each record, creating an array of tags and their counts:

{ tag_counts[$2] = $1 }

Then, once everything has finished (the END pattern), we process this array. For each tag, we do the following:

1. Normalize the tag (the gsub function overwrites the variable, so we have to make a copy):

   normtag=tag
   gsub(/-|_/,"",normtag)

   (Notice the similarity between this and Ruby’s equivalent normtag.gsub!(/-|_/, "")!)

2. Get the count for that tag and add it to the count for the normalized version:

   count=tag_counts[tag]
   sum[normtag]+=count

   Like in PHP and Perl, if a value is not present in an array it is automatically added with a default value.

3. Next we check to see if the current tag is the commonest version of the normalized tag, and if so we save its name and count in two other arrays:

   if (count > max[normtag])
   {
   	names[normtag]=tag
   	max[normtag]=count
   }

   Notice again the usefulness of a default value for nonexistent keys: count > max[normtag] will be true if max[normtag] doesn’t exist.

Now we have all we need to print out the answer. For each tag we normalize it to the final version (remembering to make a copy):

finaltag=names[tag]
gsub(/(-|_)+/,"_",finaltag)

Then we print out the line (concatenation is done by simply juxtaposing variables or strings):

print " " sum[tag] " " finaltag

If you’ve been watching closely you’ll notice there is a small difference between the awk and the Ruby scripts; Ruby sorts before outputting, while the awk version will come out in a non-defined order. This is fine! We can use the standard *nix tool ‘sort’ to sort the lines;

awk -f consolidate_tags.awk < tags | sort -nr > fixed_tags

(Note that this fits in with the *nix philosophy of ‘do one thing well’ and reusing small components.)

Again, the awk version outperforms the Ruby by a factor of 3–4.

Reading external commands and files

Unfortunately there doesn’t seem to be a command-line stemming program (a quick Perl script would suffice but it isn’t what we’re here for!), so I’ll skip that stage (here’s one of the aforementioned weaknesses of a non-general-purpose language). Instead we’ll go straight to implementing stopwords.

Here’s David’s Ruby code again:

require "set"
 
stopwords = Set[*
  IO.read("smart.txt").lines.reject{|x| x =~ /^#/}.map(&:strip)
]
 
STDIN.lines.each do |l|
  c, t = l.split
  puts l unless stopwords.include? t.strip
end

And here’s my equivalent in awk:

BEGIN {
    while (getline < "smart.txt")
    { stopwords[$0] = 1 }
}
!($2 in stopwords)

Here I use the ‘getline’ function which does as its name suggests. We make an array of all the stopwords, with 1 as a placeholder value. The pattern is then short and simple: Print every record where the tag isn’t in the stopwords (again, we can leave off the expression to print the whole record).

Note: There is a discrepancy here: David claims this eliminated 46 tags, while I get a value of 368 for both my awk code and his Ruby code.

Again, the Ruby takes about 8 times as long to execute.

Conclusion

Here’s a couple of points:

• Record- or field-oriented data? Think awk.

• Don’t discount it just because it’s venerable. It is very well-suited to its task.

• pattern { expression } syntax is extremely flexible.

• Awk’s regular expressions are fast.

Nowadays everybody wanna talk
    like they got something to say
But nothing comes out
    when they move their lips
Just a bunch of gibberish
And motherf—kers act
    like they forgot about Awk

f x y z = ...

… and you want:

f x y z w = ...

First of all you should check the contexts where f is used. For example, if f is quite often used as an argument to map (fmap, <$>):

elsewhere xs = map (f a b) xs

If you naïvely add w to the end of the argument list you’ll end up with this instead:

elsewhere xs = map (\x-> f a b x c) xs

On the other hand, if you take a look at the usage of f you can decide that because f is often used to map over things, you can insert the additional parameter before the last, and end up with nicer code:

elsewhere xs = map (f a b c) xs

You may even discover that the existing f is used in a lot of lambdas that could be avoided by rearranging its arguments!

I thought I had posted this earlier, but it turns out I hadn’t. So, it’s here now

Meteoroids

Meteoroids is a simple game (the premise being an homage to the classic Asteroids-based titles), programmed in Processing. Audio is provided via ChucK, and input is provided by a Nintendo Wiimote via OSC commands generated from an extension of Darwiin Remote.

To explain more, here’s a short video

The brief was to write both an additive and subtractive synthesizer, in addition to an effects processor. I generalized this a little bit so that you can combine random parts together, so the additive/subtractive synthesizers aren’t really separate any more.

Basically my code allows you to write ‘scores’ like this:

square wave:square:
glassharp:adsr:square wave,0.1,0.2,0.6,0.6
glassharpDelay:delay:glassharp,0.4
glassharpDelayed:gain:glassharpDelay,0.5
instrument:add:glassharp,glassharpDelayed
!instrument c e8 g c4 e8 g c’4 e’ g’ c e8 g c4 e8 g c’4 e’ g’

The first 5 lines are ‘instrument lines’ and the last one is a ‘score line’.

Instrument lines

The instrument lines are somewhat SSA-like in that you can only do one thing on one line. Each line has the structure [instrument name]:[source or filter]:[parameters]. The provided sources include sine, square, sawtooth, triangle, and additive (this latter has parameters which are the coefficients for additive synthesis).

An example of using additive synthesis (here used to approximate a square wave more and more closely):

sq1:additive:1
sq2:additive:1,0,0.333
sq3:additive:1,0,0.333,0,0.2
sq4:additive:1,0,0.333,0,0.2,0,0.14285714
!sq1 c d e f g r !sq2 c d e f g r !sq3 c d e f g r !sq4 c d e f g r

Filters include (parameters in brackets): delay (source instrument, seconds), gain (source instrument, amount), adsr (source instrument, attack time, decay time, sustain gain, release time), lowpass (instrument, frequency, order), highpass (instrument, frequency, order), add (instrument, instrument), subtract (instrument, instrument).

Score lines

Score lines specify the notes for the instruments to play. Notes are specified like this: [note name][optional sharp or flat][optional octave shift][optional length]. For example, to specify a C-major arpeggio using crotchets, over two octaves, you would use:

c4 e g c' e' g'

The note length ‘sticks’ for all following notes in the same line, and defaults to 4 (a crotchet) at the start of each line. Note length is specified as , so c8 is half as long as c4.

Octave shift is indicated using commas or apostrophes:

c,,, c,, c, c c' c'' c'''

Sharps and flats are indicated using ‘s’ and ‘b’, respectively:

c cs d ds e f gb g ab a as b c'

To change instrument in the middle of the score line, use the syntax ‘!instrument_name’. (This operation takes no time in the score.)

Multiple score lines will be played simultaneously. An example:

g2 a g  g
e2 f f  e
c2 c b, c

Rests are specified using the ‘note name’ ‘r’.

Caveats

• The code isn’t written for widespread consumption (it is very get-the-job-done).
• It is possible to send the program into an infinite loop using a filter that refers to itself. (e.g. infinite:delay:infinite,0.5)
• Currently you cannot control filter parameters via the score lines; this means you cannot (e.g.) create sound from white noise using a series of filters, as you cannot change the pitch.
• Wavetables aren’t implemented, but should be easy to add.
• The tempo is currently fixed at 120 BPM.
• Gain for the whole audio file will be reduced automatically to prevent clipping.
• The file format itself is not very forgiving. It is best to stick closely to the examples shown above! (In particular, white space at the end of a score line will break things with obscure messages.)

Code & example

You can listen to an example rendered by my code here. The code can be downloaded (including the score for that example) here.

Comments on implementation

The various files with ‘handle’ in their name are there to support Matlab’s form of closures (this is what I got from the documentation); if you don’t do it this way then all the references to ‘synth_options{n}’ end up being to the wrong options as Matlab’s anonymous functions are in some ways call-by-name.

The file ‘lookup’ is used instead of interfacing directly to java.util.Hashtable because you can’t (AFAIK) marshal function_handles across to Java and back.

If we have a sorted list of numbers, how can we efficiently get a sorted list of the sums of every pair of numbers in that list?

My initial reply is also there. I decided that, since I have a moment of spare time I should implement this. I’m semi-reprinting it here, but you might want to read it anyway.

Algorithm

The idea is that if you have a sorted list , you can write out the sums as a matrix where :

I’ve left out the lower half of the matrix as it is clearly symmetric ().

You can see that clearly and (since if then ), so we only have to examine the “top-left corners” of the matrix. As an example, we would first examine :

Then accept it since it is the only option, and move on to the next top-left corner, which again is a single choice:

Then we get two options:

And so on:

I think you get the picture

One of the points of this post is that I horribly misimplemented this and have spent many wasted hours today trying to figure out why it wasn’t working. Instead of the last sequence of diagrams, my algorithm was doing the following:

That is, every time a corner was eliminated it was adding both neighbours to the list of corners even if there was a corner further left on the row below it. As such, the following naïve algorithm was beating it by a factor of 4:

sortedSumSortedList xs = sort $ concat [[x+y|y<-drop nx xs]|x<-xs|nx<-[0..]]

Implementation

A preliminary: you’ll need the following imports for the code below.

import Data.Array.Unboxed
import Control.Monad
import qualified Data.IntMap as IntMap
import Test.QuickCheck
import Data.List
import Data.Time.Clock

First of all we need the sums of the list with itself:

sumLists :: [Int] -> [Int] -> UArray (Int,Int) Int
sumLists xs ys = array ((0,0),(length xs-1,length ys-1)) $ sumLists' xs ys 0
	where
	sumLists' _ [] _ = []
	sumLists' xs' (y:ys') ny = [((nx,ny),x+y)|x<-drop ny xs'|nx<-[ny..]] ++ sumLists' xs ys' (ny+1)

This does basically the same thing as the code above (concat [[x+y|y<-drop nx xs]|x<-xs|nx<-[0..]]) except that we want an array rather than a list so that we have constant-time addressing. In Haskell an array is created by specifying the boundaries of the array and then the data for the array. Note that the bottom of the array is left empty as in the diagrams; this is fine, we can leave some data unspecified as long as we never access it.

And here's the workhorse. I've commented it more thoroughly so you should be able to understand what's happening.

orderedSumsOfOrderedList sums corners row
	| IntMap.null corners = []
	| otherwise = replicate (length minCorners) minimumValue ++ orderedSumsOfOrderedList sums corners' row'
	where
	-- minCorners = all corners with the same (lowest) value
	-- allCorners = all other corners currently being considered (as a IntMap)
	(minCorners,allCorners) = IntMap.deleteFindMin corners
	-- minimumValue = the value in the lowest corner(s)
	minimumValue = sums ! (head minCorners)
 
	-- row is incremented if any of the neighbours has moved down a row
	row' = if any (\(_,_,b)-> b) neighbours then row+1 else row
	-- update the corners to reflect all neighbours of the just-removed corners
	corners' = foldr (\(key,value)-> IntMap.insertWith (++) key [value]) allCorners $ map (\(x,y,_) -> (x,y)) neighbours
 
	-- a list of values, their positions in the array, and whether to increment row
	neighbours = concatMap (\p-> goRight p ++ goDown p) minCorners
		where
			-- try to get a neighbour further right, within bounds of array
			goRight (x,y) =	ifM (x < maxX)                       (sums ! (x+1,y), (x+1,y),False)
			-- try to get a neighbour further down, within bounds of array and not on the same row as another one
			-- (if successful we should update row)
			goDown  (x,y) = ifM (y < x && y < maxY && y+1 > row) (sums ! (x,y+1), (x,y+1),True)
			maxX = (fst$snd$bounds$sums)
			maxY = (snd$snd$bounds$sums)

To efficiently choose the lowest number each time, we keep track of them in something like a binary tree. In Haskell the provided implementation is Data.Map (or Data.IntMap which is specialized for integer keys).

The rest of what this code does is basically:

1. Choose the lowest corner(s) from the tree of available corners.
2. Find the neighbours of these corner(s), ensuring they are valid (in this case this means checking bounds and checking that no two are on the same row—it suffices to ensure that no downwards-searching neighbours are added which are on a row less than the maximum row reached so far), and insert these into the tree.
3. Output the lowest corner(s) and recurse with the new tree and row number.

ifM is a nice little function I've had cause to use several times, and it looks like this:

ifM :: (MonadPlus m) => Bool -> a -> m a
ifM pred res = if pred
		then return res
		else mzero

And here's the wrapper function (osool = ‘ordered sums of ordered list’), we take in a list of Ints and return a list of Ints. Note that we do not check the precondition (that the input list is sorted).

osool :: [Int] -> [Int]
osool [] = []
osool xs = orderedSumsOfOrderedList sums corners row 
	where
	sums = sumLists xs xs
	corners = IntMap.singleton (sums ! (0,0)) [(0,0)]
	row = 0

sums is the sums of the list, and corners is the quick-lookup structure (in this case IntMap) which allows us to find the minimum fast. We initialize it with the value of the top-left corner of the matrix, and its coördinates. Finally, row is a value indicating which row we are up to. As shown above, we don't want to add any new corners which are less than this value when eliminating a square and looking for a neighbouring square in the downwards direction.

And finally, we can test this with the wonderful QuickCheck:

checkMe = do
	time "osool" $ quickCheck (\xs -> let sxs = sort xs in length (osool sxs) == num sxs)
	time "checkSumLists" $ quickCheck (\xs -> let sxs = sort xs in length (checkSumLists sxs) == num sxs)
 
	time "osool" $ longCheck (\xs -> let sxs = sort xs in length (osool sxs) == num sxs)
	time "checkSumLists" $ longCheck (\xs -> let sxs = sort xs in length (checkSumLists sxs) == num sxs)
 
	time "areEqual" $ quickCheck (\xs -> let sxs = sort xs in checkSumLists sxs == osool sxs)
	where
	longCheck p = check (defaultConfig { configSize = const 1000, configMaxTest = 500}) p
	checkSumLists xs = sort $ concat [[x+y|y<-drop nx xs]|x<-xs|nx<-[0..]]
	num xs = sum [1..length xs]
	time s d = do
		putStrLn $ s ++ ":"
		t1 <- getCurrentTime
		d
		t2 <- getCurrentTime
		putStrLn $ show $ t2 `diffUTCTime` t1

Results

$ ./test
osool:
OK, passed 100 tests.
0.024591s
checkSumLists:
OK, passed 100 tests.
0.014857s
osool:
OK, passed 500 tests.
15.448749s
checkSumLists:
OK, passed 500 tests.
82.871982s
areEqual:
OK, passed 100 tests.
0.007773s

As you can see, the wins over the naïve version are substantial.

class Wrapper<T>
{
    T value;
    public Wrapper(T theObject)
    {
        value = theObject;
    }
    // Some other methods...
}

Now, since this is a just a wrapper around some type T, we would like to implement some simple interfaces around this object. For example, if T is comparable, we would like the wrapper class to implement IComparable<Wrapper<T>>. However this is not possible with C#. In Haskell we would have something like this:

instance (Disposable a) => Disposable (Wrapper a) where ...

This says “if a is a type that is an instance of Disposable, then the type Wrapper a is also an instance of Disposable”. In C#, I’d like to see something like this:

class Wrapper<T>
    : IComparable<Wrapper<T>>
        when T : IComparable<T> //this is the syntax extension
{
    //...
}

And then in any methods that the interface specifies (in this case int Compare(Wrapper<T> other)), it is assumed that for any object of type T you have access to all the methods that T has when it implements IComparable<T>.

At the moment the best you can do is to always implement IComparable<Wrapper<T>> and just throw a runtime exception when T doesn’t implement IComparable<T>, which isn’t very nice.

A simple idea, but it would add great power to C#.

After some (very quick) research I haven’t found anything that suggests anyone else has attempted to get this into C#, but there is JavaGI (see section 2.4 for the equivalent of what this post talks about) where the authors have extended Java to deal with what they term ‘generalized interfaces’—a concept which alters Java (rather radically) to make interface implementations similar to Haskell’s typeclasses.

Assumption One: We are dealing with a valid UTF-8 string

Making this assumption means that once we hit the start of a multi-byte character we can skip forward a few places. It also means we don’t check for hitting invalid characters (this sends the algorithm into an infinite loop if run on non-valid input it is possible to make the algorithm run past the end of the buffer by supplying malformed data).

Assumption Two: Most strings are ASCII

Therefore, run a simple ASCII count routine beforehand. As soon as we hit a non-ASCII character switch into counting UTF-8.

The code

Note: The current code relies on chars being signed bytes.

int porges_strlen2(char *s)
{
        int i = 0;
 
        //Go fast if string is only ASCII.
        //Loop while not at end of string,
        // and not reading anything with highest bit set.
        //If highest bit is set, number is negative.
        while (s[i] > 0)
                i++;
 
        if (s[i] <= -65) // all follower bytes have values below -65
                return -1; // invalid
 
        //Note, however, that the following code does *not*
        // check for invalid characters.
        //The above is just included to bail out on the tests :)
 
        int count = i;
        while (s[i])
        {
                //if ASCII just go to next character
                if (s[i] > 0)      i += 1;
                else
                //select amongst multi-byte starters
                switch (0xF0 & s[i])
                {
                        case 0xE0: i += 3; break;
                        case 0xF0: i += 4; break;
                        default:   i += 2; break;
                }
                ++count;
        }
        return count;
}

Results

I used Kragen’s testing code, but removed all strlens that didn’t do UTF-8 counting, and added one test for valid UTF-8 text (just the phrase ‘こんにちは’ repeated). Twice as fast on both the ASCII-only and UTF-8 tests. Improvement on ASCII is due to the ASCII-only routine, and improvement on UTF-8 is due to skipping bytes.

"": 0 0 0 0 0
"hello, world": 12 12 12 12 12
"naïve": 5 5 5 5 5
"こんにちは": 5 5 5 5 5
1: all 'a':
1:           porges_strlen2(string) =   33554431: 0.034672
1:         ap_strlen_utf8_s(string) =   33554431: 0.068210
1:         my_strlen_utf8_c(string) =   33554431: 0.071038
1:         my_strlen_utf8_s(string) =   33554431: 0.135856
2: all '\xe3':
2:           porges_strlen2(string) =   11184811: 0.032115
2:         ap_strlen_utf8_s(string) =   33554431: 0.068228
2:         my_strlen_utf8_c(string) =   33554431: 0.071050
2:         my_strlen_utf8_s(string) =   33554431: 0.152513
3: all '\x81':
3:           porges_strlen2(string) =         -1: 0.000001
3:         my_strlen_utf8_s(string) =          0: 0.068339
3:         ap_strlen_utf8_s(string) =          0: 0.068547
3:         my_strlen_utf8_c(string) =          0: 0.071039
4: all konichiwa:
4:           porges_strlen2(string) =   11184810: 0.032143
4:         ap_strlen_utf8_s(string) =   11184810: 0.068271
4:         my_strlen_utf8_c(string) =   11184810: 0.071036
4:         my_strlen_utf8_s(string) =   11184810: 0.089478

Note also that the invalid UTF-8 gives strange results; this is because the algorithm isn’t meant to work on it! (The first invalid sequence is a list of 3-byte starters, so the result is divided in 3 due to skipping, and the second is a list of follower bytes, so the code bails out.)

Going faster

By dropping back to the ASCII counter whenever we hit ASCII again, we go even faster. This will handle the cases (such as in English) where there are many ASCII characters and only a few multibyte ones.

int porges_strlen2(char *s)
{
        int i = 0;
        int iBefore = 0;
        int count = 0;
 
        while (s[i] > 0)
                ascii:  i++;
 
        count += i-iBefore;
        while (s[i])
        {
                if (s[i] > 0)
                {
                        iBefore = i;
                        goto ascii;
                }
                else
                switch (0xF0 & s[i])
                {
                        case 0xE0: i += 3; break;
                        case 0xF0: i += 4; break;
                        default:   i += 2; break;
                }
                ++count;
        }
        return count;
}

But on the ‘konichiwa’ test the speed improvement happens even though we’re counting pure multibyte, and I’m not sure exactly why… probably something to do with branch prediction or another arcane CPU topic I don’t understand.

4: all konichiwa:
4:           porges_strlen2(string) =   11184810: 0.026017
4:         ap_strlen_utf8_s(string) =   11184810: 0.068320
4:         my_strlen_utf8_c(string) =   11184810: 0.071035
4:         my_strlen_utf8_s(string) =   11184810: 0.089464
5: mixed english:
5:           porges_strlen2(string) =   32435949: 0.040342
5:         my_strlen_utf8_c(string) =   32435949: 0.071035
5:         ap_strlen_utf8_s(string) =   32435949: 0.078233
5:         my_strlen_utf8_s(string) =   32435949: 0.160676

Without the drop-back-to-ASCII modification:

5: mixed english:
5:           porges_strlen2(string) =   32435949: 0.067753

main = (putStr . ap (++) show) "main = (putStr . ap (++) show) "

Edit: I have found it somewhere else Here, to be exact.