Ticket #1185: 0001-Fix-1185-Normalize-DAG-passed-to-topological-sort-so.patch

File 0001-Fix-1185-Normalize-DAG-passed-to-topological-sort-so.patch, 1.7 KB (added by Moritz Heidkamp, 11 years ago)

Here's the patch implementing option 3 as discussed on IRC.

  • data-structures.scm 

    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  
    753753                            #f
    754754                            (cons edge path)
    755755                            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)
    757768             (state (cons (list) (list))))
    758769    (if (null? dag)
    759770        (cdr state)

  • tests/data-structures-tests.scm 

    diff --git a/tests/data-structures-tests.scm b/tests/data-structures-tests.scm
index 51c25a9..461b1cf 100644
    a b  
    6161
    6262(assert (equal? '() (topological-sort '() eq?)))
    6363(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?)))
    6565(assert-error (topological-sort '((a b) (b a)) eq?))
    6666
    6767;; Queues.