[plt-scheme] random walk
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
![[logo]](/logo.png){kind=logo}