(use-modules (srfi srfi-1))

(define (analyze k)
  (define n (* k 2))
  (define l (apply circular-list (map (lambda (X) #f) (iota n))))
  (define (shift l k)
    (let loop ((l l) (k k))
      (if (= k 0) 
	  l
	  (loop (cdr l) (- k 1)))))

  (define (next loop)
    (let lp ((ll l) (i 0))
      (if (= i n)
	  l
	  (if (car ll)
	      (lp (cdr ll) (+ i 1))
	      (loop i l 0)))))
	  
  (define (M)
    (let lp ((l l) (k n) (M -1))
      (if (= k 0)
	  M
	  (let ((c (caar l)))
	    (if (< M c)
		(lp (cdr l) (- k 1) c)
		(lp (cdr l) (- k 1) M))))))

  (define (place x)
    (let loop ((ll l) (i 0))
      (if (equal? (car ll) x)
	  i
	  (loop (cdr ll) (+ i 1)))))
      
  (set-car! (cdr l) (cons 1 0))
  (set-car! (shift l (- n 1)) (cons 1 0))
  (let loop ((m 2) (ll l) (k 0))
    (let ((ll (shift ll m)))
      (if (and (pair? (car ll)) (eq? (caar ll) m))
	  (next loop)
	  (begin
	    (unless (car ll) (set-car! ll (cons m k)) (set! k (+ k 1)))
	    (loop m ll k)))))

  (let* ((M   (M))
	 (ll  (let lp ((ll l) (k n))
		(if (= k 0)
		    '()
		    (cons (car ll) (lp (cdr ll) (- k 1))))))
	 (ll  (fold (lambda (k r)(if (eq? (car k) M) (cons k r) r)) '() ll))
	 (ll  (sort ll (lambda (x y) (< (cdr x) (cdr y))))))

    (cond 
     ((= (length ll) 1)
      (* (place (car ll)) 2))
     (else
      (+ (place (car ll)) (place (car (last-pair ll))))))))
   
(let lp ((i 3))
  (if (= i 1000)
      (pk 'ok)
      (begin
	(if (not (= (* 2 i) (analyze i)))
	    (format #t "~a != (analyze ~a) == ~a~%" (* 2 i) (* 2 i) 
		    (analyze (* 2i))))
	(lp (+ i 1)))))