1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
(defpackage :dokaku178
  (:use :common-lisp))
(in-package :dokaku178)

(defvar *population* (make-hash-table))
(defstruct tree
   id children parents)

(defun get-node (key)
  (multiple-value-bind (hash-value flag) (gethash key *population*)
    (if (null flag)
    (setf (gethash key *population*) (make-tree :id key
                          :parents nil
                          :children nil))
    hash-value)))

(defun set-node (pair-list)
  (let* ((parent (car pair-list))
     (child (cdr pair-list))
     (parent-node (get-node parent))
     (child-node (get-node child)))
    (pushnew parent (tree-parents child-node))
    (pushnew child (tree-children parent-node))))

(defun get-origins ()
  (let ((origins nil))
    (maphash #'(lambda(k v)
         (if (null (tree-parents v))
             (pushnew k origins))) *population*)
    origins))

(defun print-tree (id)
  (let ((id (gethash id *population*)))
    (format t "~a => ~a => ~a ~%"  (tree-parents id)
                               (tree-id id)
                   (tree-children id))))

(defun main()     
  (let ((pair-lst
     '((a . b)(b . c)(c . d)(c . e)
       (a . f)(d . x)(y . z)(z . c))))
    (loop for n in pair-lst do
     (set-node n))))