; $ gsc -prelude "(declare (standard-bindings)(block))" randomwalk.scm
; $ gsc -prelude "(declare (standard-bindings)(extended-bindings)(block)(not safe))" randomwalk.scm
; $ gsi randomwalk -e "(time (main 10))"

; $ time bigloo -load randomwalk.scm -eval "(main 8)(exit)"

; $ bigloo -Obench randomwalk.bgl -o bigloo-randomwalk
; $ time ./bigloo-randomwalk 10

; $ mzscheme -e "(define pp pretty-print)" -f randomwalk.scm -e "(time (main 10))"

; $ larceny -- -e "(define pp pretty-print)(compiler-switches 'fast-unsafe)(benchmark-block-mode #t)" randomwalk.scm -e "(time (main 10))" -e "(quit)"

; $ gosh -l ./randomwalk.scm -e "(define pp print)" -e "(time (main 10))" -e "(exit)"

; $ scheme48 -a batch <<<$'(define pp (lambda (x) (display x)(newline)))(load "randomwalk.scm")\n,time(main 8)'


(define (reduce-map/index u r m l)
  (let loop ((l l) (ret u) (i 0))
    (if (null? l) ret (loop (cdr l) (r (m (car l) i) ret) (+ i 1)))))

(define (reduce-map-right/index u r m l)
  (let loop ((l l) (i 0))
    (if (null? l) u (r (m (car l) i) (loop (cdr l) (+ i 1))))))

(define (reduce-map u r m l)
  (reduce-map/index u r (lambda (e i) (m e)) l))
;  (let loop ((l l) (ret u))
;    (if (null? l) ret (loop (cdr l) (r (m (car l)) ret)))))

(define (map/index m l)
  (reduce-map-right/index '() cons m l))

(define (squared-L2-norm pos)
  (reduce-map 0 + (lambda (e) (* e e)) pos))

(define (next-position pos dim step)
  (let ((pos-vector (list->vector pos)))
    (vector-set! pos-vector dim (+ (vector-ref pos-vector dim) step))
    (vector->list pos-vector)))

(define (next-positions dimension pos)
  (let loop ((dim 0) (dir #t) (ret '()))
    (if (= dim dimension) ret
	(if dir
	    (loop dim #f (cons (next-position pos dim -1) ret))
	    (loop (+ dim 1) #t (cons (next-position pos dim +1) ret)) ))))

(define (walk dimension norm)
  (lambda (depth)
    (let step ((d 0) (pos (vector->list (make-vector dimension 0))))
      (if (< d depth)
	  (reduce-map 0 + (lambda (p) (step (+ d 1) p)) (next-positions dimension pos))
	  (norm pos) ) )))

;;;fast version below

(define (fast-squared-L2-norm-2 x y)
  (+ (* x x) (* y y)))

(define (fast-walk-2 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
	   (fast-squared-L2-norm-2 x y)))))

(define (main depth)
  (pp (/ ((if #f (walk 2 squared-L2-norm) fast-walk-2) depth) (expt 4 depth))))