@鸡蛋小哥
代码如下（等级不够不能上传啊..）
;r: result
;g: graph
;v: vertice
;p: path(length)
;plist: pair-list
;vp-plist: vertice-path-pair-list
;to-list: total-ordering-list
(define call/cc call-with-current-continuation)
(define topsort
(lambda (g)
(call/cc
(lambda (k)
(let ((t (top-vertice g)))
(if (not (= (length t) 1))
(k 'cyclic))
(let ((v (car t)))
(vp-plist->to-list (graph->vp-plist g v k))))))))
(define remove
(lambda (x ls)
(if (null? ls)
'()
(if (eqv? x (car ls))
(remove x (cdr ls))
(cons (car ls) (remove x (cdr ls)))))))
(define exist
(lambda (x ls)
(cond ((null? ls) #f)
((eqv? x (car ls)) #t)
(else (exist x (cdr ls))))))
(define sort
(lambda (ls)
(if (null? ls)
'()
(let ((t (apply max ls)))
(append (sort (remove t ls)) (list t))))))
(define pl-constructor
(lambda (keys default-value)
(map (lambda (x) (cons x default-value)) keys)))
(define pl-selector
(lambda (select-func ls)
(map (lambda (x) (select-func x)) ls)))
(define vertice
(lambda (g)
(pl-selector car g)))
(define top-vertice
(lambda (g)
(define v (vertice g))
(for-each
(lambda (x)
(for-each
(lambda (x)
(set! v (remove x v)))
(cdr x)))
g)
v))
(define graph->vp-list
(lambda (g v k)
(define result (pl-constructor (vertice g) 0))
(define update
(lambda (val key)
(let ((t (assq key result)))
(if (> val (cdr t))
(set-cdr! t val)))))
(let f ((cur v)
(path '()))
(if (exist cur path)
(k 'cyclic))
(update (length path) cur)
(for-each (lambda (x) (f x (cons cur path))) (cdr (assq cur g))))
result))
(define vp-plist->to-list
(lambda (pl)
(define temp (pl-constructor (map cdr pl) '()))
(define result '())
(for-each
(lambda (x)
(let ((t (assq (cdr x) temp)))
(set-cdr! t (append (cdr t) (list (car x))))))
pl)
(for-each (lambda (x) (set! result (append result (cdr (assq x temp))))) (sort (map car temp)))
result))
;(define g0 '((a b b e) (c) (b c) (d a b) (e d f) (f d)))
;(topsort g0)