[plt-scheme] random walk

p.s.

I am so sorry for using a lexically scope macro before: I thought I  
needed to do so for performance. Turns out, a function works just as  
fast:

> #lang scheme
>
> #| [:~/0Unison/Need] matthias% mzscheme foo3.ss
>    10
>    cpu time: 234 real time: 234 gc time: 0 |#
>
> ;; 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))
>   (let step ((ld 0) (p O))
>     (if (>= ld depth)
>         ;; (apply + (map sqr p))
>         (let loop ([i 0][sum 0])
>           (if (= i n) sum (loop (+ i 1) (+ sum (sqr (vector-ref p  
> i))))))
>         ;; (apply + (map (curry step (+ ld 1)) (map (curry v+ p) Ds)))
>         (let loop ([Ds 0][sum 0])
>           (define (tmp! delta)
>             (let ([old (vector-ref p Ds)])
>               (vector-set! p Ds (delta old 1))
>               (begin0
>                 (step (+ ld 1) p)
>                 (vector-set! p Ds old))))
>           (if (= Ds n) sum (loop (+ Ds 1) (+ sum (tmp! +) (tmp!  
> -))))))))
>
> (define (main depth)
>   (pretty-print (/ (walk 2 depth) (expt 4 depth))))
>
> (time (main 10))




On Jun 11, 2009, at 4:22 PM, Matthias Felleisen wrote:

>
> I have spent an hour or so improving the speed of my solution by a  
> factor of 12. This should bring it closer to 150 seconds on your  
> machine.
>
> I started from a list based version, went to vectors, and then  
> eliminated the applicative vector update with temporary assignments.
>
> The files (with invocation commands) follow in order fast to slow.  
> -- Matthias
>
> #lang scheme
>
> #| [:~/0Unison/Need] matthias% mzscheme foo3.ss
>    10
>    cpu time: 234 real time: 234 gc time: 0 |#
>
> ;; 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))
>   (let step ((ld 0) (p O))
>     (if (>= ld depth)
>         ;; (apply + (map sqr p))
>         (let loop ([i 0][sum 0])
>           (if (= i n) sum (loop (+ i 1) (+ sum (sqr (vector-ref p  
> i))))))
>         ;; (apply + (map (curry step (+ ld 1)) (map (curry v+ p) Ds)))
>         (let loop ([Ds 0][sum 0])
>           (define-syntax-rule (tmp! delta)
>             (let ([old (vector-ref p Ds)])
>               (vector-set! p Ds (delta old 1))
>               (begin0
>                 (step (+ ld 1) p)
>                 (vector-set! p Ds old))))
>           (if (= Ds n) sum (loop (+ Ds 1) (+ sum (tmp! +) (tmp!  
> -))))))))
>
> (define (main depth)
>   (pretty-print (/ (walk 2 depth) (expt 4 depth))))
>
> (time (main 10))
>
>
> #lang scheme
>
> #| [:~/0Unison/Need] matthias% mzscheme foo2.ss
>    10
>    cpu time: 414 real time: 414 gc time: 14 |#
>
> ;; 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)
>         ;; (apply + (map sqr p))
>         (let loop ([i 0][sum 0])
>           (if (= i n) sum (loop (+ i 1) (+ sum (sqr (vector-ref p  
> i))))))
>         ;; (apply + (map (curry step (+ ld 1)) (map (curry v+ p) Ds)))
>         (let loop ([Ds Ds][sum 0])
>           (if (null? Ds)
>               sum
>               (loop (cdr Ds)
>                     (+ sum (step (+ ld 1) (vector+ n p (car  
> Ds))))))))))
>
> ;; Nat (Vectorof Nat) (Vectorof Nat) -> (Vectorof Nat)
> (define (vector+ n p delta)
>   (define result (make-vector n 0))
>   (let loop ([i 0])
>     (when (< i n)
>       (vector-set! result i (+ (vector-ref p i) (vector-ref delta i)))
>       (loop (+ i 1))))
>   result)
>
> ;; Nat -> (Listof (Vectorof {0|+1|-1}))
> (define (deltas n)
>   (define (mk D i) (lambda (j) (if (= i j) D 0)))
>   (append (build-list n (lambda (i) (build-vector n (mk +1 i))))
>           (build-list n (lambda (i) (build-vector n (mk -1 i))))))
>
> (define (main depth)
>   (pretty-print (/ (walk 2 depth) (expt 4 depth))))
>
> (time (main 10))
>
> #lang scheme
>
> #| [:~/0Unison/Need] matthias% mzscheme foo1.ss
>    10
>    cpu time: 606 real time: 607 gc time: 18 |#
>
> ;; Nat Nat -> Nat
> ;; compute L2 distance for all random walks of depth dpt in n-space
> (define (walk n depth)
>   (define O (make-list n 0))
>   (define Ds (deltas n))
>   (let step ((ld 0) (p O))
>     (if (>= ld depth)
>         ;; (apply + (map sqr p))
>         (let loop ([p p][sum 0])
>           (if (null? p) sum (loop (cdr p) (+ sum (sqr (car p))))))
>         ;; (apply + (map (curry step (+ ld 1)) (map (curry v+ p) Ds)))
>         (let loop ([Ds Ds][sum 0])
>           (if (null? Ds)
>               sum
>               (loop (cdr Ds) (+ sum (step (+ ld 1) (map + p (car  
> Ds))))))))))
>
> ;; Nat -> (Listof (Vectorof {0|+1|-1}))
> (define (deltas n)
>   (define (mk D i) (lambda (j) (if (= i j) D 0)))
>   (append (build-list n (lambda (i) (build-list n (mk +1 i))))
>           (build-list n (lambda (i) (build-list n (mk -1 i))))))
>
> (define (main depth)
>   (pretty-print (/ (walk 2 depth) (expt 4 depth))))
>
> (time (main 10))
>
> #lang scheme
>
> #| [:~/0Unison/Need] matthias% mzscheme foo.ss
>    10
>    cpu time: 2779 real time: 2776 gc time: 72 |#
>
> ;; 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 (curry step (+ ld 1)) (map (curry v+ p) Ds))))))
>
> ;; (Vectorof Nat) -> Nat
> (define (L2 p)
>   (apply + (map sqr (vector->list p))))
>
> ;; Nat -> (Listof (Vectorof {0|+1|-1}))
> (define (deltas n)
>   (define (mk D i) (lambda (j) (if (= i j) D 0)))
>   (append (build-list n (lambda (i) (build-vector n (mk +1 i))))
>           (build-list n (lambda (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))))
>
> (define (main depth)
>   (pretty-print (/ (walk 2 depth) (expt 4 depth))))
>
> (time (main 10))
>
>
>
>
>
>
>
>
>
> On Jun 11, 2009, at 10:03 AM, Marijn Schouten (hkBst) wrote:
>
>> First, I'd like to thank all who tried to help me previously with  
>> this.
>> Unfortunately I still didn't manage to fix my macro mess, so I  
>> have tried again
>> with functions.
>>
>> Matthias Felleisen wrote:
>>>
>>> Do you want this function? I don't see the need for a macro.
>>
>> Yes, this code does what I need, but it doesn't do it fast enough.
>>
>>> #lang scheme
>>
>> I commented this out, since I don't know how to run with it.
>>
>>>
>>> ;; 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))))
>>>
>>> ;;
>>
>> I added:
>>
>> (define (main depth)
>>   (pretty-print (/ (walk 2 depth) (expt 4 depth))))
>>
>> Then I ran like so:
>>
>> mzscheme -f felleisen-walk.scm -e "(time (main 10))"
>> 10
>> cpu time: 1940 real time: 1956 gc time: 75
>>
>>
>>
>> The following code:
>>
>> (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)))))
>>
>> is specific to dimension 2 but also much faster:
>>
>> $ mzscheme -e "(define pp pretty-print)" -f randomwalk.scm -e  
>> "(time (main 10))"
>> 10
>> cpu time: 59 real time: 59 gc time: 0
>>
>> I also have an abstract version that runs in any dimension that  
>> runs 10 times as
>> slow as my fast version and 3 times faster than your version.  
>> There are
>> certainly some areas in my abstract version which I am extremely  
>> unhappy about
>> that account for a lot of consing.
>>
>> Anyway, I'm interested in code that runs as fast as my fast code  
>> above, but is
>> also able to work with arbitrary dimension, such that I do not  
>> have to duplicate
>> my code for each dimension that I am interested in. I would be  
>> very happy if I
>> could do that by optimizing some abstract version that uses only  
>> functions by
>> eliminating consing and non-tail recursion, but currently it seems  
>> to me that
>> only a macro that generates the fast code given a particular  
>> dimension will give
>> maximum speed.
>>
>> Further I would like to note that preliminary testing seems to  
>> indicate that
>> plt-scheme is quite competitive with other fast implementations  
>> that I have
>> tried for my current code (unlike say gauche (3-4 times slower) or  
>> scheme48 (4
>> times slower than gauche)). Previous testing had shown plt to be  
>> (only)
>> medium-fast, so I am pleasantly surprised.
>>
>> I have attached a file with my slow and fast implementations (no  
>> macros yet).
>> You can switch between the implementations in the main function at  
>> the bottom.
>>
>> Thanks,
>>
>> Marijn
>>
>>> -------------------------------------------------------------------- 
>>> ---------
>>>
>>> (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
>> ; $ 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))))
>>
>> _________________________________________________
>>   For list-related administrative tasks:
>>   http://list.cs.brown.edu/mailman/listinfo/plt-scheme
>
> _________________________________________________
>  For list-related administrative tasks:
>  http://list.cs.brown.edu/mailman/listinfo/plt-scheme