;; 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)))))