|
|
|
;; Copyright 2019 Edward L. Platt <elplatt@alum.mit.edu>
|
|
|
|
;;
|
|
|
|
;; TODO: comments and tests
|
|
|
|
|
|
|
|
#lang racket
|
|
|
|
|
|
|
|
(provide
|
|
|
|
sylvester-nodes
|
|
|
|
sylvester-edges
|
|
|
|
sylvester-undirected-edges)
|
|
|
|
|
|
|
|
(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-undirected-edges m)
|
|
|
|
(filter
|
|
|
|
(lambda (edge)
|
|
|
|
(> (sylvester-radix-value (first edge))
|
|
|
|
(sylvester-radix-value (second edge))))
|
|
|
|
(sylvester-edges 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)))))
|
|
|
|
|