XPost: comp.lang.scheme

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)]))

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)