[CL] Hierarchy data structure

Here's what this is: It's a data structure I made up, with an implementation using hashtables. I'm not really sure what I've written here. I'd assume it's fairly useless and other data structures are more appropriate for this sort of stuff. Have fun with the code/docs.

Docs:
This program is used to create and maintain things such as
phylogenetic trees, food chains, and anything of the sort
category/item. This is done with two things: first, a link that
associates two things, and second, a rank that every item has. Higher
ranked items are "lower" than lower ranked items. Obviously, the
"root" of a categorization is said to be the zero ranked item. For
example, mammals are animals, and dog is a mammal. We might represent
this as animals -> mammals -> dog. Animals is rank 0, mammals is rank
1 and dog is rank 2. Note there is no differentation between what is
an item and what is a category; mammals are an item of animals, but a
category of dog (it happens so that dog is not a category of
anything). Moreover, a dog belongs in the canidae species. However, we
can not represent this as canidae -> dog because dog is of rank 2 and
canidae would be of rank 0. A "link" (edge in graph theory), can only
be between items whose rank differs by 1. However, canidae are
species. species -> canidae -> dog is fine. Then we can ask questions
(in the form of function calls) such as:

- is dog a canidae? yes
- what makes dog an animals? mammals
- what things are mammals? (this question can be asked for direct links
or everything that falls under that category. The answer to the first
would be canidae and the other canidae, dog. In general, you can ask
for anything that is above or below your item/category, and you can
ask for a deep or shallow answer).
- what rank is animals? 0

This would look like (I have called it a hierarchy)

hierarchy rank
---------------------- ----
animals species 0
| |
canidae mammals 1
\ /
dog 2
Technically, this differs from graphs quite a lot, in implementation
and functionality. Graphs use pointers for links. This is done with a
hashtable where each key-value pair is:
- key is the symbol name used for the category/item
- value is a CONS (a pair) of the rank of the item and a list of items
connected to it (there is no need to maintain two lists for items
above and below the item; you can look for items with rank n-1 or n+1
accordingly). Whenever an item is linked to another, each items name
is appended to each other items list of items. You can load
hierarchies from sexps and save them to sexps. A sexp hierarchy of the
above looks like:
(animals species
(animals canidae)
(species mammals)
(canidae dog)
(mammals dog))
Another example to grasp this:
A -> B -> C
\-> D -> E

F -> G -> H
\-> I
Would be

(a f
(a b d)
(b c)
(d e)
(f g)
(g h i))
In a sense, the members in the sexp list are:

In case of atoms, they're 0 ranked items
In case of lists, the CAR is the item for which all CDR items are linked to.

notice, the CAR must already be 'defined'. You can not have a hierarchy sexp as

(a (b c))
because b hasn't been mentioned earlier in the sexp and it didn't get
a rank (so c can't get a rank either). Everything we've said so far
can be done with this code:

(with-hierarchy
(animals species
(animals canidae)
(species mammals)
(canidae dog)
(mammals dog))
(format t "is dog a canidae? ~A~%" (belongs 'dog 'canidae))
(format t "what things are mammals? ~A~%" (all-below '(mammals)))
(format t "what rank is animals? ~A~%" (rank 'animals)))
The function BELONGS would tell us whether an item is under some a
category. A dog is a canidae, it is also a canis-familiaris, a species
and an 'animals'. ALL-BELOW returns a list of all the items that
belong under the given category(-ies). RANK is self-explanatory. The
macro WITH-HIERARCHY takes two arguments, either a sexp hierarchy or a
variable holding a sexp hierarchy and a body of expressions to
evaluate within that created hierarchy context.

Code:

(defmacro with-hierarchy (hierarchy &body body)
"evaluate body with hierarchy loaded and bound on *hierarchy*"
`(let ((*hierarchy* (make-hash-table)))
(declare (special *hierarchy*))
(progn
,(when hierarchy
(if (listp hierarchy)
`(load-hierarchy ',hierarchy)
`(load-hierarchy ,hierarchy)))
,@body)))

(defun all-below (&optional (list (first-row)))
"Return everything that x includes"
(loop for root = list then row
for row = (next-row root)
until (null row) append row))

(defun all-above (list)
"Return everything that members of list are included in"
(loop for root = list then row
for row = (prev-row root)
until (null row) append row))

(defun first-row ()
"Return all items with rank 0"
(declare (special *hierarchy*))
(loop for value being the hash-values of *hierarchy*
using (hash-key key)
when (zerop (rank key)) collecting key into first-row
finally (return first-row)))

(defun prev-row (row)
"Return the previous list of item linked to members in row
(obviously with rank n - 1)"
(declare (special *hierarchy*))
(reduce #'union row :key #'above))

(defun next-row (row)
"Return the next list of items linked to members in row
(obviously with rank n + 1)"
(declare (special *hierarchy*))
(reduce #'union row :key #'below))

(defun load-hierarchy (hierarchy)
"Parse the hierarchy sexp"
(mapcar (lambda (x)
(if (atom x)
(make-link x 0)
(mapcar (lambda (y)
(add-link y (car x)))
(cdr x))))
hierarchy))

(defun save-hierarchy ()
"Return a sexp that can be parsed"
(declare (special *hierarchy*))
(loop for value being the hash-values of *hierarchy*
using (hash-key key)
for below = (below key)
when (zerop (rank key)) collecting key into roots
when below collecting (cons key below) into rest
finally (return
(append roots
(sort rest
(lambda (x y) (< (rank x) (rank y)))
:key #'car)))))

(defun make-link (link rank)
"Create a link"
(declare (special *hierarchy*))
(setf (gethash link *hierarchy*)
(cons nil rank))
link)

(defun add-link (x y)
"Add a link from y to x"
(let ((y-rank (rank y)))
(if (exists x)
(when (= 1 (- (rank x) y-rank))
(push x (links y))
(push y (links x))
x)
(add-link (make-link x (1+ y-rank)) y))))

(defun belongs (x y)
"Does x belong in category y?"
(when (every #'exists (list x y))
(let ((rank-diff (- (rank x) (rank y))))
(cond ((= rank-diff 1)
(some (lambda (x) (eq x y))
(above x)))
((> rank-diff 1)
(some (lambda (x)
(belongs x y))
(above x)))
(t nil)))))

(defun exists (x)
"Does x exist in hierarchy?"
(declare (special *hierarchy*))
(nth-value 1 (gethash x *hierarchy*)))

(defun (setf links) (y x)
(declare (special *hierarchy*))
(setf (car (gethash x *hierarchy*)) y))

(defun links (x)
"All links from/to x"
(declare (special *hierarchy*))
(car (gethash x *hierarchy*)))

(defun below (x)
"All links below x"
(let ((x-rank (rank x)))
(remove-if (lambda (y)
(< (rank y) x-rank))
(links x))))

(defun above (x)
"All links above x"
(let ((x-rank (rank x)))
(remove-if (lambda (y)
(> (rank y) x-rank))
(links x))))

(defun rank (x)
"The rank of x (steps away from root, with root being 0)"
(declare (special *hierarchy*))
(cdr (gethash x *hierarchy*)))


;; example

(defun test-example ()
(with-hierarchy *test*
(format t "rank of dog: ~A~%" (rank 'dog))
(format t "what is a dog? ~A~%" (all-above '(dog)))
(format t "does canis-lupus belong in animals? ~A~%"
(belongs 'canis-lupus 'animals))
(format t "does wolf belong in books? ~A~%"
(belongs 'wolf 'books))
(save-hierarchy)))


(defparameter *test*
'(animals
(animals canidae)
(canidae canis-lupus canis-familiaris)
(canis-lupus wolf)
(canis-familiaris dog)
books
(books anna-karenina war-and-peace)))

(defparameter *phylogenetic-tree*
'(luca
(luca chlorobacteria hadobacteria
cyanobacteria gracilicutes eurybacteria)
(eurybacteria endobacteria actinobacteria)
(actinobacteria neomura)
(neomura archaea eukarya)))

with an implementation using hashtables

I hate hash and hashtables

(Post truncated)

Geez, I wonder what the rest of this post says

I wrote this code years ago, and now I'm going WTF when I look at some portions of it:
(if (listp hierarchy)
`(load-hierarchy ',hierarchy)
`(load-hierarchy ,hierarchy)))

What in the world is going on here...

>>3
It's LITHP, baby. And it rocks to hell and back baby, hallelujah! Fuck you if yuo don't like LITH!P

>>4
Actually the moment I posted >>3 I realized what the code does. LOAD-HIERARCHY takes a sexp, which may be an ATOM or a LIST. An ATOM is dumped as-is while the LIST is dumped without being evaluated. It's not really as cryptic as I first thought.

Btw, no comments?

>>5
You're code has been carefully observed and may inspire code writings of my own. However, I have no comment.

>>1
i think you made a little error in the hierarchy diagram (species - mammals - dog)?
First time i've seen a lisp loop though, so you must be pretty expert =)

Could even merge, since all canidae are likely mammals?
animals - mammals - canidae - dog - (breeds?)