cl-genealogy/cl-genealogy.org

Common Lisp Genealogical Database Manager

Introduction   nonum

TOC   ignoreheading

Data Storage

One of the key components of genealogical software is the ability to effectively store information related to members of a family. This will include things such as people, birth records, death records, marriage records, divorce records and notes.

To accomplish the storage of this information, I'm using a schema-less relational database management system called LambdaLite, which is written entirely in lisp, and uses the local file system to store data effectively.

Macros

To accomplish the goal of storing data within the database system that is LambdaLite, I need to be able to constrain various attributes to be certain values. To do this, instead of having to manually write code to constrain them each time, I use a few macros to do this. These macros include:

constrain-values

Constrains to be one of several values. This macro takes one or more arguments, and generates a function that checks to see if the argument passed to it is in any of the given values.

in-table-column

Checks to see if the value is one of the values in a specific column. This macro takes two arguments, a table name and a column name, then generates a function which will calculate all possible values, iterating for each row in the table, getting the values in the specified column, and then testing the value passed to the function to see if it is a member of the possible values.

ids-in-table-column

Checks to see if this is one of the possible IDs in a table column. This is done through the same mechanism as in-table-column, but simply ensuring that the passed object is a) a list, and b) the elements in the list are mapped through the in-table-column result, with the values of a and be being reduced using and to produce a single boolean.

unique-in-column

This checks to see whether or not the passed value is within the specified column, ensuring that it is not within it. This function takes three things, a table, a column and a type. It first ensures that the passed object is of the specified type, and if it is, calculates all values currently in the specified table and column, and then checks to see that the passed object is not within the list.

  (defmacro constrain-values (&rest values)
    `(lambda (object)
       (the boolean
            (member object (list ,@values)))))

  (defmacro in-table-column (table column)
    `(lambda (object)
       (let ((possible-values (iter
                                (for row in (select ,table))
                                (collect (,column row)))))
         (the boolean (member object possible-values)))))

  (defmacro ids-in-table-column (table column)
    `(lambda (object)
       (let ((possible-values (iter
                                (for row in (select ,table))
                                (collect (,column row)))))
         (and (listp object)
            (reduce #'and (map 'list ,(in-table-column table column)
                             object))))))

  (defmacro unique-in-column (table column type)
    `(lambda (object)
       (if (typep object ',type)
           (let ((possible-values (iter
                                    (for row in (select ,table))
                                    (collect (,column row)))))
             (not (the boolean (member object possible-values)))))))

  (defun generate-table-id (table)
    (check-type table keyword)
    (1+ (length (select table))))

People

This is the People table, used to store the most bare information about a person. This includes the following:

ID

The ID used to identify the person within the database.

Name

The name of the person.

Gender

The gender of the person. Can be one of:

• M

• F

• T

Father

The person's father. This is either an person ID, or 0 if we don't know who the father is.

Mother

The person's mother. As with father, this can be either a person ID or 0.

  (defattributes
    :/person-id (unique-in-column :people :/person-id integer)
    :/person-name #'stringp
    :/gender (constrain-values "M" "F" "T")
    :/father (lambda (object)
               (or (= 0 object)
                  (funcall (in-table-column :people :/person-id) object)))
    :/mother (lambda (object)
               (or (= 0 object)
                  (funcall (in-table-column :people :/person-id) object))))

Births

Another important thing is to be able to log births, or possible birth dates. To do this, you need four pieces of information:

Birth ID

The ID used to reference the person's birth.

Person

The ID of the person born.

Birth Date

When the person was born.

Birth Location

Where the person was born.

  (defattributes
    :/birth-id (unique-in-column :births :/birth-id integer)
    :/birth-person (in-table-column :people :/person-id)
    :/birth-date #'stringp
    :/birth-location #'stringp)

Deaths

Furthermore, to be as complete as possible, you need to be able to store and query death information. This includes things such as:

Death ID

The ID used to track this death record.

Person

The ID of the person who died.

Date

When the person died.

Location

Where the person died.

  (defattributes
    :/death-id (unique-in-column :deaths :/death-id integer)
    :/death-person (in-table-column :people :/person-id)
    :/death-date #'stringp
    :/death-location #'stringp)

Marriages

Further, to be able to keep track of relationships (and thus families), you need to be able to track marriages. This entails keeping track of the following information:

Marriage ID

ID used to track the marriage within this system.

Husband

ID of the husband in the marriage.

Wife

ID of the wife in the marriage.

Wedding Date

Date the marriage was considered to have started.

End Date

Date the marriage ended (Divorce, death, annulment).

  (defattributes
    :/marriage-id (unique-in-column :marriages :/marriage-id integer)
    :/husband (in-table-column :people :/person-id)
    :/wife (in-table-column :people :/person-id)
    :/wedding-date #'stringp
    :/end-date #'stringp)

Divorces

To keep track of the dissolution of marriages, and to enable correct report generation, we must keep track of divorces. To do this, we store the following information:

Divorce ID

How the divorce is referred to within the database.

Marriage

The ID of the marriage the divorce terminates

Divorce Date

The date the Divorce is effective.

  (defattributes
    :/divorce-id (unique-in-column :divorces :/divorce-id integer)
    :/marriage (in-table-column :marriages :/marriage-id)
    :/divorce-date #'stringp)

Notes

Keeping notes within the database is a good idea, it allows the notes to be linked directly to the relevant data, and can help to keep organized. To store a note, you need the following pieces of data:

Note ID

The ID used to reference the note.

Title

The title of the note.

Text

The text of the note, formatted using markdown.

Media Link

An optional link to a media file, such as an image or oral history.

  (defattributes
      :/note-id (unique-in-column :notes :/note-id integer)
    :/note-title #'stringp
    :/note-text #'stringp
    :/media-link #'stringp)

Common Attributes

As LambdaLite is schemaless, the following attributes can be mixed in to other tables, and can be used to help link records quickly and easily.

Person

The ID of a relevant Person.

Birth

The ID of a relevant Birth.

Death

The ID of a relevant Death.

Marriage

The ID of a relevant Marriage.

Divorce

The ID of a relevant Divorce.

  (defattributes
      :/person (in-table-column :people :/person-id)
    :/birth (in-table-column :births :/birth-id)
    :/death (in-table-column :deaths :/death-id)
    :/marriage (in-table-column :marriages :/marriage-id)
    :/divorce (in-table-column :divorces :/divorce-id))

WORKING Data Interface [0/10]

Create Person

Create Birth

Create Death

Create Marriages

Create Divorce

Get Person

Get Birth

Get Death

Get Mariage

Get Divorce

WORKING Family Tree Display [0/5]

Generate Person Nodes

Generate Marriage Nodes

Generate Edges Between People

Generate Edges Between Marriages

Generate Final Family Tree

WORKING Ahnentafel Generation [0/3]

Numbering

  (defun generate-ahnentafel-numbers (starting-person number-of-generations)
    (let ((ahnentafel-list (cons (cons 1 starting-person) nil)))
      (labels ((generate-number (current gender)
                 (if (string= gender "M")
                     (* 2 current)
                     (1+ (* 2 current))))
               (recurse (person number generation gender)
                 (if (not (= generation 0))
                     (let ((new-number (generate-number number gender))
                           (father (:/father person))
                           (mother (:/mother person)))
                       (push (cons new-number person) ahnentafel-list)
                       (if (not (= 0 father))
                           (recurse father new-number (1- generation) "M"))
                       (if (not (= 0 mother))
                           (recurse mother new-number (1- generation) "F"))))))
        (recurse (:/father starting-person) 1 (1- number-of-generations) "M")
        (recurse (:/mother starting-person) 1 (1- number-of-generations) "F"))
      ahnentafel-list))

Formatting

  (defun format-ahnentafel-record (record)
    (destructuring-bind (number . person) record
      (let ((name (:/person-name (get-person person)))
            (birthdate (:/birth-date (get-birth person)))
            (death (let ((death-record (get-death person)))
                     (if (null death-record)
                         ""
                         (format nil " -- ~a" (:/death-date death-record))))))
        (format nil "~10,5R: ~A, ~A~A" number name birthdate death)))))

Final Output

  (defun output-ahnentafel (file start-person total-generations)
    (let ((ahnentafel-text (map 'list
                             #'format-ahnentafel-record
                             (sort (generate-ahnentafel-numbers
                                    start-person
                                    total-generations)
                                   #'<
                                   :key #'car))))
      (with-open-file (output file
                              :direction :output
                              :if-exists :output
                              :if-does-not-exist :create)
        (map 'list #'(lambda (line)
                       (format output "~A~&" line))
             ahnentafel-text))))

WORKING GEDCOM Handling [0/5]

Grammar

Parser

Cross-Reference Resolver

Convert To Native Format

Export to GEDCOM

Configuration File Parsing

WORKING Packaging [0/6]

  (defpackage #:config-parser
    (:use :esrap
          :cl)
    (:import-from #:parse-number
                  #:parse-number)
    (:export open-configuration-file))

  (defpackage #:cl-genealogy
    (:use #:cl
          #:lambdalite
          #:iterate
          #:archive)
    (:export generate-graph
             print-ahnentafel
             database
             new-person
             new-death
             new-marriage
             new-divorce))

Data Storage

Data Interface

Family Tree

Ahnentafel

Gedcom Parsing

ASDF

  (asdf:defsystem #:cl-genealogy
    :description "Describe genie here"
    :author "Samuel Flint <swflint@lisp.technology>"
    :license "GNU GPLv3 or Later"
    :depends-on (#:cl-utilities
                 #:esrap
                 #:parse-number
                 #:lambdalite
                 #:iterate
                 #:archive)
    :serial t
    :components ((:file "package")
                 (:file "database")
                 (:file "family-tree")
                 (:file "ahnentafel")))

Push To Bottom   ignoreheading

Version Information   nonum

This document, and the code, forming the cl-genealogy package is version src_sh{git describe –always –long –dirty –abbrev=10 –tags}