don't include the *-node in the topological-sort output
svn: r14835 original commit: 8e79a2aed5289f12bc9a111ab50e5a66ab9b24fd
This commit is contained in:
parent
2ac42691a8
commit
dffc446fc5
|
@ -78,10 +78,8 @@
|
||||||
(set-node-total! *-node total-time)
|
(set-node-total! *-node total-time)
|
||||||
;; convert the nodes from the hash to a list, do a topological sort, and then
|
;; convert the nodes from the hash to a list, do a topological sort, and then
|
||||||
;; sort by total time (combining both guarantees(?) sensible order)
|
;; sort by total time (combining both guarantees(?) sensible order)
|
||||||
(let* ([nodes (topological-sort *-node)]
|
(let ([nodes (append-map (lambda (nodes) (sort nodes > #:key node-total))
|
||||||
[nodes (append-map (lambda (nodes) (sort nodes > #:key node-total))
|
(topological-sort *-node))])
|
||||||
nodes)]
|
|
||||||
[nodes (remq *-node nodes)])
|
|
||||||
;; sort all the edges in the nodes according to total time
|
;; sort all the edges in the nodes according to total time
|
||||||
(for ([n (in-list nodes)])
|
(for ([n (in-list nodes)])
|
||||||
(set-node-callees! n (sort (node-callees n) > #:key edge-callee-time))
|
(set-node-callees! n (sort (node-callees n) > #:key edge-callee-time))
|
||||||
|
|
|
@ -48,12 +48,13 @@
|
||||||
[(zero? total-time) (profile-nodes profile)]
|
[(zero? total-time) (profile-nodes profile)]
|
||||||
[else (filter hide? (profile-nodes profile))]))
|
[else (filter hide? (profile-nodes profile))]))
|
||||||
|
|
||||||
;; A simple topological sort of nodes using the Khan method, starting
|
;; A simple topological sort of nodes using the Khan method, starting from node
|
||||||
;; from node `x' (which will be given as the special *-node). The
|
;; `x' (which will be given as the special *-node). The result is a list of
|
||||||
;; result is a list of node lists, each one corresponds to one level.
|
;; node lists, each one corresponds to one level. Conceptually, the input node
|
||||||
|
;; is always only item in the first level, so it is not included in the result.
|
||||||
(provide topological-sort)
|
(provide topological-sort)
|
||||||
(define (topological-sort x)
|
(define (topological-sort x)
|
||||||
(let loop ([todo (list x)] [sorted (list (list x))] [seen (list x)])
|
(let loop ([todo (list x)] [sorted '()] [seen (list x)])
|
||||||
(let* (;; take the next level of nodes
|
(let* (;; take the next level of nodes
|
||||||
[next (append-map (lambda (x) (map edge-callee (node-callees x)))
|
[next (append-map (lambda (x) (map edge-callee (node-callees x)))
|
||||||
todo)]
|
todo)]
|
||||||
|
|
|
@ -33,25 +33,25 @@
|
||||||
(define (topological-sort-tests)
|
(define (topological-sort-tests)
|
||||||
(test
|
(test
|
||||||
|
|
||||||
(same-levels '(A -> B -> C)
|
(same-levels '(* -> A -> B)
|
||||||
|
'((A) (B)))
|
||||||
|
|
||||||
|
(same-levels '(* -> A -> B -> *
|
||||||
|
* -> B -> A -> *)
|
||||||
|
'((A B)))
|
||||||
|
|
||||||
|
(same-levels '(* -> A -> B -> C
|
||||||
|
* -> C)
|
||||||
'((A) (B) (C)))
|
'((A) (B) (C)))
|
||||||
|
|
||||||
(same-levels '(A -> B -> C -> A
|
(same-levels '(* -> A
|
||||||
A -> C -> B -> A)
|
* -> B
|
||||||
'((A) (B C)))
|
B -> B)
|
||||||
|
'((A B)))
|
||||||
|
|
||||||
(same-levels '(A -> B -> C -> D
|
(same-levels '(* -> A
|
||||||
A -> D)
|
* -> B -> C
|
||||||
'((A) (B) (C) (D)))
|
* -> C -> B)
|
||||||
|
'((A B C)))
|
||||||
(same-levels '(A -> B
|
|
||||||
A -> C
|
|
||||||
C -> C)
|
|
||||||
'((A) (B C)))
|
|
||||||
|
|
||||||
(same-levels '(A -> B
|
|
||||||
A -> C -> D
|
|
||||||
A -> D -> C)
|
|
||||||
'((A) (B C D)))
|
|
||||||
|
|
||||||
))
|
))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user