; latin squares

(define (take n xs)
  (let loop ((n n) (xs xs) (ys '()))
    (if (or (zero? n) (null? xs))
        (reverse ys)
        (loop (- n 1) (cdr xs)
              (cons (car xs) ys)))))

(define (drop n xs)
  (let loop ((n n) (xs xs))
    (if (or (zero? n) (null? xs)) xs
      (loop (- n 1) (cdr xs)))))

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))
   
(define (shuffle x)
  (do ((v (list->vector x)) (n (length x) (- n 1)))
      ((zero? n) (vector->list v))
    (let* ((r (random n)) (t (vector-ref v r)))
      (vector-set! v r (vector-ref v (- n 1)))
      (vector-set! v (- n 1) t))))

(define (rot n xs)
  (if (negative? n)
    (set! n (- (length xs) (- n))))
  (append (drop n xs) (take n xs)))

(define (latin n)
  (do ((n n (- n 1))
       (m (list (shuffle (range n))) (cons (rot 1 (car m)) m)))
      ((= n 1) (shuffle (apply map list (shuffle m))))))

(define (f2 n)
  (let ((s (number->string n)))
    (if (< n 10) (string-append " " s) s)))

(for-each (lambda (row) (display (map f2 row)) (newline)) (latin 25))