[plt-scheme] random walk

Do you want this function? I don't see the need for a macro.

#lang scheme

;; Nat Nat -> Nat
;; compute L2 distance for all random walks of depth dpt in n-space
(define (walk n depth)
   (define O (make-vector n 0))
   (define Ds (deltas n))
   (let step ((ld 0) (p O))
     (if (>= ld depth)
         (L2 p)
         (apply + (map (lambda (d) (step (+ ld 1) (v+ p d))) Ds)))))

;; (Vectorof Nat) -> Nat
(define (L2 p)
   (apply + (map sqr (vector->list p))))

;; Nat -> (Listof (Vectorof {0|+1|-1}))
(define (deltas n)
   (define (mk+1 i) (lambda (j) (if (= i j) +1 0)))
   (define (mk-1 i) (lambda (j) (if (= i j) -1 0)))
   (apply append
          (build-list n (lambda (i)
                          (list (build-vector n (mk+1 i))
                                (build-vector n (mk-1 i)))))))

;; (Vectorof Nat) (Vector Nat) -> (Vector Nat)
(define (v+ u v)
   ;; I am sure there's some for/vector somewhere, I can't find it
   (list->vector (for/list ((x u) (y v)) (+ x y))))

;;  
------------------------------------------------------------------------ 
-----
(require test-engine/scheme-tests)

;; deltas
(check-expect (deltas 0) '())
(check-expect (deltas 1) (list (vector +1) (vector -1)))
(check-expect
  (deltas 2) (list (vector +1 0) (vector -1 0) (vector 0 +1) (vector  
0 -1)))

;; v+
(check-expect (v+ #3(2 3 0) #3(-1 0 0)) #3(1 3 0))

;; L2
(check-expect (L2 #3(2 3 0)) 13)

;; walk:
;; add your favorite test here

(test)




On May 29, 2009, at 11:08 AM, Marijn Schouten (hkBst) wrote:

> Hi,
>
> I'm trying to write a macro that writes a function that sums the L2- 
> lengths of
> all (random) walks of depth d on a square grid of dimension DIM. In  
> dimension 2
> that function should look like this:
>
>
> (define (walk 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
> 	   (+ (* x x) (* y y)) ) )))
>
>
> (walk d) starts at the origin, (x,y) = (0,0), and recursively walks  
> a step in
> all 2DIM directions, returning the L2-length when depth d is  
> reached and summing
> all those lengths. It is not hard to prove that (walk depth) is  
> equal to (expt
> (* 2 (DIM)) depth) but this random walk length summer is only the  
> starting point
> for doing more interesting things.
>
> I'm looking for a macro that will write the `walk' function given  
> the dimension.
>
> Attached is an attempt that I cannot seem to get working.
>
> Thanks,
>
> Marijn
>
>
> -- 
> If you cannot read my mind, then listen to what I say.
>
> Marijn Schouten (hkBst), Gentoo Lisp project, Gentoo ML
> <http://www.gentoo.org/proj/en/lisp/>, #gentoo-{lisp,ml} on FreeNode
> ; $ 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)))))
>
> _________________________________________________
>   For list-related administrative tasks:
>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme