Sunday, 27 December 2015

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:

Friday, 11 December 2015

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:'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: