; $ gsi -:s stripped-randomwalk -e "(main 10)"

(define-syntax DIM
  (syntax-rules ()
    ((DIM) 2)))
;    ((DIM) 3)))

;;; (reduce-map unit reducer mapper list)
;;; (reduce-map u r m '()) |-> u
;;; (reduce-map u r m l) |-> (reduce u r (map m l))
(define-syntax macro-reduce-map
  (syntax-rules ()
    ((_ u r m) u)
    ((_ u r m a b ...)
     (r (m a)
	(macro-reduce-map u r m b ...)))))

(define-syntax L2-norm
  (syntax-rules ()
    ((_ a ...) (macro-reduce-map 0 + (lambda (e) (* e e)) a ...))))

(define (main depth)
  (pp (/ (walk depth) (expt (* 2 (DIM)) depth))))

(define (walk depth)
  (let-syntax
      ((step
	(lambda (stx)
	  (syntax-case stx ()
	    ((k)
	     (letrec ((vector-map (lambda (f v)
				    (let* ((l (vector-length v))
					   (ret (make-vector l)))
				      (let loop ((i 0))
					(cond ((= i l) ret)
					      (else (vector-set! ret i (f (vector-ref v i) i))
						    (loop (+ i 1))))))))
		      (make-next-coords (lambda (names pos inc)
					  (if (= pos 0)
					      (cons `(+ ,(car names) ,inc) (cdr names))
					      (cons (car names) (make-next-coords (cdr names) (- pos 1) inc))))))
	     (let* ((coords (generate-temporaries (vector->list (make-vector (DIM)))))
		    (next (vector->list (let ((next-v (make-vector (* 2 (DIM)))))
					  (vector-map (lambda (e i) (make-next-coords coords (modulo i (DIM)) (if (< i (DIM)) +1 -1))) next-v)))) )
	       #`(let %step #,(datum->syntax-object #'k (cons '(d 0) (map (lambda (c) (list c 0)) coords)))
		   (cond ((< d depth)
			  (let* ((d+1 (fx+ d 1))
				 (d-next (map (lambda (l) (cons d+1 l)) #,next)) )
			    (macro-reduce-map 0 + %step d-next)))
			 (else (L2-norm coords)) )) ) ))))))
    (step)))

;; (define (walk-f depth)
;;   (let step ((d 0) (x 0) (y 0) #;(z 0))
;;     (cond ((< d depth)
;; 	   (let ((d+1 (+ d 1)))
;; 	     (+
;; 	      (step d+1 (+ x 1) y)
;; 	      (+
;; 	       (step d+1 (- x 1) y)
;; 	       (+ (step d+1 x (+ y 1))
;; 		       (step d+1 x (- y 1))) ))))
;; 	  (else
;; 	   (L2-norm x y)))))

