On Feb 14, 2014, at 7:42 AM, Erich Rast wrote:
> I have a directed graph given as list of pairs ((from-node .
> to-node) ...) and need to detect whether adding a pair would create a
> cycle.
>
> Is there an easy way to do this already, e.g. some Planet package or
> snippet someone would like to share?
>
> I don't want to reinvent the wheel and this is not a homework question.
I thought it looked like the first homework from my junior-level sw dev course
last year but when I checked the interface, my requirement was to conform to
the triangle inequality. Sorry, no luck
#lang racket
(require "../Lib/contract.rkt")
;;
---------------------------------------------------------------------------------------------------
;; for contracts see below
(provide
node?
edge?
edge
edge-from
edge-to
edge-cost
reverse-edge
graph/c)
(interface graph&
(node? (-> any/c boolean?))
(edge? contract?)
(edge (-> node? real? node? edge?)) ;; MF: forgot to export it
(edge-from (-> edge? node?))
(edge-to (-> edge? node?))
(edge-cost (-> edge? number?))
graph/c
(graph% graph/c))
;; an interface needs a common terminology with an interpretation (see
Fundamentals I, ontology)
;; nodes
(define node? symbol?)
;; edges
(define edge?
(list/c node? real? node?))
(define/contract (edge from cost to)
(-> node? real? node? edge?)
(list from cost to))
(define edge-from first)
(define edge-cost second)
(define edge-to third)
(define reverse-edge reverse)
(define (cost/c low high)
;; MF: while I can't enforce invariants on fields
(λ (x) (<= low x high))
#;
(and/c (>=/c low) (<=/c high)))
;; graphs
(define graph/c
(class/c
;; specify the interval of costs [low-cost,high-cost]
(init-field (low-cost (and/c real? (>=/c 0)))) ;; MF: made cost non-negative
;; MF: Racket's contract system is deficient here:
(init-field (high-cost (and/c real? (>=/c 0) #;(>/c low-cost))))
;; and I want this to be interpreted as an invariant
(nodes
;; the list of nodes of this graph
(->m (set/c node? #:cmp 'eq)))
(edges
;; the list of edges of this graph
(->m (set/c edge? #:cmp 'equal)))
(add-edge
;; adding an edge (from,to) with cost w to this graph
(->dm ((from node?)
(w (cost/c (get-field low-cost this) (get-field high-cost this)))
(to node?))
#:pre (triangle-condition-preserved (send this edges) from w to)
any))
;; MF: I had not anticipated that I would want an 'inherited' call
(inherit (add-edge
;; adding an edge (from,to) with cost w to this graph
(->dm ((from node?)
(w (cost/c (get-field low-cost this) (get-field high-cost
this)))
(to node?))
#:pre (triangle-condition-preserved (send this edges) from w
to)
any)))
(reverse-edges
;; reverse all edges in this graph, keep costs
(->m any))
(join
;; join the nodes of other graph to this graph
(->dm ((other (instanceof/c graph/c)))
#:pre (and (set=? (set-intersect (send this nodes) (send other
nodes)) (seteq))
(= (get-field low-cost this) (get-field low-cost other))
(= (get-field high-cost this) (get-field high-cost other)))
any))
(path?
;; is there a path from f to t?
(->dm ((f node?) (t node?)) (result boolean?)))
(path
;; (path f t) is there a path from f to t and its total cost in this graph
(->dm ((f node?) (t node?)) #:pre (send this path? f t)
(values (cost real?) (p (listof edge?)))))))
;; [set/c edge?] node? real? node? -> boolean?
;; does the new edge preserve all new triangle equations?
(define (triangle-condition-preserved edges:set from cost-from->to to)
(define edges (set->list edges:set))
(define to-out (filter (λ (e) (and (eq? (edge-from e) to) (not (eq? (edge-to
e) from)))) edges))
(define to-in (filter (λ (e) (and (eq? (edge-to e) to) (not (eq? (edge-from
e) from)))) edges))
(define (edges-between s t)
(filter (λ (e) (and (eq? (edge-from e) s) (eq? (edge-to e) t))) edges))
(and
; from to
; *----- cost---->*
; |
; |
; |
; v
; * target
;; there is only one way to complete this triangle: from->target
(for/and ((to->target to-out))
(define cost-from->to->target (+ cost-from->to (edge-cost to->target)))
(for/and ((from->target (edges-between from (edge-to to->target))))
(define cost-from->target (edge-cost from->target))
(<= cost-from->target cost-from->to->target)))
; from to
; *----- cost --->*
; ^
; |
; |
; |
; * intermediate
;; there are two ways to complete this triangle: from -> intermediate,
intermediate -> from
(for/and ((intermediate->to to-in))
(define cost-intermediate->to (edge-cost intermediate->to))
(define intermediate (edge-from intermediate->to))
(and
(for/and ((intermediate-from (edges-between intermediate from)))
(define cost-intermediate->from (edge-cost intermediate-from))
(<= cost-intermediate->to (+ cost-intermediate->from cost-from->to)))
(for/and ((from->intermediate (edges-between from intermediate)))
(define cost-from->intermediate (edge-cost from->intermediate))
(<= cost-from->to (+ cost-from->intermediate
cost-intermediate->to)))))))
____________________
Racket Users list:
http://lists.racket-lang.org/users
