[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