Kent M. Pitman wrote:

> > I'm doing the DNA problem. The function is
> > supposed to count the bases A, T, G, C in either a single dna
> > (represented as a list, e.g (a a t t)) or a complement dna
> > (represented as a table, e.g ((a t) (a t)
> > (t a) (c g))). My function count rights but the viriable result get
> > accumulated on subsequent calls. I don't understand why. Could you
> > shed some light?
> >
> > Thanks very much.
> >
> > (defun count-bases (strand)
> > (let ((result '((a 0) (t 0) ( g 0) (c 0))))
> > (dolist (base strand result)
> > (cond ((atom base)(incf (second (assoc base result))))
> > (t (incf (second (assoc (first base) result)))
> > (incf (second (assoc (second base) result))))))))
>
> You're modifying the constant structure. QUOTE just returns the object
> (think of it as a pointer to a constantly allocated language if you're
> used to that in other languages). On subsequent calls, this will have
> the modified results. (Actually, in some implementations you may get an
> error before that point, but if you don't, that's the most likely result.
> From a language point of view, what you've done is simply undefined and
> pretty much anything that happens is valid from the implementation's point
> of view since you violated your contract as a user when you did that.)
>
> You'll want to use calls to LIST, as in (list (list 'a ...) ...) rather
> than that quoted structure.
>
> In fact, if this is not homework, or some other form of learning
> exercise specifically aimed at figuring out ASSOC, this is not how I'd
> recommend you do this. All those calls to ASSOC are high overhead for
> the value you're getting. I'd suggest the following. I'll show the code
> since no one ever seems to make homework that allows one to use really
> useful primitives--sigh.
>
> (defun count-bases (strand)
> (let ((na 0) (nc 0) (ng 0) (nt 0))
> (macrolet ((notice (ref)
> `(let ((r ,ref))
> (ecase r
> ((a) (incf na))
> ((c) (incf nc))
> ((g) (incf ng))
> ((t) (incf nt))))))
> (dolist (base strand)
> (cond ((atom base) (notice base))
> (t
> (notice (first base))
> (notice (second base)))))
> (values na nc ng nt))))

Testing:

(count-bases '(a c g (a t) (c t) (g t)))

2
2 2
3

Gauche Scheme

(define (count-bases strand)
(let1 counts '()
(dolist (x strand)
(if (pair? x)
(begin (ainc! counts (car x))
(ainc! counts (last x)))
(ainc! counts x)))
(apply values (map (cut assoc-ref counts <>) '(a c g t)))))

2 2
2 3

Given:

(define-syntax ainc!
(syntax-rules ()
[(_ alist key val func default)
(let ((pair (assoc key alist)))
(if pair
(set-cdr! pair (func val (cdr pair)))
(set! alist (cons (cons key (func val default)) alist))))]
[(_ alist key val func)
(ainc! alist key val func 0)]
[(_ alist key val)
(ainc! alist key val +)]
[(_ alist key)
(ainc! alist key 1)]))