scolobb
/
dds
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

utils: Typed update-vertices/unweighted.

This commit is contained in:
Sergiu Ivanov 2022-02-06 23:44:03 +01:00
parent 25b4216faf
commit e1cf64a822
2 changed files with 58 additions and 41 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
scribblings/utils.scrbl
View File

@ -277,6 +277,28 @@ Typeset the graph via graphviz and display it.
(dotit (weighted-graph/directed '((1 a b) (2 b c))))
]}
@defproc[(update-vertices/unweighted [graph Graph] [func (-> Any Any)]) Graph]{
Applies a transformation to every vertex in the unweighted graph and returns
the new graph.
If the transformation function maps two vertices to the same values, these
vertices will be merged in the resulting graph. The transformation function
may be called multiple times for the same vertex.
This function does not rely on @racket[rename-vertex!], so it can be used to
permute vertex labels.
@examples[#:eval utils-evaluator
(define g (directed-graph '((a b) (b c))))
(define (double-labels [x : Any])
(define x-str (symbol->string (cast x Symbol)))
(string->symbol (string-append x-str x-str)))
(dotit (update-vertices/unweighted g double-labels))
]}
@section{Additional list and hash map utilities}
@section{Functions and procedures}

77
utils.rkt
View File

@ -21,7 +21,8 @@
extract-symbols any->string stringify-variable-mapping string->any
handle-org-booleans map-sexp read-org-sexp unorg unstringify-pairs
read-org-variable-mapping unorgv read-symbol-list drop-first-last
list-sets->list-strings pretty-print-set pretty-print-set-sets dotit)
list-sets->list-strings pretty-print-set pretty-print-set-sets
update-vertices/unweighted dotit)
(define-type Variable Symbol)
(define-type (VariableMapping A) (Immutable-HashTable Variable A))
@ -297,6 +298,37 @@
(check-equal? (pretty-print-set-sets (set (set 'a 'b) (set 'c))) "{a b}{c}")))
(define dotit (compose display graphviz))
(: update-vertices/unweighted (-> Graph (-> Any Any) Graph))
(define (update-vertices/unweighted gr func)
(unweighted-graph/directed
(for/list ([e (in-edges gr)])
(match-let ([(list u v) e])
(list (func u) (func v))))))
(module+ test
(test-case "update-vertices/unweighted"
(define gr1 (directed-graph '((a b) (b c))))
(define gr2 (undirected-graph '((a b) (b c))))
(define (dbl [x : Any])
(define x-str (symbol->string (cast x Symbol)))
(string->symbol (string-append x-str x-str)))
(define new-gr1 (update-vertices/unweighted gr1 dbl))
(define new-gr2 (update-vertices/unweighted gr2 dbl))
(check-false (has-vertex? new-gr1 'a))
(check-true (has-vertex? new-gr1 'aa))
(check-false (has-vertex? new-gr1 'b))
(check-true (has-vertex? new-gr1 'bb))
(check-false (has-vertex? new-gr1 'c))
(check-true (has-vertex? new-gr1 'cc))
(check-true (has-edge? new-gr1 'aa 'bb))
(check-true (has-edge? new-gr1 'bb 'cc))
(check-true (has-edge? new-gr2 'aa 'bb))
(check-true (has-edge? new-gr2 'bb 'aa))
(check-true (has-edge? new-gr2 'bb 'cc))
(check-true (has-edge? new-gr2 'cc 'bb))))
)
(require 'typed)
@ -304,14 +336,14 @@
extract-symbols any->string stringify-variable-mapping string->any
map-sexp read-org-sexp unorg unstringify-pairs
read-org-variable-mapping unorgv read-symbol-list drop-first-last
list-sets->list-strings pretty-print-set pretty-print-set-sets dotit)
list-sets->list-strings pretty-print-set pretty-print-set-sets
update-vertices/unweighted dotit)
;;; Untyped section.
(provide
;; Functions
(contract-out [update-vertices/unweighted (-> graph? (-> any/c any/c) graph?)]
[update-graph (->* (graph?)
(contract-out [update-graph (->* (graph?)
(#:v-func (-> any/c any/c)
#:e-func (-> any/c any/c))
graph?)]
@ -357,43 +389,6 @@
;;; Additional graph utilities
;;; ==========================
;;; Apply a transformation to every vertex in the unweighted graph,
;;; return the new graph. If the transformation function maps two
;;; vertices to the same values, these vertices will be merged in the
;;; resulting graph. The transformation function may be called
;;; multiple times for the same vertex.
;;;
;;; This function does not rely on rename-vertex!, so it can be used
;;; to permute vertex labels.
(define (update-vertices/unweighted gr func)
(unweighted-graph/directed
(for/list ([e (in-edges gr)])
(match-let ([(list u v) e])
(list (func u) (func v))))))
(module+ test
(test-case "update-vertices/unweighted"
(define gr1 (directed-graph '((a b) (b c))))
(define gr2 (undirected-graph '((a b) (b c))))
(define dbl (λ (x) (let ([x-str (symbol->string x)])
(string->symbol (string-append x-str x-str)))))
(define new-gr1 (update-vertices/unweighted gr1 dbl))
(define new-gr2 (update-vertices/unweighted gr2 dbl))
(check-false (has-vertex? new-gr1 'a))
(check-true (has-vertex? new-gr1 'aa))
(check-false (has-vertex? new-gr1 'b))
(check-true (has-vertex? new-gr1 'bb))
(check-false (has-vertex? new-gr1 'c))
(check-true (has-vertex? new-gr1 'cc))
(check-true (has-edge? new-gr1 'aa 'bb))
(check-true (has-edge? new-gr1 'bb 'cc))
(check-true (has-edge? new-gr2 'aa 'bb))
(check-true (has-edge? new-gr2 'bb 'aa))
(check-true (has-edge? new-gr2 'bb 'cc))
(check-true (has-edge? new-gr2 'cc 'bb))))
;;; Given a graph, apply a transformation v-func to every vertex label
;;; and, if the graph is a weighted graph, the transformation e-func
;;; to every edge label. Both transformations default to identity