Hi, I am trying to write a program that will iterate over all random walks of a certain fixed depth on a grid of a certain dimension DIM. There are exactly (expt (* 2 (DIM)) depth)) such random walks and I would like to calculate the mean squared length of them at a certain depth. The answer is depth. The algorithm should thus act as the identity function on natural numbers, if given depth and returning the mean squared length of random walks of that depth.
The function
(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)))))
calculates the total squared length. Assuming dimension 2 I performed some
optimizations. I have written syntax-case macro code that should construct this
function for arbitrary dimension, except I cannot get it to work. I have
attached the complete program (68 lines) with the offending code commented out.
I would really appreciate some help with this.
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)"
; $ larceny -- stripped-randomwalk.scm -e "(define pp pretty-print)" -e "(main
10)" -e "(quit)"
(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 (stx)
;; (syntax-case stx ()
;; ((k)
;; (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))))))
;; (let* ((coords (generate-temporaries (vector->list (make-vector
(DIM)))))
;; (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)))) )
;; #`(let %step #,(datum->syntax-object #'k (cons '(d 0) (map
(lambda (c) (list c 0)) coords)))
;; (cond ((< d depth)
;; (let* ((d+1 (fx+ d 1))
;; (d-next (map (lambda (l) (cons d+1 l))
#,next)) )
;; (macro-reduce-map 0 + %step d-next)))
;; (else (L2-norm coords)) )) ) ))))))
;; (step)))
(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)))))
signature.asc
Description: OpenPGP digital signature
_______________________________________________ Larceny-users mailing list Larceny-users@lists.ccs.neu.edu https://lists.ccs.neu.edu/bin/listinfo/larceny-users
