From b18962b0ff7e7009c9350ebca87c8a1b71bf6dfd Mon Sep 17 00:00:00 2001
From: Moritz Heidkamp <moritz.heidkamp@bevuta.com>
Date: Mon, 13 Apr 2015 23:18:12 +0200
Subject: [PATCH] Fix #1185: Normalize DAG passed to topological-sort so that
edges of duplicate nodes are merged
---
data-structures.scm | 13 ++++++++++++-
tests/data-structures-tests.scm | 2 +-
2 files changed, 13 insertions(+), 2 deletions(-)
diff --git a/data-structures.scm b/data-structures.scm
index 511a3c1..a424c8e 100644
a
|
b
|
|
753 | 753 | #f |
754 | 754 | (cons edge path) |
755 | 755 | state)))))))) |
756 | | (let loop ((dag dag) |
| 756 | |
| 757 | (define normalized-dag |
| 758 | (foldl (lambda (result node) |
| 759 | (alist-update! (car node) |
| 760 | (append (cdr node) |
| 761 | (or (alist-ref (car node) dag pred) '())) |
| 762 | result |
| 763 | pred)) |
| 764 | '() |
| 765 | dag)) |
| 766 | |
| 767 | (let loop ((dag normalized-dag) |
757 | 768 | (state (cons (list) (list)))) |
758 | 769 | (if (null? dag) |
759 | 770 | (cdr state) |
diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index 51c25a9..461b1cf 100644
a
|
b
|
|
61 | 61 | |
62 | 62 | (assert (equal? '() (topological-sort '() eq?))) |
63 | 63 | (assert (equal? '(a b c d) (topological-sort '((a b) (b c) (c d)) eq?))) |
64 | | (assert (equal? '(c d a b) (topological-sort '((a b) (c d)) eq?))) |
| 64 | (assert (equal? '(c d a b) (topological-sort '((c d) (a b)) eq?))) |
65 | 65 | (assert-error (topological-sort '((a b) (b a)) eq?)) |
66 | 66 | |
67 | 67 | ;; Queues. |