DouKaku?

; 親子ペア定義
(setf pair-lst '((a b)
                 (b c)
                 (c d)
                 (c e)
                 (a f)
                 (d x)
                 (y z)
                 (z c)
                 ))

;; 同一の親を持つペアをマージする
;; ex) ((p1 c1) (p1 c2) (p2 c3) (p2 c4)) -> ((p1 c1 c2) (p2 c3 c4))
(defun gen-fmly-lst (plst)
  (defun merge-lst (frst rst)
    (if (null rst)
      frst
      (if (eq (car frst) (caar rst))
        (merge-lst (append frst (cdar rst)) (cdr rst))
        (merge-lst frst (cdr rst)))))
  (labels ((rec (lst acc)
                (if (null lst)
                  acc
                  (if (member (caar lst) acc :key #'car)
                    (rec (cdr lst) acc)
                    (rec (cdr lst) (cons (merge-lst (car lst) (cdr lst)) acc))))))
    (rec plst nil)))

;; fmlyのリストからツリーを生成する
(defun gen-fmly-tr (fmly-lst)
  (labels ((rec (flst acc)
                (if (null flst)
                  acc
                  ; hook前のfmlyをhook後のfmly(n次元リスト)に置き換えて処理をする
                  (let* ((nD-fmly (car (member (caar flst) acc :key #'car)))
                         (othr (other nD-fmly acc)))
                    ; fmlyをhook処理し、一箇所もhookできなかったらfmlyをそのままaccに加える
                    (if (equal othr (hook nD-fmly othr))
                      (rec (cdr flst) (cons nD-fmly othr))
                      (rec (cdr flst) (hook nD-fmly othr)))))))
    (rec fmly-lst fmly-lst)))

;; リストからobjを除いたリストを取得する
(defmacro other (obj lst)
  `(remove-if #'(lambda (x) (equal ,obj x)) ,lst))

;; リストのcarと一致するatomをツリーの中で見つけた場合、該当atomをリストで置き換える
;; ex) (hook '(a x) '(a (b a) (c (d a)))) -> ((a x) (b (a x)) (c (d (a x))))
(defun hook (lst tree)
  (cond ((eq (car lst) tree) lst)
        ((atom tree) tree)
        (t (cons (hook lst (car tree))
                 (hook lst (cdr tree))))))

(defun main ()
  (gen-fmly-tr (gen-fmly-lst pair-lst)))
; 実行すると、下記の構造が得られる
; ((A (B (C (D X) E)) F) (Y (Z (C (D X) E))))
; インデントすると
;((A
;   (B
;     (C
;       (D
;         X)
;       E))
;   F)
; (Y
;   (Z
;     (C
;       (D
;         X)
;        E)))
; )

class Node:
    def __init__(self, name):
        self.name = name
        self.parent = None
        self.children = []

def pairs_to_trees(pairs):
    nodes = {}
    for parent_name, child_name in pairs:
        parent = nodes.setdefault(parent_name, Node(parent_name))
        child  = nodes.setdefault(child_name,  Node(child_name))
        child.parent = parent
        parent.children.append(child)
    return [node for node in nodes.itervalues() if node.parent is None]

def show(node, depth):
    if depth == 0:
        print node.name
    else:
        print "  " * (depth - 1) + "->" + node.name
    for child in node.children:
        show(child, depth + 1)

def main():
    pairs = [
        ('A', 'B'),
        ('B', 'C'),
        ('C', 'D'),
        ('C', 'E'),
        ('A', 'F'),
        ('D', 'X'),
        ('Y', 'Z'),
        ('Z', 'C'),
    ]

    for tree in pairs_to_trees(pairs):
        show(tree, 0)

if __name__ == '__main__':
    main()

(setf pair-lst '((a  b)
                 (b  c)
                 (c  d)
                 (c  e)
                 (a  f)
                 (d  x)
                 (y  z)
                 (z  c) ))

(defun gen-family-relation (list env)
  (let ( node result )
    (dolist (x list result)
        (setf node (assoc (car x) env))
        (if node
            (setf (cdr node) (append (cdr node) (cdr x)))
            (push x env) )
        (setf result env) )))

(defun query (s env)
  (let ((node (assoc s env)))
    (if node
        (cons (car node)(mapcar #'(lambda (x)(query x env)) (cdr node)))
        s)))

(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))))

var cache = {};
var family = {};

function add(parent, child){
    var p,c;
    if(parent in cache){
        p = cache[parent];
    } else { //初めての名前
        p = family[parent] = { name : parent };
        cache[parent] = p;
    }
    if(child in cache){
        p[child] = cache[child];
    } else { //初めての名前
        c = p[child] = { name : child };
        cache[child] = c;
    }
}

family_toString.tab = "  ";

function family_toString(f, tab){
    var result = "";

    if(tab == null) tab = -1;

    var indent = arguments.callee.tab.x(tab);

    for( x in f){
        if(x == "name") continue;
        else{
            result += indent + (tab < 0 ? "" : "->") + f[x].name + "\n";
            result += family_toString(f[x], tab+1);
        }
    }
    return result;
}

if(!String.prototype.x){
    String.prototype.x = function(n){
        var result="", i;
        for(i=0;i<n;i++){
            result += this;
        }
        return result;
    }
}

if(child in family){
    delete family[child];
}