From Newsgroup: comp.lang.lisp

Ken Tilton wrote:

sean wrote:

Hi c.l.l

I'm a newbie working through Graham's ACL with the help of Chris
Riesbeck's online annotations and Lisp Critic tool. The latter always scolds me when I accumulate values in the body of a dolist using setf
and friends, telling me to use 'do' instead. Trouble is, I can't see a reasonable way to to do this transformation in general.

Here's an example (which started life as Graham's 'random-next'
Figure 8.3 ACL):

;; 'choices' is an alist, not empty, whose entries are pairs
;; (symbol . weight). Make a weighted random choice of symbol.

(defun weight-sum (choices)
(reduce #'+ choices :key #'cdr))

;; Graham has a snippet similar to this.
;; Lisp Critic thinks that 'i' should be updated in a 'do'.
(defun weighted-roulette-choice (choices)
(let ((i (random (weight-sum choices))))
(dolist (pair choices)
(when (minusp (decf i (cdr pair)))
(return (car pair))))))

;; Here's an equivalent 'do'. Lisp Critic still hates the setq of
;; course, but I need the new value of 'pair' when updating 'i'.
(defun weighted-roulette-choice (choices)
(do ((l choices (cdr l))
(pair nil)
(i (random (weight-sum choices)) (- i (cdr pair))))
((minusp i) (car pair))
(setq pair (car l))))

;; I can get rid of the assignment at the cost of using do* and an extra
;; variable. Lisp Critic is happy.
(defun weighted-roulette-choice (choices)
(do* ((l choices (cdr l))
(lastpair nil pair)
(pair (car l) (car l))
(i (random (weight-sum choices)) (- i (cdr lastpair))))
((< i (cdr pair)) (car pair))))

To my naive newbie eyes, this is unreadable compared to the 'dolist' version. However, both the assignment in the body and the early return seem tailor-made for 'do'. Is there some idiomatic way to write such
a dolist as a do?

In the end I used a cowardly 'loop':

(defun weighted-roulette-choice (choices)
(let ((roulette-spin (random (weight-sum choices))))
(loop for pair in choices
sum (cdr pair) into cumulative-weight
until (> cumulative-weight roulette-spin)
finally (return (car pair)))))

I chickened out with:

(defun weighted-roulette-choice (choices)
(loop with i = (random (weight-sum choices))
for (choice . weight) in choices
when (minusp (decf i weight))
return choice))

Exactly half the parentheses of PG's version! Note that IMHO the right
name for a variable (choice vs pair) is the semantics of its content,
not a doc string for its representation. Fixing i left as an exercise.

Gauche Scheme

(use srfi-27) ;; random-integer

(define (weight-sum choices)
(apply + (map cdr choices)))

(define (weighted-roulette-choice choices)
(let1 r (random-integer (weight-sum choices))
(car
(find (lambda(x) (negative? (dec! r (cdr x)))) choices))))



Testing:

(let1 h (make-hash-table)
(dotimes (9888)
(hash-table-update! h
(weighted-roulette-choice '((a . 2)(b . 5)(c . 2)))
(cut + 1 <>) 0))
(hash-table->alist h))

((c . 2122) (b . 5480) (a . 2286))
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

Ken Tilton wrote:

sean wrote:

Hi c.l.l

I'm a newbie working through Graham's ACL with the help of Chris Riesbeck's online annotations and Lisp Critic tool. The latter always scolds me when I accumulate values in the body of a dolist using setf
and friends, telling me to use 'do' instead. Trouble is, I can't see a reasonable way to to do this transformation in general.

Here's an example (which started life as Graham's 'random-next'
Figure 8.3 ACL):

;; 'choices' is an alist, not empty, whose entries are pairs
;; (symbol . weight). Make a weighted random choice of symbol.

(defun weight-sum (choices)
(reduce #'+ choices :key #'cdr))

;; Graham has a snippet similar to this.
;; Lisp Critic thinks that 'i' should be updated in a 'do'.
(defun weighted-roulette-choice (choices)
(let ((i (random (weight-sum choices))))
(dolist (pair choices)
(when (minusp (decf i (cdr pair)))
(return (car pair))))))

;; Here's an equivalent 'do'. Lisp Critic still hates the setq of
;; course, but I need the new value of 'pair' when updating 'i'.
(defun weighted-roulette-choice (choices)
(do ((l choices (cdr l))
(pair nil)
(i (random (weight-sum choices)) (- i (cdr pair))))
((minusp i) (car pair))
(setq pair (car l))))

;; I can get rid of the assignment at the cost of using do* and an extra ;; variable. Lisp Critic is happy.
(defun weighted-roulette-choice (choices)
(do* ((l choices (cdr l))
(lastpair nil pair)
(pair (car l) (car l))
(i (random (weight-sum choices)) (- i (cdr lastpair))))
((< i (cdr pair)) (car pair))))

To my naive newbie eyes, this is unreadable compared to the 'dolist' version. However, both the assignment in the body and the early return seem tailor-made for 'do'. Is there some idiomatic way to write such
a dolist as a do?

In the end I used a cowardly 'loop':

(defun weighted-roulette-choice (choices)
(let ((roulette-spin (random (weight-sum choices))))
(loop for pair in choices
sum (cdr pair) into cumulative-weight
until (> cumulative-weight roulette-spin)
finally (return (car pair)))))

I chickened out with:

(defun weighted-roulette-choice (choices)
(loop with i = (random (weight-sum choices))
for (choice . weight) in choices
when (minusp (decf i weight))
return choice))

Exactly half the parentheses of PG's version! Note that IMHO the right
name for a variable (choice vs pair) is the semantics of its content,
not a doc string for its representation. Fixing i left as an exercise.

Gauche Scheme

(use srfi-27) ;; random-integer

(define (weight-sum choices)
(apply + (map cdr choices)))

(define (weighted-roulette-choice choices)
(let1 r (random-integer (weight-sum choices))
(car
(find (lambda(x) (negative? (dec! r (cdr x)))) choices))))

Testing:

(let1 h (make-hash-table)
(dotimes (9888)
(hash-table-update! h
(weighted-roulette-choice '((a . 2)(b . 5)(c . 2)))
(cut + 1 <>) 0))
(hash-table->alist h))

((c . 2122) (b . 5480) (a . 2286))

Another way.

(define (weighted-roulette-choice choices)
(do ((x #f)
(r (random-integer (weight-sum choices)) (- r (cdr x))))
((negative? r) (car x))
(set! x (pop! choices))))
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2

From Newsgroup: comp.lang.lisp

B. Pym wrote:

Ken Tilton wrote:

sean wrote:

Hi c.l.l

I'm a newbie working through Graham's ACL with the help of Chris Riesbeck's online annotations and Lisp Critic tool. The latter always scolds me when I accumulate values in the body of a dolist using setf
and friends, telling me to use 'do' instead. Trouble is, I can't see a reasonable way to to do this transformation in general.

Here's an example (which started life as Graham's 'random-next'
Figure 8.3 ACL):

;; 'choices' is an alist, not empty, whose entries are pairs
;; (symbol . weight). Make a weighted random choice of symbol.

(defun weight-sum (choices)
(reduce #'+ choices :key #'cdr))

;; Graham has a snippet similar to this.
;; Lisp Critic thinks that 'i' should be updated in a 'do'.
(defun weighted-roulette-choice (choices)
(let ((i (random (weight-sum choices))))
(dolist (pair choices)
(when (minusp (decf i (cdr pair)))
(return (car pair))))))

;; Here's an equivalent 'do'. Lisp Critic still hates the setq of
;; course, but I need the new value of 'pair' when updating 'i'.
(defun weighted-roulette-choice (choices)
(do ((l choices (cdr l))
(pair nil)
(i (random (weight-sum choices)) (- i (cdr pair))))
((minusp i) (car pair))
(setq pair (car l))))

;; I can get rid of the assignment at the cost of using do* and an extra ;; variable. Lisp Critic is happy.
(defun weighted-roulette-choice (choices)
(do* ((l choices (cdr l))
(lastpair nil pair)
(pair (car l) (car l))
(i (random (weight-sum choices)) (- i (cdr lastpair))))
((< i (cdr pair)) (car pair))))

To my naive newbie eyes, this is unreadable compared to the 'dolist' version. However, both the assignment in the body and the early return seem tailor-made for 'do'. Is there some idiomatic way to write such
a dolist as a do?

In the end I used a cowardly 'loop':

(defun weighted-roulette-choice (choices)
(let ((roulette-spin (random (weight-sum choices))))
(loop for pair in choices
sum (cdr pair) into cumulative-weight
until (> cumulative-weight roulette-spin)
finally (return (car pair)))))

I chickened out with:

(defun weighted-roulette-choice (choices)
(loop with i = (random (weight-sum choices))
for (choice . weight) in choices
when (minusp (decf i weight))
return choice))

Let's compare the speed of LOOP to that of DO. (Using SBCL.)

(defun weight-sum (choices) (reduce #'+ choices :key #'cdr))

(defun weighted-roulette-choice (choices)
(loop with i = (random (weight-sum choices))
for (choice . weight) in choices
when (minusp (decf i weight))
return choice))

(time (dotimes (_ 8999888)
(weighted-roulette-choice
'((a . 2)(b . 5)(c . 2)(d . 5)(e . 2)(f . 9)(g . 8)(h . 7)))
))

;; Result for fastest run:
5.110 seconds of real time
5.015625 seconds of total run time (5.015625 user, 0.000000 system)
98.16% CPU
9,342,002,197 processor cycles
0 bytes consed


(defun weighted-roulette-choice4 (choices)
(let ((r (random (weight-sum choices))))
(do (x)
((minusp r) (car x))
(decf r (cdr (setf x (pop choices)))))))

(time (dotimes (_ 8999888)
(weighted-roulette-choice4
'((a . 2)(b . 5)(c . 2)(d . 5)(e . 2)(f . 9)(g . 8)(h . 7)))
))

;; Result for fastest run:
4.906 seconds of real time
4.890625 seconds of total run time (4.890625 user, 0.000000 system)
99.69% CPU
8,982,108,421 processor cycles
0 bytes consed


DO seems slightly faster.
--
[T]he problem is that lispniks are as cultish as any other devout group and basically fall down frothing at the mouth if they see [heterodoxy].
--- Kenny Tilton
The good news is, it's not Lisp that sucks, but Common Lisp. --- Paul Graham --- Synchronet 3.21a-Linux NewsLink 1.2