Lars Malmsteen
Lars Malmsteen

Reputation: 768

assoc function in Common Lisp and 2 questions

I've got a list which keeps occurances of letters in a sentence:

(setf mylist '((a 1) (b 2) (a 1) (b 1) (o 2) (m 1))) ; "abba boom"

I'd like to associate all pairs having for instance the letter b:

(assoc 'b mylist) ; => returns just the first occurance of b: (B 2)

How to get all pairs associated with b and list them? e.g.

(my-assoc 'b mylist) ; => ((B 2) (B 1))

2- How to write a function which will group the letters along with the sum of their occurances? e.g.

(my-group-sum mylist) ; => ((A 2) (B 3) (O 2) (M 1))

Here is my take, assuming that my-assoc as described above, exists:

(defun my-group-sum (lst) 
  (loop for (letter num) in lst do 
     (let ((temp (my-assoc letter lst)) 
           (occurance 0)) 
          (dolist (pair temp) 
             (incf occurance (cdr pair)))); cdr should be "second" 
          collect (letter occurance)))

Note: This code is not compiled, nor tested. It's very likely to be erroneous even if the my-assoc function was available. It's just for demonstation purposes.

Upvotes: 0

Views: 646

Answers (2)

Renzo
Renzo

Reputation: 27424

To complete the excellent and detailed answer of @coredump, I would like to mention a different (and more efficient) approach to the “group by” problem presented in the question.

This approach simply scans the list only once to perform the operation, using a hash table to collect the sums:

CL-USER> (defun my-group-sum (lst)
           (let ((table (make-hash-table)))
             (loop for (letter num) in lst
                   do (incf (gethash letter table 0) num))
             (loop for key being the hash-key of table
                   using (hash-value val)
                   collect (list key val))))
MY-GROUP-SUM
CL-USER> (my-group-sum '((a 1) (b 2) (a 1) (b 1) (o 2) (m 1)))
((B 3) (M 1) (O 2) (A 2))

In the first loop (gethash letter table 0), if letter does not exist in the table, creates an entry for it with the value 0, or returns the current value of letter, and incf increments it by adding the current number.

The second loop simply collects the result. Of course if you need it sorted in some way you need to add an explicit call to sort.

Upvotes: 2

coredump
coredump

Reputation: 38809

Let's use the same example, I am using defvar to declare the variable properly:

(defvar *list* '((a 1) (b 2) (a 1) (b 1) (o 2) (m 1)))
  1. How to get all pairs associated with b and list them?

Common Lisp defines REMOVE, that builds a new list with some elements removed. Sometimes you want the contrary, a function that only keeps certain elements. In order to do that, you have to take the complement function. For example:

(remove 'a *list* :test-not #'eq :key #'car)
=> ((A 1) (A 1))

The above means we remove elements x such that (eq 'a x) is false, due to the :test-not argument. The :key argument says that we compare entries by their first elements.

You could roll your own with a loop:

(loop 
  for entry in *list* 
  when (eq (car entry) 'a)
    collect entry)
  1. How to write a function which will group the letters along with the sum of their occurances?

You provided some attempt, here it is formatted:

(defun my-group-sum (lst)
  (loop
     for (letter num) in lst
     do (let ((temp (my-assoc letter lst)) (occurance 0))
          (dolist (pair temp)
            (incf occurance (cdr pair))))
     collect (letter occurance)))

Some things are not good, and if you test this code in a live environment, you should have errors either when you compile the function (if your Lisp compiles code), or when running the code in a test. Let's review some problems:

  • occurance is spelled occurrence (a minor problem, but it helps to check that)
  • (letter occurance) is not how you build list, you should call (list letter occurance) otherwise it means: call function letter with argument occurance, even though there is no such letter function defined here (probably), and because you want to return a list of two elements.

  • when you try to build (list letter occurance), the symbol occurance is not bound in the lexical scope. It was bound inside the let in the do loop-expression, but here you use it outside of that scope. Better call collect directly:

Here is a reworked version:

(defun my-group-sum (lst)
  (loop 
     for (letter num) in lst
     collect (let ((temp (remove letter lst :test-not #'eql :key #'car)) 
                   (occurance 0))
               (dolist (pair temp)
                 (incf occurance (cdr pair)))
               (list letter occurance))))

The last form in the let returns the result that is collected.

Now, if you test your code, you are going to see that there is a problem: lst is unmodified by the call to remove (it builds a fresh list), which means you may find other matches in the main loop. For example, at first you have:

((a 1) (b 1) (a 1))

The first iteration of the loop collects (a 2), but then the remaining iteration is made on ((b 1) (a 1)), which still contains an a.

An alternative would be to mutate the binding lst, or mutating the list. I am not sure if all implementations react well if you change the list over which you iterate in a loop, and mutating is forbidden by the standard according to 3.6 Traversal Rules and Side Effects .

The usual way to make a value change iteratively is:

(loop for var = <init> then <next>)

... where what follows when is the next list to use. You could adapt your algorithm to return the list from which you remove an item.

But the first approach for this would be to divide-and-conquer the problem:

  • write a function aggregate-step that takes a list and returns two values in a list: (1) an accumulated entry which is either nil or a form (name count) and (2) the next list to use.
  • write the fixpoint loop that calls it. Assuming you use (list entry rest) to return the two values, and that entry might be nil, here is how the loop looks like:

    (loop 
      for curlist = lst then rest
      for (entry rest) = (aggregate-step curlist)
      while entry
        collect entry)
    

Upvotes: 2

Related Questions