Tiling and tessellation with a Context Free Grammar - Part 2

In my previous blog post we looked at how to use a Context Free Grammar to make simple grids of circles and then use colour variation to produce a rainbow effect. Now let's look at making more interesting patterns of shapes.

Simple spirals

First let's draw a series of ever decreasing, spiralling triangles...

#lang s-exp stamps/lang

(define-shape spiral
  (spiral [r 22]
          [x .8]
          [s .95]))
(maximum-render-cycles 1000)
(start-shape spiral)

Play with those numbers in square brackets to produce something you like. Remember, r=rotation, x=x translation, s=scale.

Recursive loops

This example draws a hexagon with a circle of hexagons around it, and for each of those hexagons, it draws a circle of hexagons around it, recursively building up a pattern that fills the artwork.

#lang s-exp stamps/lang

(define-shape hex-circle
  ((loop ([i 6])
           [r (* 360 (/ i 6))]
           [y .9])))

(define-shape scene
  (hex-circle [alpha -.7]
              [b .2])

(maximum-render-cycles 1000)
(start-shape scene)

There's a few new concepts in this code:
  • A loop construct to draw a circle of 6 hexagons. There's a lot of brackets in there! These denote the loop; the binding, in this case i takes the values from 1 to 6; then the loop body, in this case a call to hex-circle with attributes to draw each at the right position around the central hexagon.
  • A bit of lisp-style maths: (* 360 (/ i 6)) means 360*(i/6), in other words, rotate by a sixth of a circle for each loop iteration. 
  • We use a scene function to set up the basic attributes, for everything drawn: reduced alpha (transparency) and reduced brightness.
As with previous examples, play with the numbers, or add in extra adjustments to create something you like.

Recursive branching

You may have noticed in the previous example that we drew many hexagons on top of other hexagons, resulting in dark hexagons in the centre of the pattern. As an alternative we can instead draw just two outer shapes, positioned at alternative angles (in this case -60˚ and 60˚), the effect of recursion then fills the plane.

#lang s-exp stamps/lang 

(define-shape C
  (C [r -60] [y .5])
  (C [r 60] [y .5])

(define-shape scene
     [alpha -.9]
     [b .2]))

(maximum-render-cycles 1000)
(start-shape scene)

Let's introduce a few variables to make playing with the numbers easier. This code is the pretty much the same as the above, but with the angle and space set at the start of the program (and red dots):

#lang s-exp stamps/lang 

(define angle (/ 360 8))
(define space 3)

(define-shape C
  (C [r (- angle)] [y space])
  (C [r angle] [y space])

(define-shape scene
     [alpha -.9]
     [b 1]
     [sat 1]
     [hue 0]))

(maximum-render-cycles 50000)
(start-shape scene)

What next? Let's explore tessellation with regular shapes such as pentagons, hexagons and heptagons... (coming soon)

Tiling and tessellation with a Context Free Grammar

There's something pleasing about filling a space with shapes that fit together and overlap in interesting ways. Using a Context Free Grammar we can use a simple language to express relations between shapes and make a large composition with a few rules.

In this series of blog post I explore tiling with different shapes, starting with simple grids and circular patterns with single shapes, then exploring more complex combinations of shapes. 

The tool I'm using to explore these patterns is Racket Stamps, which runs on the Racket language. Download both for free by following these links. 

What's a Context Free Grammar?

From Wikipedia a CFG is: "a set of production rules that describe all possible [compositions] in a given language... production rules are simple replacements."

So a CFG allows you to represent drawings by simple shape compositions, for example this Racket Stamps code draws an infinite line of circles by defining circles as a circle followed by circles to the left:

#lang s-exp stamps/lang
                        ;; Comments:
(define-shape circles   ;; define circles to be:
  (circle)              ;; a circle
  (circles [x 1]))      ;; followed by circles to the left

If you run that in Racket Stamps (and do check out the tutorial first) you'll see that the line is actually not infinite, just very long. We can control how far the rendering runs, and therefore how many shapes are drawn using the setting maximum-render-cycles -- you'll see this in the examples below.

Tiling a plane

So we can draw a line, but how would we fill a 2D space? The first method to try is to make a grid of shapes. A grid is a line of shapes, with a grid placed above it, which is a line of shapes with a grid placed above it... thanks to recursion we can fill the space, here's the code:

#lang s-exp stamps/lang

(define-shape line-of-circles
  (line-of-circles [x 1]))

(define-shape grid
  (grid [y 1]))

(maximum-render-cycles 1000)
(start-shape grid)

Because of the way the rendering works (and in particular how the maximum-render-cycles setting works), we actually get a triangle of circles! But we can crop into a square, so code like the above works well to help us explore patterns. Try this by adding this setting to the above example:

  (bounding '(-16 -12 -1 0.50))

Making adjustments

Do you see those xs and ys in the examples above, enclosed in square brackets? They adjust the position of shapes so that we don't draw everything on top of each other. There are lots of other adjustments you can use, try out the following:
  • rotate (or r) by a number of degrees
  • scale (or s) by a factor, 1 is same size, .9 is 10% smaller, 1.1 is 10% bigger 
  • shear by a factor between -1 and +1, 0 is no shear
  • hue (or h) change colour by degrees on the colour wheel 
  • saturation (or sat) between 0 and 1
  • brightness (or b) between 0 and 1
  • alpha (or a) between 0 and 1
In many cases the adjustment modifies the attribute by whatever you specify, so that you can gradually make things bigger or smaller, or change the colour. Try changing the definition of grid to the following:

(define-shape grid
  (line-of-circles [sat 1] [b 1]) ;; Full saturation and brightness
  (grid [y 1]
        [hue 10] ;; Move through the colour wheel by 10 degrees


Let's try to make something more interesting than a grid of circles... Tiling and Tessellation part 2.

Learn to read music with Racket Scheme

Further to my previous post about using MIT Scratch to help you practice music, I thought I'd give Racket a go to see how easy it would be to get something working.

Scratch is brilliant for prototyping audio/visual ideas, but the limitations of a drag and drop language quickly become apparent once you move beyond basic programs.

I've started learning Racket using the books Realm of Racket and the Little Schemer. Racket is appealing to me because it has the audio/visual stuff built in, and because it's different from the current set of popular C-inspired programming languages.

Here's how the program looks when run...

And here's the code:
#lang racket

Show notes, then play them, see if you get them right!
Press any key if you find the note easy, you'll then
get less time to play this note next time.

Challenge: How to avoid practicing mistakes or quick
corrections, wait for the player to remember first?

- Fix display of extenders that should be hidden by
  stave lines
- Blue colouring for easy notes only considers default set
- Sort easy-notes for better display, or show them on
  the stave?

(require srfi/1)
(require 2htdp/universe 2htdp/image)
(require 2htdp/image)
(require rsound)
(require rsound/piano-tones)

;; What notes do we want to practice?
(define NOTES
  '(e2 f2 g2 a3 b3 c3 d3 e3 f3 g3 a4 b4 c4 d4 e4 f4 g4)) 
;; We need MIDI numbers to play them, these are the standard set
  '(52 53 55 57 59 60 62 64 65 67 69 71 72 74 76 77 79)) 
;; Guitar midi notes are one octave lower
(define MIDI-NOTES
  (map (λ (x) (- x 12)) PIANO-MIDI-NOTES))

;; We want to show the open string notes differently
  '(e2 a3 d3 g3 b4 e4))
;; The initial set of easy notes for *me* to play - change this
;; to suit your needs
(define EASY-NOTES
  '(c4 d4 f4 g4))

;; The canvas
(define WIDTH 400)
(define HEIGHT 300)
(define G-CLEF (bitmap "GClef.png"))

;; How many seconds between notes? Change this to suit your needs
(define TICK-RATE 3)

(define PIX-PER-NOTE 11)

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

(define-syntax-rule (times-repeat n fn)
  (for/list ([i (in-range n)])

(define (random-choice list)
  (list-ref list (random (length list))))

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

(define (note-index a-note)
  (list-index (curry equal? a-note) NOTES))

(define above/align-left
  ((curry above/align) "left"))

(define (stave)
  (apply above/align-left 
         (cons (line 300 0 "black")
               (times-repeat 4
                              (line 0 20 "black")
                              (line 300 0 "black")

(define (note-pos-relative-b4 a-note)
  ;; b4 is the middle of the stave
  ;; b4 = 0, a4 = -1, c4 = 1, etc
  (- (note-index a-note) PIX-PER-NOTE))

(define (note-y-pos a-note)
  (* PIX-PER-NOTE (note-pos-relative-b4 a-note)))

(define (extender-line)
  (line 30 0 "black"))

(define (extenders a-note-pos)
  ;; Draw extenders from b4 up or down to note
  ;; the first few will be obscured by the 5 stave lines

  ;; Use absolute value of note pos:
  (if (< a-note-pos 0) (extenders (- 0 a-note-pos))
        [(= a-note-pos 0) (extender-line)]
        ;; No lines at odd note positions
        [(odd? a-note-pos)
         (extenders (sub1 a-note-pos))]
          "left" "top"
          (extenders (sub1 a-note-pos)))])))

(define (extenders-above a-note)
  ;; Are the extenders above the stave (or below)?
  (>= (note-pos-relative-b4 a-note) 0))

(define (note-img a-note)
  (circle 10
          (if (member a-note OPEN-STRINGS) "outline" "solid")
          (if (member a-note EASY-NOTES) "blue" "black")))

(define (show-note a-note)
  ;; Show the note on the stave with extenders and the G-Clef
   (scale 0.53 G-CLEF)
   120 -6
    (extenders (note-pos-relative-b4 a-note))
    (/ WIDTH 2) (/ HEIGHT 2) "middle"
    (if (extenders-above a-note) "bottom" "top")
     (note-img a-note)
     0 (note-y-pos a-note)
      (stave) (empty-scene WIDTH HEIGHT "white"))))))

(define (play-note a-note)
  (play (piano-tone 
         (list-ref MIDI-NOTES (note-index a-note)))))

(define (play-and-show-note a-note)
  (play-note a-note)
  (show-note a-note))

;; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
;; big-bang world

(struct world (note plays easy-notes) #:transparent)

(define (next-random-note last-note)
  ;; Next random note, but not last-note
  (define note (random-choice NOTES))
  (if (eq? note last-note)
      (next-random-note last-note)

(define (play-note-times a-note easy-notes)
  (if (member a-note easy-notes) 2 4))

(define (next-note w)
  ;; Play the next note, but first check if we've finished
  ;; playing this note. If we have, pick a new one.
    [(zero? (world-plays w))
     (let* ((note (next-random-note (world-note w)))
           (plays (play-note-times note (world-easy-notes w))))
       (next-note (world note plays (world-easy-notes w))))]
     (play-note (world-note w))
     (world (world-note w) (sub1 (world-plays w)) (world-easy-notes w))]))

(define (easy-note w a-key)
  ;; The user finds the current note easy - stop playing it
  ;; and add it to the set
  (let ((note (world-note w))
        (easy-notes (world-easy-notes w)))
    (world note 0
           (if (member note easy-notes)
               (cons note easy-notes)))))

(define (render-scene w)
   (above/align "left"
    (text (string-append "Easy notes: "
                         (string-join (map symbol->string (world-easy-notes w)) ", "))
          15 "black")
    (text "Press any key to add current note" 15 "black"))
   5 5 "left" "top"
   (show-note (world-note w))))

(define (go)
  (big-bang (world (random-choice NOTES) 0 EASY-NOTES)
            (on-tick next-note TICK-RATE)
            (on-key easy-note)
            (to-draw render-scene)))


You'll also need the G-Clef image:

The code is also available on GitHub:

Using autotests to explore and improve code

There's a lot of code out there on the internet, however often it's hard to understand what it does and how to change it to meet your needs. I've found writing autotests a great way to delve into others' code and really understand it, including its bugs and wrinkles. Here's how I took this approach with a new programming challenge in Racket...


I want to write a version of the Eliza psychotherapist program to explore how intelligent computers can appear, or how much work it is to make them appear intelligent. I have in mind testing it out on the local kids' computer club... how many of the 8-10 year olds would be fooled?

I've had a play with the Emacs Doctor mode (run `ESC-x doctor` in emacs to see this) and it's certainly fun. I'm also exploring the Racket programming language (a dialect of Scheme) right now so if I can get something running in that then I can extend it and also further my knowledge in this language.

So after some Googling I find this:
...it's written for Guile (GNU's version of Scheme).

My first task is to get it running in Racket, it's not that hard, mostly quote escaping and a few differences when making hashes and sorting lists. You can see the code changes here:

So now it runs, cool :)

But it seems to crash a fair bit on certain inputs, and now I realise I have to figure out what the code is actually doing. Hmmm... I can see that `eliza.rkt` defines the patterns to match and `bot.rkt` does the actual work, but I'll need to dig much deeper to get the program working properly, and be able to extend it.

I start by listing the bugs I find, but this doesn't help much with my understand of the code...

Introducing autotests

Racket has a nice autotest framework `rackunit` so I give that a go. I pick out a few simple looking procedures from `bot.rkt` and write tests to see if I can prove what they do with different inputs. Here's my first version of `bot-tests.rkt`:

#lang racket

(require rackunit "bot.rkt")

(define-keyword (xnone)
   (A sentence for xnone)))

(define-keyword (sorry)
   (Please don\'t apologise.)))

 "pre-process-msg tests"
 (check-equal? (pre-process-msg "hello")
 (check-equal? (pre-process-msg "HeLlo")
 (check-equal? (pre-process-msg "apples AND oranges")
               '(apples and oranges))
 (check-equal? (pre-process-msg "maybe")

 "respond-to tests"
 (check-equal? (respond-to "apple and banana")
               "A sentence for xnone"))
 (check-equal? (respond-to "SORRY")
               "Please don\'t apologise."))

So I now know what `pre-process-msg` and `respond-to` do and I have a working set of tests. Now I can introduce failing tests to give me some debugging strategies...

Writing failing autotests

Here's my first failing tests, a keyword with a comma in it:

(define-keyword (you)
  ((* you *)
   (Oh, I (% 2) ?)))

(check-equal? (respond-to "you like noise")
               "Oh, I like noise ?")

So now I have a quick way of breaking the program, with a single click, rather than having to interact with the program by typing input. The other big advantage of these autotests is that they are way simpler than the full `eliza.rkt` file, so they are easier to understand. 

The fix to the above program was to escape the comma thus: `(Oh\, I (% 2) ?)`

To be continued...

Next: synonyms, what the (% 2) means in keywords, and how sentences are destructured...

Where I've got to so far

If you want to see how far I've got, take a look at my github repo:

Here's my current to-do list:

Racket on the Raspberry Pi

Racket is a nice programming language to experiment with -- OK there's a bit of adjustment to the lisp syntax, but once you get that you get access to a wealth of built-in libraries for graphics, animation, UIs and more.

The Racket package in the official Raspian repo doesn't work out of the box, but you can download and compile it yourself. It takes an hour or so, but is not hard to do.

I've tried this on both the newer model 2, and the older version of the Raspberry Pi. It works reasonable well on the newer model, but is frustratingly slow on the older one.

Step 1: Download the latest version from the website

Go to http://download.racket-lang.org/ and choose Unix source + built packages.

You can also download with:
wget http://mirror.racket-lang.org/installers/6.2.1/racket-6.2.1-src-builtpkgs.tgz

Step 2: Compile it from source

Check the version numbers in the commands below. At the time of writing 6.1 was available.

tar zxvf racket-6.1-src-builtpkgs.tgz
cd racket-6.1/src

Finally run:

sudo make install

Step 3: Run DrRacket to try it out

Start up DrRacket, you can find it in the bin directory:

cd ~/racket-6.1/bin

Enter the following into the top part of the window (the Definitions) and click Run.

#lang racket
(require pict)

(define (circles n)
  (if (zero? n) empty
      (cons (circle (* n 15)) (circles (sub1 n)))))

(define (squares n)
  (if (zero? n) empty
      (cons (rectangle (* n 15) (* n 15)) (squares (sub1 n)))))

Now run these in the bottom part, the Interactions:

(apply cc-superimpose (squares 8))
(shuffle (append (circles 4) (squares 4)))

DrRacket has great built in help, simply place your cursor a command and hit F1 to read the docs.

Step 4: Check out the games

There are a bunch of games in ~/racket-6.2.1/share/pkgs/realm/ -- from the book Realm of Racket.
The snake game in chapter6 is a good place to start.

Have fun...

Programming Number Squares

I want to produce number squares (10 x 10 grids of numbers up to 100) and highlight different sequences of numbers to help in my maths teaching. For example: what sequence is highlighted in the number square below?

I could make these in a spreadsheet, but why not program it so that I can quickly produce a range of number squares?

I've been playing with the Racket programming language (http://racket-lang.org/) and given that it has graphics primitives built in to the basic language it seems like a good choice.

Here's an example of what it can do with graphics, try each line in turn...
(require 2htdp/image) 
(text "21" 50 "black") 
(rectangle 70 70 "solid" "yellow") 
(overlay (text "21" 50 "black")  (rectangle 70 70 "solid" "yellow")) 
OK, so we have a yellow square with 21 in it. So from these basics we can build some number squares:
(require 2htdp/image)  
(require math/number-theory)
(define NUMBERS-PER-LINE 10)  
(define NUMBER-SIZE 30)
(define BOX-SIZE 60)
(define (number-in-box n pred)
  (overlay (text (number->string n) NUMBER-SIZE "black")
           (if (pred n)
               (rectangle BOX-SIZE BOX-SIZE "solid" "pink")
               (rectangle BOX-SIZE BOX-SIZE "outline" "black"))))
(define (number-block n pred)
  (define numbers (rest (build-list (+ n 1)
                                    (λ (x) (number-in-box x pred)))))
  (define (number-lines l)
    (cond [(= (length l) NUMBERS-PER-LINE)
           (apply beside (take l NUMBERS-PER-LINE))]
            (apply beside (take l NUMBERS-PER-LINE))
            (number-lines (drop l NUMBERS-PER-LINE)))]))
  (number-lines numbers))
The first procedure number-in-box draws one number and colours it (or not) depending on the predicate pred, which is a test for the number. Try these:

(number-in-box 5 odd?)
(number-in-box 5 even?)

The second procedure number-block draws the block of numbers, again with the predicate (which it simply passes on to number-in-box. Try these:
(number-block 100 odd?)  
(number-block 100 prime?) 
(number-block 100 square-number?)

Making times tables with curry

To make tables for times tables you need to add a predicate to test for multiples of a number, e.g.:
(define (multiple-of-3? n)
  (zero? (remainder n 3))) 
Now you can run:
(number-block 100 multiple-of-3?)
However, it's a bit of work to have to define a new procedure each time we want a new times table. What about a predicate like this?

(define (multiple-of? m n)
  (zero? (remainder n m)))

This takes two parameters like this: (multiple-of? 3 9)
in this example, is 9 a multiple of 3?

However, our predicate that we want to pass to number-block expects a single argument: the number in the number square. How can we adapt this procedure to accept a single argument? The answer: with currying.

(curry multiple-of? 3) is a new version of our procedure with the three already passed, so this version is ready to accept the number from the number square. Try these examples:

(number-block 100 (curry multiple-of? 4))
(number-block 100 (curry multiple-of? 5))
(number-block 100 (curry multiple-of? 6))