2
\$\begingroup\$

I'd like to find a more elegant solution to the following.

Below appears correct, but it's hard to read.

Is my first use of the map function below poor in stylistic terms?

It feels that way, and I'd like to pin down why.

I wonder what is a nicer way to achieve this.

;; ANSI Common Lisp ex 3.3, p56.
;; "Define a function that takes a list and returns a list indicating
;;  number of times each (eql) element appears, sorted from most common
;;  element to least common"
;; > (occurrences '(a b a d a c d c a))
;; ((A . 4) (C . 2) (D . 2) (B . 1))

(defun occurrences (lst)
  (labels ((build-flist (lst res)                                                            ; [1]
            (if (null lst)
                res
                (build-flist (cdr lst) (mapcar #'(lambda (x) (if (eql (car x) (car lst))     ; [2]
                                                                 (cons (car x) (1+ (cdr x))) ; [3] ; rtn inc'd freq entry
                                                                 x))                               ; rtn unchanged freq entry
                                               res))))
           (remove-dups (lst)                               ; [4]
            (if (null lst)
                nil
                (adjoin (car lst)
                        (remove-dups (cdr lst))))))

    (sort (build-flist lst (mapcar #'(lambda (x) (cons x 0)) (remove-dups lst))) ; [5]
          #'> :key #'cdr)))

;;[1] build-flist builds a frequency list. it is called like:
;;    (build-flist '(a b a d a c d c a) '((A . 0) (B . 0) (C . 0) (D . 0))
;;[2] map over entire res assoc list, incrementing frequency if it equals
;;    the el just removed from head of list, else just keep entry as is (inefficient).
;;[3] inelegant. in map, is there some kind of when form.                 ;; <<< STILL TENSION HERE, CODE IS HARD TO READ
;;[4] remove-dups uses adjoin, (set-based operator). this will help us    ;; --------------------------------------------
;;    build an zero-initialised freq list, to get us started.
;;[5] Finally, our actual function builds the frequency list, then sorts the result.
;;    We pass it a frequency list initialised to zero to get started.

;; Discussion
;; It doesn't always help to encapsulate helper functions in labels.
;; If the functions are simple, perhaps they could be global, if they're complex, perhaps they could be simplified.
```
\$\endgroup\$
2
\$\begingroup\$

One problem with build-flist is that it is a double loop. It iterates over the lst and for each element iterates over the result list (which has the same length minus duplicates). For each lst element, the result list gets copied by mapcar.

Also you iterate with recursion over the lst. The pattern to use here in Functional Programming would be a kind of reduce.

remove-dups would be the primitive function remove duplicates.

In typical Lisp style one would destructively update the result list. Since it is an assoc list, one could look up the element with assoc and update it.

first try with destructive updates

so, if we try to create the result list first:

(defun occurrences (list)
  (flet ((create-result-list (list)
           (mapcar (lambda (item)
                     (cons item 0))
                   (remove-duplicates list)))
         (count-occurrences (list result)
           (mapc (lambda (item)
                   (incf (cdr (assoc item result))))
                 list)
           result))
    (sort (count-occurrences list (create-result-list list))
          #'>
          :key #'cdr)))

second try with destructive updates

we can also build the result list, while we move over the list

(defun occurrences (list &aux result)
  (mapc (lambda (item &aux (pair (assoc item result)))
          (if pair
              (incf (cdr pair))
            (push (cons item 1) result)))
        list)
  (sort result #'> :key #'cdr))

It will still be slow for larger lists, but for many applications it might be sufficient and we can also add arbitrary tests, which with a hash-table might be more difficult...

\$\endgroup\$
  • \$\begingroup\$ As much as I appreciate Renzo's answer, I'm switching my correct answer to this one because it directly levels-up my original code and thereby provides great pedagogic value. \$\endgroup\$ – mwal Jul 7 at 12:46
  • \$\begingroup\$ Can we speak about these solutions being 'a kind of reduce' even though the result is a list, and not a single value? my intuition currently is that reduce means strictly(?) to transform a list to a single value somehow... Or, did you mean that my original build-flist could be changed to use reduce? (if yes, pls let me try it before revealing the answer.. :) Thanks for very cool answer. \$\endgroup\$ – mwal Jul 7 at 12:47
  • 1
    \$\begingroup\$ @mwal: the reduce would only return one value, but in this case it would be an assoc list, which would be built during the the reduce operation or which could be started with an initial value. \$\endgroup\$ – Rainer Joswig Jul 7 at 17:57
7
\$\begingroup\$

This is the typical situation where a hash table that maps elements to their frequency count is particularly well suited.

(defun occurrences (lst)
  (let ((table (make-hash-table)))                   ; [1]
    (loop for e in lst
          do (incf (gethash e table 0)))             ; [2]
    (sort (loop for k being the hash-key of table    ; [3]
                  using (hash-value v)
                collect (cons k v))                         
          #'>= :key #'cdr)))                         ; [4]
  1. We create the hash table: the key will be an element of the list, the value will be the frequency count. Note that it is not necessary to initialize it because the gethash function provide an initialization of the value for a key not already present in the table.

  2. For each element of the list we increment (incf) the frequency value associated to it. This value is obtained by gethash, and if it is not yet in the table, it is initialized by default to 0 (the last parameter of gethash).

  3. At the end, we use the “loop over hash table” syntax to collect all the pairs (key count) in a list, and we sort the list over the second element.

This solution is simple, very efficient and elegant.

If you want to use only lists, here is a solution that has the same complexity of the sorting algorithm:

(defun occurrences (lst)
  (if (null lst)                                            ; [1]
      nil
      (let ((sorted (sort (copy-list lst) #'string<=)))     ; [2]
        (do ((c 1)                                          ; [3]
             (l (cdr sorted) (cdr l))                       ; [4]
             (el (car sorted) (car l))                      ; [5]
             (res nil))                                     ; [6]
            ((null l)                                       ; [7]
             (sort (cons (cons el c) res) #'>= :key #'cdr)) ; [8]
          (if (eql (car l) el)                              
              (incf c)                                      ; [9]
              (progn
                (push (cons el c) res)                      ; [10]
                (setf c 1)))))))
  1. If the list is empty return nil.
  2. Sort the element by their names (assuming they are atoms), so that equal elements are contiguous.
  3. Start a loop. The variabile c count how many equal elements are found (the frequency).
  4. l is used to scan the sorted list. It starts from the second element of sorted.
  5. el is the current element, while (car l) is the second one.
  6. res is used to accumulate the result.
  7. The iteration stops when l reaches the end of the list.
  8. The result is obtained by adding the last couple (element, frequency) to the result, and sorting it by frequency.
  9. The body of the loop: if the first element is equal to the second one increment the counter and continue to iterate.
  10. Otherwise, a new element is found. So push the old one with its frequency on the result, and reset the counter to 1.
\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.