Changeset 15920 in project for chicken


Ignore:
Timestamp:
09/16/09 13:16:32 (10 years ago)
Author:
iraikov
Message:

including topological-sort in the prerelease branch

Location:
chicken/branches/prerelease
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • chicken/branches/prerelease/data-structures.import.scm

    r13240 r15920  
    7575   sort!
    7676   sorted?
     77   topological-sort
    7778   string-chomp
    7879   string-chop
  • chicken/branches/prerelease/data-structures.scm

    r13859 r15920  
    781781
    782782
     783;;;  Simple topological sort:
     784;
     785; Taken from SLIB (slightly adapted): Copyright (C) 1995 Mikael Djurfeldt
     786
     787(define (topological-sort dag pred)
     788  (if (null? dag)
     789      '()
     790      (let* ((adj-table '())
     791             (sorted '()))
     792
     793        (define (insert x y)
     794          (let loop ([at adj-table])
     795            (cond [(null? at) (set! adj-table (cons (cons x y) adj-table))]
     796                  [(pred x (caar at)) (set-cdr! (car at) y)]
     797                  [else (loop (cdr at))] ) ) )
     798       
     799        (define (lookup x)
     800          (let loop ([at adj-table])
     801            (cond [(null? at) #f]
     802                  [(pred x (caar at)) (cdar at)]
     803                  [else (loop (cdr at))] ) ) )
     804       
     805        (define (visit u adj-list)
     806          ;; Color vertex u
     807          (insert u 'colored)
     808          ;; Visit uncolored vertices which u connects to
     809          (for-each (lambda (v)
     810                      (let ((val (lookup v)))
     811                        (if (not (eq? val 'colored))
     812                            (visit v (or val '())))))
     813                    adj-list)
     814          ;; Since all vertices downstream u are visited
     815          ;; by now, we can safely put u on the output list
     816          (set! sorted (cons u sorted)) )
     817       
     818        ;; Hash adjacency lists
     819        (for-each (lambda (def) (insert (car def) (cdr def)))
     820                  (cdr dag))
     821        ;; Visit vertices
     822        (visit (caar dag) (cdar dag))
     823        (for-each (lambda (def)
     824                    (let ((val (lookup (car def))))
     825                      (if (not (eq? val 'colored))
     826                          (visit (car def) (cdr def)))))
     827                  (cdr dag))
     828        sorted) ) )
     829
     830
    783831;;; Binary search:
    784832
  • chicken/branches/prerelease/distribution/manifest

  • chicken/branches/prerelease/support.scm

    r15844 r15920  
    11271127
    11281128
    1129 ;;; Simple topological sort:
    1130 ;
    1131 ; - Taken from SLIB (slightly adapted): Copyright (C) 1995 Mikael Djurfeldt
    1132 
    1133 (define (topological-sort dag pred)
    1134   (if (null? dag)
    1135       '()
    1136       (let* ((adj-table '())
    1137              (sorted '()))
    1138 
    1139         (define (insert x y)
    1140           (let loop ([at adj-table])
    1141             (cond [(null? at) (set! adj-table (cons (cons x y) adj-table))]
    1142                   [(pred x (caar at)) (set-cdr! (car at) y)]
    1143                   [else (loop (cdr at))] ) ) )
    1144        
    1145         (define (lookup x)
    1146           (let loop ([at adj-table])
    1147             (cond [(null? at) #f]
    1148                   [(pred x (caar at)) (cdar at)]
    1149                   [else (loop (cdr at))] ) ) )
    1150        
    1151         (define (visit u adj-list)
    1152           ;; Color vertex u
    1153           (insert u 'colored)
    1154           ;; Visit uncolored vertices which u connects to
    1155           (for-each (lambda (v)
    1156                       (let ((val (lookup v)))
    1157                         (if (not (eq? val 'colored))
    1158                             (visit v (or val '())))))
    1159                     adj-list)
    1160           ;; Since all vertices downstream u are visited
    1161           ;; by now, we can safely put u on the output list
    1162           (set! sorted (cons u sorted)) )
    1163        
    1164         ;; Hash adjacency lists
    1165         (for-each (lambda (def) (insert (car def) (cdr def)))
    1166                   (cdr dag))
    1167         ;; Visit vertices
    1168         (visit (caar dag) (cdar dag))
    1169         (for-each (lambda (def)
    1170                     (let ((val (lookup (car def))))
    1171                       (if (not (eq? val 'colored))
    1172                           (visit (car def) (cdr def)))))
    1173                   (cdr dag))
    1174         sorted) ) )
    1175 
    1176 
    11771129;;; Some pathname operations:
    11781130
  • chicken/branches/prerelease/types.db

    r15844 r15920  
    452452(sort! (procedure sort! ((or list vector) (procedure (* *) *)) (or list vector)))
    453453(sorted? (procedure sorted? ((or list vector) (procedure (* *) *)) boolean))
     454(topological-sort (procedure topological-sort (list (procedure (* *) *)) list))
    454455(string-chomp (procedure string-chomp (string #!optional string) string))
    455456(string-chop (procedure string-chop (string fixnum) list))
Note: See TracChangeset for help on using the changeset viewer.