Genealogy with Rackett

I’ve been learning Racket lately, and having a great time of it — inspired, among other things, by Alexis King’s talks on Hackett — A Metaprogrammable Haskell Written in Racket. As an experiment, I decided to see if I could write little genealogy program that extracts an ancestor from a tree of ancestors given a lineage, e.g. ,(f f f) for “father’s father’s father” and (m f m) for “mother’s father’s mother.”

For the code below, you will need to know how to extract heads and tails from lists and combine these to good effect:

> (define a '(1 2 3 4))
> (car a)
1
> (cdr a)
'(2 3 4)
> (car (cdr a))
2
> (cadr a)
2

You get the idea. Thus (caddr a), which is really (car (cdr (cdr a))) is 3. Let’s begin the real work with an imaginary family which we can use for testing:

(define family
  '("Thomas: 1949"
      ("Harold: 1922"
          ("James: 1897" ("George: 1887") ("Elizabeth 1885"))
          ("Violet 1900" ("Morris: 1877") ("Maude: 1889"))
      )
      ("Mary: 1925"
          ("Aaron: 1886" ("Zvi: 1860") ("Rebecca: 1863"))
          ("Susan 1894" ("Jonathan: 1855") ("Fidelity: 1860"))
      )
  ))

The next step is to define a small set of primitives: one function to return the left child tree of a given node, and one function to return the right child tree:

(define (left-child-tree tree) (cadr tree))
(define (right-child-tree tree) (caddr tree))

Let’s check that it works:

> (left-child-tree family)
     '("Harold: 1922" 
        ("James: 1897" ("George: 1887")("Elizabeth 1885")) 
        ("Violet 1900" ("Morris: 1877") ("Maude: 1889")))
> (right-child-tree (left-child-tree family))
    '("Violet 1900" ("Morris: 1877") ("Maude: 1889"))
> (right-child-tree (right-child-tree (left-child-tree family)))
    '("Maude: 1889")

The correct subtree is returned, and composing primitives works as intended. For later use, let’s introduce some abbreviations:

(define m right-child-tree)  ; mother's tree
(define f left-child-tree)   ; father's tree

Recall the goal: to compute ancestors by giving a lineage, e.g., m f m for “mother’s paternal grandmother.”

> (ancestor '(f f) family)     ; paternal grandfather
"James: 1897"
> (ancestor '(m f m) family)   ; mother's paternal grandmother
"Rebecca: 1863"

To do this, we need a function apply-nested that takes a quoted list of functions as first argument, then applies them in reverse order to the second argument, as indicated in the example below.

> (define (g x) (* 2 x))
> (define (h x) (+ x 1))
> (define (k x) (* x x))
> (h (g (k 2)))
9
> (apply-nested '(k g h) 2)
9

The apply-nested function is defined using recursion and eval:

(define (apply-nested functions arg)
    (if (null? functions)
        arg
        (apply-nested (cdr functions) ((eval (car functions)) arg)))

Now the ancestor function is easy to write: run apply-nested, then extract the top node of the resulting tree using car:

(define (ancestor lineage tree)
   (car
    (apply-nested lineage tree)))

All done!