diff --git a/network.rkt b/network.rkt new file mode 100644 index 0000000..8ea97ff --- /dev/null +++ b/network.rkt @@ -0,0 +1,45 @@ +;; Copyright 2019 Edward L. Platt +;; +;; TODO: comments and tests + +#lang racket + +(require "sylvester.rkt") + +(define (sylvester-nodes m) + (map (compose (extend-sylvester-radix m) + make-sylvester-radix) + (range (- (sylvester m) 1)))) + +(define (sylvester-edges m) + (foldr + append + '() + (map (lambda (k) (map (sylvester-color-edge k) (sylvester-nodes m))) + (range m)))) + +(define (sylvester-color-edge k) + (lambda (v) (list v ((skip-sylvester-radix k) v)))) + +(define (permutation-sylvester-radix i n) + (lambda (v) + (let* ([v ((extend-sylvester-radix (+ i 1)) v)] + [head (take v i)] + [tail (if (< i (- (length v) 1)) + (drop v (+ i 1)) + '())] + [element (list-ref v i)]) + (append + head + (cons (modulo (+ element n) (sylvester i)) + tail))))) + +(define (skip-sylvester-radix i) + (lambda (v) + (if (= i 0) + ((permutation-sylvester-radix 0 1) v) + (let* ([prev (skip-sylvester-radix (- i 1))] + [partial (take v (min i (length v)))] + [value (sylvester-radix-value (prev partial))]) + ((compose (permutation-sylvester-radix i (+ 1 value)) prev) v))))) + \ No newline at end of file