LISP Workshop for Musicians #5

Logic, conditions and control

In the last session we built up this function:

(defun harmonic-series (frequency n &key (ratio 1)(sel nil)(start 1)(notes nil) 
                                    &aux (output-list nil))
     "returns a list of the harmonic-series with fundamental < frequency >
      and < n > harmonics. Key arguments: < ratio > < sel >
      (must be 'odd or 'even), < start >, < notes >"
     (if sel                                                                   ;;; 1
        (if (equal sel 'even)                                                  ;;; 2
          (loop for j from 1 to n and for r from (+ start 1) by (* 2 ratio) do ;;; 3
              (push (* frequency r) output-list))         
          (if (equal sel 'odd)                                                 ;;; 4
              (loop for j from 1 to n and for r from start by (* 2 ratio) do   ;;; 5
                  (push (* frequency r) output-list)) 
              (error "sel must be 'odd or 'even")))                            ;;; 6
        (loop for j from 1 to n and for r from start by ratio do               ;;; 7
          (setf output-list (push (* frequency r) output-list))))
     (if notes                                                                 ;;; 8
         (nreverse (mapcar #'(lambda (x)                                       ;;; 9
                                     (note (float x))) 
                                   output-list))
         (nreverse output-list)))                                              ;;; 10

Inside this code we are taking decisions, that is why we are using the nested if structure, recall that if has this behavior:
```
     (if < condition-form >
         < then-form >
         < else-form >)

     (defun simple (a b)
        (if ( > a b)
          a
          b))
     
     (simple 1 2)
     (simple 2 2)
     (simple 3 2)
```
so the very first if is testing the variable sel, if this variable is NIL, the first form (list) after the test will NOT be evaluated, and the interpreter will jump to the next form (starting at line 7) inside the if and evaluate it. In the case that sel is NOT NIL, this means that it is true for the test the first of the two forms inside the if gets evaluated (the form starting at line 2). In this case that form has another if statement, this time we test if the variable sel is equal to 'even (line 2), if this is true we execute the loop in line 3. Otherwise we jump to line 4 where the form that we have to evaluate is another if, we test now if the value of set is equal to 'odd, if this is true we execute the loop starting in line 5, otherwise we print an error message.

This nested if structure can be avoided using the cond macro:

    (cond (< condition-form-1 > < then-form-1-1 >...< then-form-1-m >)
          (< condition-form-1 > < then-form-2-1 >...< then-form-2-m >)
          ...
          (< condition-form-n > < then-form-n-1 >...< then-form-n-m >))

    (defun simple (a b)
      (cond (( > a b) a)
            ((<  a b) b)
            ( T 'a=b)))

the new code using cond looks like this:

(defun harmonic-series (frequency n &key (ratio 1)(sel nil)(start 1)(notes nil) 
                                    &aux (output-list nil))
     "returns a list of the harmonic-series with fundamental < frequency >
      and < n > harmonics. Key arguments: < ratio > < sel >
      (must be 'odd or 'even), < start >, < notes >"
     (if sel                                                                   
        (cond ((equal sel 'even)                                                 
               (loop for j from 1 to n and for r from (+ start 1) by (* 2 ratio) do 
                   (push (* frequency r) output-list)))         
              ((equal sel 'odd)                                                
               (loop for j from 1 to n and for r from start by (* 2 ratio) do 
                   (push (* frequency r) output-list)))
              (T (error "sel must be 'odd or 'even")))                        
        (loop for j from 1 to n and for r from start by ratio do               
              (setf output-list (push (* frequency r) output-list))))
     (if notes                                                                 
         (nreverse (mapcar #'(lambda (x)                                       
                                     (note (float x))) 
                                   output-list))
          (nreverse output-list)))

Cond evaluates the conditions sequentially and when it finds one that is T (true) it executes its associated forms.

We can make other change in the conditions of our code. We must transform the frequencies in the output-list into notes only when :notes is true. We can use the when conditional for this:

     (when < condition-form >
        < then-form-1 >
        < then-form-2 >
        ...
        < then-form-n)

     
(defun harmonic-series (frequency n &key (ratio 1)(sel nil)(start 1)(notes nil) 
                                    &aux (output-list nil))
     "returns a list of the harmonic-series with fundamental < frequency >
      and < n > harmonics. Key arguments: < ratio > < sel >
      (must be 'odd or 'even), < start >, < notes >"
     (if sel                                                                   
        (cond ((equal sel 'even)                                                 
               (loop for j from 1 to n and for r from (+ start 1) by (* 2 ratio) do 
	          (push (* frequency r) output-list)))         
              ((equal sel 'odd)                                                
               (loop for j from 1 to n and for r from start by (* 2 ratio) do 
	          (push (* frequency r) output-list)))
              (T (error "sel must be 'odd or 'even")))
        (loop for j from 1 to n and for r from start by ratio do               
              (setf output-list (push (* frequency r) output-list))))
     (when notes                                                                 
         (setf output-list (mapcar #'(lambda (x)                                       
                                     (note (float x))) 
                                   output-list)))
     (nreverse output-list))

When test the condition-form, if it evaluates to T (true) it executes sequentially the then-forms. In this case there is only one then-form. The unless conditional is the reverse of when, it evaluates the then-forms sequentially only if the condition-form is NOT T (NIL).
```
     (unless (not < condition-form >)
        < then-form-1 >
        < then-form-2 >
        ...
        < then-form-n >)
```

Dotted Pairs and Association Lists

In Workshop #3 we explored the memory representation of List Structures. List are represented as chains of duple-cells in memory with linking pointers. At that point we said that the last element of these chains is a NIL cell, represented by a duple cell without a link pointer:
There is a special type of cons cell that instead of ending with a NIL constant, they end with a pointer to another element:
For his type of lists, called Dotted Pairs, you might expect a different behavior of the function rest or cdr:
```
     (rest '(a b))
     - > (b)

     (rest '(a . b))
     - > b
```
when rest is called on a dotted pair, it returns an atom instead of a list. So any list can be written as a nested set of dotted pairs:
```
     (a b c)  <=>  (a . (b c))

     (rest '(a b c)) 
     - > (b c)

     (rest '(a . (b c)))
     - > (b c)
```
Dotted pairs ar specially useful for the construction of Association Lists. Association-lists (or a-lists, for short) are lists of dotted pairs of the following form:
```
     ((key-1 . item-1)(key-2 . item-1) ... (key-n . item-n))
```

This kind of structure is used to create Data Bases:

(defvar phones '((john . "(415)-477-2233")(mary . "(408)-489-3458")(peter . "(415)-325-2154")))

Lisp provides built-in functions for manipulating a-lists. To fetch an item from an a-list, you use the function assoc:
```
     (assoc 'peter phones)
     - > (PETER . "(415)-325-2154")
```
Note that assoc returns a dotted pair consisting of a key and an item. To get the actual item, you need to call rest:
```
     (rest (assoc 'peter phones))
     - > "(415)-325-2154"
```
There is a :test keyword for assoc that allows you to select the test used to match the keys; its defaults to eql.
You can retrieve keys from the a-list given an item using the rassoc function (for reverse association). For example, you could retrieve the name of one of your friends in the phone data base given a telephone number by typing:
```
     (rassoc "(408)-489-3458" phones)
     - > NIL
```

This does not work because, as we said in Workshop #3, two chains of characters (even if they "say" the same thing) are not eql, so we have to change the test of rassoc to equal:

     (rassoc "(408)-489-3458" phones :test #'equal)
     - > (MARY . "(408)-489-3458")

     and to retrieve the actual key name:

     (first (rassoc "(408)-489-3458" phones :test #'equal))
     - > MARY

Functions using A-Lists

Functions that operate on a finite set of values can be written using a-lists. This kind of intelligent functions can learn while are executing their evaluation. This means that they will evaluate their body only one time for a particular argument, and store the argument and its value into an a-list. The next time the function is call with the same argument the body is not evaluated and the function performs a simple association in its data base and retrieve the value. This is specially useful for functions that must perform arithmetic calculations or heavy mathematic calculus.
We can create our own my-pitch function, to get the frequency of any symbolic represented note, using a-lists. First, we have to define our empty data base of knowledge:
```
    (defvar *pitch-frq-list* NIL)
    - > *PITCH-FRQ-LIST*
```

Our function will operate under dotted pairs of the form: (< note-symbol > . < octave-number >), so an a4 is of the form (a . 4). Here is a first version of our function:

(defun my-pitch (note)
   "
   returns the frequency of note
   "
  (if (assoc note *pitch-frq-list* :test 'equal)                         ;;; 1
    (rest (assoc note *pitch-frq-list* :test 'equal))                    ;;; 2
    (let* ((deg (position (first note) '(c cs d ds e f fs g gs a as b))) ;;; 3
           (oct (rest note))                                             ;;; 4
           (r (expt 2 (/ 1 12)))                                         ;;; 5
           (new (* (* 16.351596 (expt r deg)) (expt 2 oct))))            ;;; 6
      (push (cons note new) *pitch-frq-list*)                            ;;; 7
      new)))                                                             ;;; 8

Our function operates this way:
- Line 1: test if the requested note is in the *pitch-frq-list* data base.
- Line 2: if the requested note is in the data base retrieve it.
- Lines 3 to 6: if the requested note is NOT in the data base create and set the following local variables:
  - deg: degree in the chromatic scale of the note
  - oct: octave of the note
  - r: ratio between notes
  - new: the frequency of the note calculated using (c . 0) as reference frequency.
- Line 7: push the dotted pair of note and its frequency into the data base.
- Line 8: return the frequency of the note.

If we call our my-pitch function:

     (my-pitch '(c . 4))
     - > 261.62

     now if we see the state of our data base:

     *pitch-frq-list*
     - > (((C . 4) . 261.62))

     it contains the only note the function learnt.

     (my-pitch '(a . 1))
     - > 54.99

     *pitch-frq-list*
     - > (((A . 1) . 54.99) ((C . 4) . 261.62))

Now if we ask for a note that our function knows only the first line of its body gets executed. Compare the time taken by each of this expressions to execute:

     (time (dotimes (i 10) (my-pitch '(C . 4))))
     - > real time : 0.017 secs
          run time  : 0.000 secs
     (time (dotimes (i 10) (my-pitch (cons 'a i))))
     - > real time : 0.050 secs
          run time  : 0.000 secs

The second expression taught the function the frequencies of the As of 10 octaves so our data base looks like this now:

     *pitch-frq-list*
     - > (((A . 9) . 14079.998423118826) ((A . 8) . 7039.9992115594132)
           ((A . 7) . 3519.9996057797066) ((A . 6) . 1759.9998028898533)
           ((A . 5) . 879.99990144492665) ((A . 4) . 439.99995072246332)
           ((A . 3) . 219.99997536123166) ((A . 2) . 109.99998768061583)
           ((A . 0) . 27.499996920153958) ((A . 1) . 54.999993840307916)
           ((C . 4) . 261.62553600000001))

We can improve our function to take care of enharmonic notes. Again, using an a-list as a dictionary can be a good solution:

    (defvar *note-names* '((c . 0)
                       (cs . 1)(df . 1)
                       (d . 2)
                       (ds . 3)(ef . 3)
                       (e . 4)
                       (f . 5)
                       (fs . 6)(gf . 6)
                       (g . 7)
                       (gs . 8)(af . 8)
		       (a . 9)
                       (as . 10)(bf . 10)
                       (b . 11)))

The *note-names* a-list has the symbols representing the note names as keys and the degree of the notes in the chromatic scale as their associated value. If we ask for the degree of As (A sharp):
```
    (assoc 'as *note-names*)
    - > (AS . 10)
```

We can can change Line 3 of our previous code and get this new function:

(defun my-pitch (note)
   "
   returns the frequency of note
   "
  (if (assoc note *pitch-frq-list* :test 'equal)
    (rest (assoc note *pitch-frq-list* :test 'equal))      
    (let* ((deg (rest (assoc (first note) *note-names*)))     ;;; this line was changed
           (oct (rest note))
           (r (expt 2 (/ 1 12)))
           (new (* (* 16.351596 (expt r deg)) (expt 2 oct))))
      (push (cons note new) *pitch-frq-list*)
      new)))

Now we can teach our function the new values:

 (loop for i from 0 to 10 do
  (dolist (j *note-names*)
    (print (my-pitch (cons (car j) i)))))

One step ahead will be to create a new dictionary for our function, this time including symbols for 1/4 tones:

 
     (setf *note-names* '((c . 0)
                           (c+ . .5)
                           (cs . 1)(df . 1)
                           (cs+ . 1.5)(df- . 1.5)
                           (d . 2)
                           (d+ . 2.5)
                           (ds . 3)(ef . 3)
                           (ds+ . 3.5)(ef- . 3.5)
                           (e . 4)
                           (e+ . 4.5)
                           (f . 5)
                           (f+ . 5.5)
                           (fs . 6)(gf . 6)
                           (fs+ . 6.5)(gf- . 6.5)
                           (g . 7)
                           (g+ . 7.5)
                           (gs . 8)(af . 8)
                           (gs+ . 8.5)(af- . 8.5)
                           (a . 9)
                           (a+ . 9.5)
                           (as . 10)(bf . 10)
                           (as+ . 10.5)(bf- . 10.5)
                           (b . 11)
                           (b+ . 11.5)))

Without changing the code we can start training our function, calling it with the new note names:

    (my-pitch '(a+ . 4)) 

    or incorporate the new notes to our learned list using this function:

   (loop for i from 0 to 10 do
      (dolist (j *note-names*)
        (print (my-pitch (cons (car j) i)))))

Finally we can write a simple function that will take a frequency as argument and try to find that rounded frequency in the *pitch-frq-list* a-list. Note that to do this we must define our own predicate of test for rassoc:

(defun roundp (n1 n2)
  "
  predicate to test rounded numbers
  "
  (equal (round n1) (round n2)))

 here is the function:

 (defun my-note (frq)
    "
    returns the note corresponding to frq
    "
    (car (rassoc (round frq) *pitch-frq-list* :test 'roundp)))

    (my-note 440.2)
    - > (A . 4) 

    (my-note 453)
    - > (A+ . 4)
    
    (my-note 452.2)
    - > NIL

If the frequency is too far from any of the frequencies in the dictionary the function returns NIL. It would be very easy to change its code to make it return the name of the note closest to the given frequency. I leave this task to you! [Hint: you can modify the function's behavior by writing a new predicate for rassoc]

Back to LispWorkshop main page.