Below is what I am looking to do:

(countsym '(w x y z) '(a x (b y y (z) z)))

I have done this so far, but it doesn't do much.

(defun countsym (item exp)
 (setq data (car item))
 (countsymhelper (data list))
)

     some-func(data, list)

In Lisp we say: (some-func-or-special-form data list)

[aside: With macros, we often say (with-this-macro (data list) ...macro
body), but that boils down to:
    (with-this-macro data list &body macro-body)

Forget I mentioned this, too advanced just now.]

So: first, try writing:

(defun count-sym (sym expr) ...)

Then worry about how to handle a list of syms and making them into an assoc.

(defun count-obj-in-tree (obj list &key (test 'eql))
  (let ((count 0))
    (labels ((count-instances (obj list)
               (loop for item in list
                     do
                     (typecase item
                       (list (count-instances obj item))
                       (t
                        (when (funcall test obj item)
                          (incf count)))))))
      (count-instances obj list)
      (values obj count))))

(defun countobjs (objs list &key (test 'eql))
  (loop for obj in objs
        collect
        (multiple-value-list (count-obj-in-tree obj list :test test))))

Of course beware of stack overflow problems, etc etc.  This code
only works for lisp expressions which are basically lists.

Why shouldn't one do the same thing in CL ?
Won't it be faster ?

--Vardhan

On 2002-12-02, Wade Humeniuk <w...@nospam.nowhere> wrote:

(defun count-symbols-in-expression (symbol-list expression)
  (let ((symbol-counts (make-hash-table :test #'eq)))
    (labels ((count-the-symbols (tree-part)
               (cond
                ((symbolp tree-part)
                 (incf (gethash tree-part symbol-counts 0)))
                ((consp tree-part)
                 (count-the-symbols (car tree-part))
                 (count-the-symbols (cdr tree-part))))))
      (count-the-symbols expression)
      (loop for symbol in symbol-list
        collect (cons symbol (gethash symbol symbol-counts))))))

  Look for two things in this code: How it is formatted, and how it does
  its work.  (The way you have formatted your code annoys people.)  Explain
  to me why this works and gives the right answer when you have ascertained
  that it does.  Explain why it is efficient in both time and space.

(defun count-member (symbols tree)
  (let* ((counts (loop for symbol in symbols collect (cons symbol 0)))
         (lists (list tree))
         (tail lists))
    (dolist (list lists)
      (dolist (element list)
        (cond ((consp element)
               (setf tail (setf (cdr tail) (list element))))
              ((member element symbols :test #'eq)
               (incf (cdr (assoc element counts :test #'eq)))))))
    counts))

--
Erik Naggum, Oslo, Norway

(defun countsymhelper (sym exp)
    (cond
      (  (null exp) 0)
      (  (atom exp) (countjustsym sym exp))
      (T (+ (countsymhelper sym (car exp))
               (countsymhelper sym (cdr exp)))
         )
        )
)

(defun countjustsym (s1 s2)
    (if (eql s1 s2)
        1 ;if there is a match, return 1, else return 0
        0)
)

(defun countsym (items exp)
 (mapcar (lambda (sym) (list sym (countsymhelper sym exp))) items)

)

  No.  Please see the glossary entry for object-traversing.  If you really
  /feel/ this is bogus, just unroll the `dolist´ macro.  No problem, right?

--
Erik Naggum, Oslo, Norway

  /Please/ pay attention to how Common Lisp programmers format their code.

--
Erik Naggum, Oslo, Norway

I agree that normal practice is to expand into something that walks
the list once, but I think ANSI was careful not to mandate this; the
downside of this absence of mandate is that you have to be slightly
more careful than you might otherwise want to be.

  I do not see how mapping and list traversal are even remotely connected.

| and the CLHS page on DOLIST does not seem to give a guarantee that
| your view is the right one; in fact, it seems to go out of its way not
| to:
|   dolist evaluates list-form, which should produce a list. It then
|   executes the body once for each element in the list, in the order in
|   which the tags and statements occur, with var bound to the
|   element. Then result-form is evaluated. tags label statements.

  This appears to be an argumentum ad ignorantiam.  It does not say, from
  which you can legitimately conclude nothing.

| I agree that normal practice is to expand into something that walks the
| list once, but I think ANSI was careful not to mandate this;

  I do not see how you find evidence for this.

| the downside of this absence of mandate is that you have to be slightly
| more careful than you might otherwise want to be.

  Oh, Christ.  So unroll the goddamn list, already.

  Instead of getting the point, that you can traverse a tree without
  resorting to recursion, we have this moronic quibble.  Fuck it.

--
Erik Naggum, Oslo, Norway

 Ain't CL programmer too valuable to waste on that ...

  I'll check back to see if comp.lang.lisp has improved in 2003.

--
Erik Naggum, Oslo, Norway

  The interaction of mapping functions and DOLIST with destructive
  operations on the list being operated on is unclear. For example, if
  you destructively modify some tail of a list being mapped down, does
  that affect the mapping process?

My phrasing was unclear above ("walks the list once", ugh)... what I
meant by that was something along the lines of the following: one
might wish to implement DOLIST by calculating the length of the list
in question, generating a destructuring argument list and
destructuring the list, then successively binding the iteration
variable to each destructuring variable in turn.  Right now I'm not in
the mood to think of whether this or some other strategy might open
the way to optimizations, but maybe the standardizers did think (or
just evaluated current practice and found it non-uniform).

A bit of a curmudgeon this morning, I admit. :-)

You are right. From now on when we see this we can respond "...and
please pare your parentheses over a wastebasket next time". This is
Lisp, our put-downs should be better, too.

btw, did you know the Japanese invented a fingernail clipper which
captures the parings? It roolz.

Finally, full marks to Travis for enduring hours of Socratic instruction
spread over dozens of emails. If only I could have sold him on
countSymHelper and countJustSym as spellings. :)

--

  I see.

| Not at all -- it does not say, from which you can conclude (well, if
| you read the rest of the standard as well, and if it does not say
| anywhere) that it does not say.

  Amazing.

| Have you read the issue that I referred to?

  Yes.

| one might wish to implement DOLIST by calculating the length of the list
| in question, generating a destructuring argument list and destructuring
| the list, then successively binding the iteration variable to each
| destructuring variable in turn.

  If you do this, or the braindamaged attempt you started with, I am not
  going to use your implementation and if I find a bug because of such a
  moronic attempt to make life as hard as possible for your users, I will
  replace your rotten `dolist´ with one that works as expected.

  Why do I think this rebarbative complaint is meretricious?  Superficially,
  adherence to the standard is a high and noble goal, but when invoked where
  it clearly has no place in intelligent implementations, and where rational
  circumventions of the supposed violation is the obvious /expansion/ of the
  /macro/ under question, it sullies the value of conformance.  Those who do
  not want to pay much attention to the standard can then point to the
  cantankerous quibblers and catamarans who engage in invention of clearly
  insane implementation techniques in their overzealous attempts to show
  that one cannot guard against excesses in human stupidity.  However, if
  Common Lisp were a language designed /by/ morons /for/ morons, we would
  also need a battery of "guarantees" from the standard that implementors
  with an IQ below that of U.S. Presidents would be forced to follow under
  threat of military action against them.  Common Lisp is a language by and
  for people with working brains.

  The standard is not some license for academic masturbators to be creative
  at the expense of the programmers with the excuse that they are conforming
  to some bogus "letter of the standard".

  The spirit of the standard is more important than the letter.  Prohibition
  against messing with the traversed list structure is obviously a good idea
  for functions where the traversal mechanism is opaque, as in `mapcar´, but
  it is nuts to claim that `dolist´ should be similarly constrained for the
  tail of the list.  (Messing with the cdr /chain/ is obviously moronic as
  there is no guarantee that, e.g., `delete´ would have only and exactly
  harmless effects, but appending to the tail?  Gimme a freaking break!)

  I refuse to consider your bogus implementations of `dolist´ as /possible/
  unless one wishes to prove a point, which means you would have to be more
  than pathologically anal-retentive to /actually/ do such a stupid thing.
  If you want languages that are created mainly to prove some irrelevant
  point, try Scheme or the functional languages.  Common Lisp is a language
  for getting the job done while being both elegant and intelligent.  Common
  Lisp should ideally be off-limits to morons.

  This was the last time I post any code to this goddamn newsgroup.  It was
  a mistake to post code to begin with.  I apologize for upsetting the anal-
  retentive so much.  Had I known I had posted to an audience of rejects for
  the leading role of "Rain Man", I would have shut up long ago.  Fuck it.

--
Erik Naggum, Oslo, Norway

Nicolas.

Here is a one pass, non recursive version, just for the fun of it.

(defun countobjs (objs tree &key (test 'eql))
  (let ((counts (make-array (length objs) :element-type 'integer
                            :initial-element 0))
        (expr-holder nil))
    (push tree expr-holder)
    (tagbody
     process-expr
     (when (null expr-holder) (go finished))
     (let ((expr (pop expr-holder)))
       (typecase expr
         (cons
          (push (cdr expr) expr-holder)
          (push (car expr) expr-holder)
          (go process-expr))
         (t
          (let ((position (position expr objs :test test)))
            (when position (incf (aref counts position))))))
       (go process-expr))
     finished)
    (map 'list 'cons objs counts)))

| (defun count-member (symbols tree)
|   (let* ((counts (loop for symbol in symbols collect (cons symbol 0)))
|          (lists (list tree))
|          (tail lists))
|     (dolist (list lists)
|       (dolist (element list)
|         (cond ((consp element)
|                (setf tail (setf (cdr tail) (list element))))
|               ((member element symbols :test #'eq)
|                (incf (cdr (assoc element counts :test #'eq)))))))
|     counts))

Recent flamage aside, is there any particular reason you implement
lists as a FIFO? Wouldn't a stack do just as well? Except, of course,
you could no longer use dolist, but would need a different iteration
construct. The technique of keeping a copy of the end of the list to
efficiently add new stuff is an important one, but to me it seems
slightly obfuscated to do so unless it's really needed.

My other remark is that one could skip the check for membership in
SYMBOLS, since that can just as well be accomplished by the assoc
call. On the other hand, I guess assoc is somewhat slower than member,
since it has to follow more links: one caar, instead of just a car,
each time you cdr down the list. So my code below should be faster
than yours if most symbols in TREE occur in SYMBOLS, whereas your code
wins if most of them do not.

So I ended up with this code:

(defun count-member (symbols tree)
  (loop with counts = (loop for symbol in symbols collect (cons symbol 0))
        for (list . lists) = (list tree) then lists
        do (dolist (element list)
             (if (consp element)
                 (setf lists (cons element lists))
                 (let ((pair (assoc element counts :test #'eq)))
                   (when pair (incf (cdr pair))))))
        when (null lists)
        do (return counts)))

Now this whole discussion may seem like a case of premature
optimization, but to me it's more a question of style. I tend to
prefer avoiding duplicate work from the outset, at least as long as it
takes as little effort as it does in this case. Not that I am saying
that my code is better than yours, it is only different.

  The didactic purpose of that device has been entirely obliterated by nit-
  picking.  Instead of trying to get the /point/, relative to the original
  poster's request, choosing to nitpick this to death destroyed the ability
  of anyone, including the original poster, to figure this one out by an
  action of /thought/.  Blatant disregard for the purpose other people may
  have for what they do really pisses me off.  Besides, I wanted the student
  in question to be reprimanded by his teacher if the code was handed in.
  The idiotic responses I got to this example has truly shown me that on
  Usenet, you should /never/ try to do something that relies on the ability
  of people to shut the fuck up because they figure out what it is going on.

  I cannot /fathom/ why people are now trying to improve on my code.  What
  on earth possesses you to ignore the fact that the original poster had a
  clear and sound purpose with his question?  And who wants to post code in
  a milieu that lets not a single opportunity to "improve" on some code that
  has everything /but/ optimality according to such highly personal needs as
  its goal?  Normally, people are able to avoid explaining everything they
  want to do in high-resolution detail, but if every single didactic example
  or presentation has to explain enough to the eager bystanders that they
  want to curb their enthusiasm for correcting and improving others for no
  reason whatsoever, every single answer with code becomes like a published
  thesis in complexity for the author.  What the hell is this /good/ for?
  There is a level of egotism in the need to correct others and a level of
  egoism in ignoring the purpose of the article they "correct" according to
  other purposes than it was written that betray a fantastically hostile
  attitude to people who want to encourage people to /think/ about something
  as stepping stones to achieving an understanding of the questions they
  actually asked.  Some fucking dimwit always has to butt in and destroy any
  setup and derail the discussion that could have led the original poster to
  a realization that said dimwit obviously does not share, solely because
  they think they can "contribute" even though they absolutely fail to grasp
  the point of what they are criticizing.

  "I may be mistaken, but the present-day writer, when he takes his pen in
  hand to treat a subject which he has studied deeply, has to bear in mind
  that the average reader, who has never concerned himself with this subject,
  if he reads does so with the view, not of learning something from the
  writer, but rather, of pronouncing judgment on him when he is not in
  agreement with the commonplaces that the said reader carries in his head."
                   -- José Ortega y Gasset, The Revolt of the Masses, 1929.

--
Erik Naggum, Oslo, Norway

|   The didactic purpose of that device has been entirely obliterated
|   by nitpicking.  [...]  Blatant disregard for the purpose other
|   people may have for what they do really pisses me off.

Sorry, no disregard was intended.  I guess I hadn't quite realized
what you were doing.

|   I cannot /fathom/ why people are now trying to improve on my code.

Not trying to improve it really. I am still learning myself (and
expect never to stop doing so), and although this is beginners'
material, I still find it useful sometimes to consider different ways
of attacking a problem and to discuss various approaches. In fact, the
very simplicity of the problem makes it easy to study a variety of
solutions without getting bogged down in technical detail.

I guess what this incident shows more than anything else is that one
cannot teach by committee.

|   There is a level of egotism in the need to correct others

I have no such need. Besides, I know perfectly well that you can code
circles around me any time of the day (after all /I/ am not a
professional programmer), so in general it would be stupid of me to
try to improve on your code. I merely noticed some puzzling points of
your code and wanted to ask about it. I am sorry I didn't realize that
those were didactic devices, or I would of course have staid out of
it. (But the discussion was already badly derailed. Rightly or
wrongly, I thought that even if I didn't move it back on track I had
given it a modest push in the right direction.)

Well, enough said I think.

I wrote a similar function, but it also builds the symbol list, thus
counting /all/ recurring symbols in the expression. Why did I do this?
Because I'm learning CL. I'm posting this in the hope that some of the
experts here might want to critique my code. I wrote it in a functional
kind of way, are there any performance considerations to this? (My
previous Lisp experience is mainly related to Scheme.)

(defun count-symbols (tree)
  (labels ((iter (tree symbols)
             (let ((symbol (car tree)))
               (cond ((null symbol) symbols)
                     ((symbolp symbol)
                      (iter (cdr tree) (inc-count symbol symbols)))
                     ((consp symbol)
                      (iter symbol (iter (cdr tree) symbols))))))
           (inc-count (symbol alist)
             (if (null alist)
                 (acons symbol 1 alist)
                 (let ((item (assoc symbol alist)))
                   (cond ((null item) (acons symbol 1 alist))
                         (t (incf (cdr item))
                            alist))))))
    (iter tree '())))

Works like this:

[1]> (count-symbols '(a b (c (c b e) (b) (a c a))))
((E . 1) (C . 3) (B . 3) (A . 3))
[2]>