; $ gsi -:s stripped-randomwalk -e "(main 10)"
; $ mzscheme -e '(require (rename-in scheme (syntax->datum syntax-object->datum)))' -f stripped-randomwalk.scm -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-f depth) (expt (* 2 (DIM)) depth)))
  (pp (/ (walk depth) (expt (* 2 (DIM)) depth)))
)

(define (walk depth)
  (let-syntax
      ((step
	(lambda (x)
	  (syntax-case x ()
	    ((_)
	     (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))))))
	       (with-syntax (((d) (generate-temporaries (list 'd)))
			      (coords (generate-temporaries (vector->list (make-vector (DIM))))))
	         (with-syntax ((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)))))
		   (with-syntax ((bindings #'(map (lambda (e) (list e 0)) (cons d coords)))
				 ((d+1) (generate-temporaries (list 'd+1)))
				 ((%step) (generate-temporaries (list '%step))) )
		     #`(let %step bindings
			 (cond ((< d depth)
				(let* ((d+1 (fx+ d 1)))
				  #,(with-syntax ((d+1&next (map (lambda (l) (cons #'d+1 l)) #'next)))
				      (macro-reduce-map 0 + #'%step #'d+1&next))))
			       (else (L2-norm coords)) ))  )))))))))
    (step)))

;;; what walk should look like for dimension 2
(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)))))