<br />
<b>Warning</b>:  mysqli::__construct(): (HY000/1203): User howardkn already has more than 'max_user_connections' active connections in <b>D:\Inetpub\vhosts\howardknight.net\al.howardknight.net\includes\artfuncs.php</b> on line <b>21</b><br />
Failed to connect to MySQL: (1203) User howardkn already has more than 'max_user_connections' active connectionsPath: ...!weretis.net!feeder8.news.weretis.net!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: "B. Pym" <Nobody447095@here-nor-there.org>
Newsgroups: comp.lang.lisp,comp.lang.scheme
Subject: Re: Lisp Question
Date: Mon, 26 Aug 2024 23:31:02 -0000 (UTC)
Organization: A noiseless patient Spider
Lines: 94
Message-ID: <vaj37h$2lak7$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=iso-8859-1
Injection-Date: Tue, 27 Aug 2024 01:31:02 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="2d9bc304c3dee41453738ac9739c34c1";
	logging-data="2796167"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1/VVzmxqk7wmJnJJgXAoYwl"
User-Agent: XanaNews/1.18.1.6
Cancel-Lock: sha1:JQ1N2jIULZXUDPkwLm+ZzO4mgw0=
Bytes: 4116

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)]))