elegant way to count items - emacs

I have a list shaped like this:
'(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))
How can I count the total number of occurrences of the terms in the car of each element in the list? Basically I want:
(("Alpha" . 4)
("Beta" . 5)
("Gamma" . 3)
("Rho" . 1))
No, this is not homework. I just don't have the "thinking in Lisp" thing quite yet.
In C#, I would use LINQ to do this. I can do it in lisp, too, using while loops and such but the way I am thinking of doing it seems overly complicated.
EDIT
This is what I have:
(defun count-uniq (list)
"Returns an alist, each item is a cons cell where the car is
a unique element of LIST, and the cdr is the number of occurrences of that
unique element in the list. "
(flet ((helper (list new)
(if (null list)
new
(let ((elt (assoc (car list) new)))
(helper (cdr list)
(if elt
(progn (incf (cdr elt)) new)
(cons (cons (car list) 1) new)))))))
(nreverse (helper list nil))))

(defun freqs (list &optional test key)
(let ((h (make-hash-table :test test)))
(dolist (x list)
(let ((key (if key (funcall key x) x)))
(puthash key (1+ (gethash key h 0)) h)))
(let ((r nil))
(maphash #'(lambda (k v) (push (cons k v) r)) h)
(sort r #'(lambda (x y) (< (cdr x) (cdr y)))))))
(freqs '(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))
#'equal #'car)

Combining higher level Common Lisp functions:
(defun count-unique (alist)
(mapcar
(lambda (item)
(cons (car item)
(count (car item) alist :test #'equal :key #'car)))
(remove-duplicates alist :test #'equal :key #'car)))
It doesn't scale to large lists though. If you need O(n) performance use a hash table based solution instead, such as the less elegant:
(defun count-unique (alist)
(loop
with hash = (make-hash-table :test #'equal)
for (key . nil) in alist
do (incf (gethash key hash 0))
finally (return
(loop for key being each hash-key of hash
using (hash-value value)
collect (cons key value)))))

I dunno that this is the most elegant, but it seems reasonable:
(defun add-for-cheeso (data)
(let (result)
(dolist (elt data result)
(let ((sofar (assoc (car elt) result)))
(if sofar
(setcdr sofar (1+ (cdr sofar)))
(push (cons (car elt) 1) result))))))

Using Common Lisp extensions:
(require 'cl)
(loop with result = nil
for (key . dummy) in original-list
do (incf (cdr (or (assoc key result)
(first (push (cons key 0) result)))))
finally return (sort result
(lambda (a b) (string< (car a) (car b)))))
You can just say finally return result if you don't care about sorting the final result.

Every time you want to traverse a list and return some value afterwards, be it a new list or some aggregate result, you are thinking of a fold, also called "reduce" in Python and Lisps. Fold is a great abstraction, as it allows to write generic code, applicable for many use-cases just by tweaking some elements. What is similar between finding a sum of several numbers, finding a product, finding a minimum integer? They are all folds, because you run through the list and then return some result based on its content. In Emacs Lisp they would look like this:
(reduce '+ '(1 2 3 4 5)) ; 15
(reduce '* '(1 2 3 4 5)) ; 120
(reduce 'min '(1 2 3 4 5)) ; 1
But folds are even more general than this. What is similar between finding a sum, counting a number of even numbers in a list, removing every odd number, and building a list with every number increased by 5? Every such function can be implemented by taking some base value, successively transform it, until you get the result. You take this base value, metaphorical blob of clay, call it "accumulator", then take one element from a list and based on this element do something to this blob of clay, make it a draft of a magnificent sculpture. Then you take the next element from a list and do something new to your sculpture. You repeat that until the list is empty and you end up with a masterpiece. It's as if every element of a list is a single instruction in a large recipe. Just bear in mind, that you are completely free to do anything with the clay, you don't have to use the list elements in the result directly—technically, this means that the accumulator (and, thus, the result) may be of different type.
(reduce '+ '(1 2 3 4 5) :initial-value 0) ; 15
(reduce (lambda (acc x) (if (evenp x) (1+ acc) acc)) '(1 2 3 4 5) :initial-value 0) ; 2
(reduce (lambda (x acc) (if (oddp x) acc (cons x acc))) '(1 2 3 4 5) :initial-value '() :from-end t) ; (2 4)
(reduce (lambda (x acc) (cons (+ x 5) acc)) '(1 2 3 4 5) :initial-value '() :from-end t) ; (6 7 8 9 10)
Note about reducing from end: lists in Lisps are not smart arrays like in Python or Java, they are linked lists, therefore accessing or changing an element somewhere in a list is an O(n) operation, while "consing" to the beginning of a list is O(1). In other words, appending an element to the end of a list is expensive, therefore Lispers usually add elements to the beginning of a list and then finally reverse the list, which is called push/nreverse idiom. If we did the ordinary reduce in the last 2 functions, we would cons 1 to the accumulator and get (1), then cons 2 to accumulator and get (2 1), until we get the correct result but upside-down. We could use reverse function afterwards, but luckily Emacs's reduce supports :from-end keyword argument, so it conses 5, then 4, then 3, and so on.
It's clear now, that your operation is a fold, traverse the original alist and count occurrences of each key. Before writing our fold, let's talk about alists first. Alist in Lisp is a poor man's hash-table. You don't usually tinker with a programming language's hash-table implementation details, do you? You work with an API. In Python this API looks like square bracket syntax (d['a'] = 1) and dict methods (d.keys()). For alists API contains function assoc, which returns an item provided a key.
(assoc 'a '((a . 1) (b . 2))) ; (a . 1)
Why do I talk about implementation details? Because you work via assoc and you don't care how exactly this alist looks like, you abstract that away. Another piece of API is that if you want to add a new element or change an existing one, you simply cons a dotted pair to the alist. It's how you supposed to work with alists, regardless of their internal structure. Why does that work? For example, if I want to change value for key a to 10, I would simply run (cons '(a . 10) my-alist), and my-alist would end up being '((a . 10) (a . 1) (b . 2)). But it's no problem, because assoc returns only the first dotted pair and ignores the rest, so you can treat alist just like any other key-value data structure. With that in mind let's write our first serious fold.
(reduce (lambda (acc x)
(let* ((key (car x))
(pair (assoc key acc))
(count (cdr pair)))
(if pair
(cons (cons key (1+ count)) acc)
(cons (cons key 1) acc))))
my-alist
:initial-value '())
What happens here? We take your data and an empty list, which will soon become our desired result. At each step we take a pair from data and ask: does our result contain info about this pair? If not, then we add it to the result and put 1—we met this key for the first time. However, if we do find info about this pair in our result, then we must again add it to our result, but this time with a number increased by 1. Repeat that process for every item in your data, and you get:
(("Alpha" . 4) ("Gamma" . 3) ("Gamma" . 2) ("Rho" . 1) ("Alpha" . 3)
("Beta" . 5) ("Beta" . 4) ("Beta" . 3) ("Alpha" . 2) ("Beta" . 2)
("Gamma" . 1) ("Beta" . 1) ("Alpha" . 1))
Remember that assoc only cares about the first occurrence of a key? This alist would behave the same as if it was just (("Alpha" . 4) ("Gamma" . 3) ("Rho" . 1) ("Beta" . 5)), so we're good here. Still, could we change our fold as to get the latter, shorter result instead? Hold on, what's the need to over-complicate our fold, if we could just tweak the result afterwards? After all, what is computer programming, if not series of data transformations? There is no reason why you couldn't just remove all the "obsolete" pairs from your alist, just use cl-remove-duplicates with correct arguments, and you're done.
So we're proud of ourselves, we wrote a fold, a pillar of functional programming, yet careful examination exposes an inefficiency: we traverse the accumulator with assoc to find a pair and its value to increment. assoc takes O(n), reduce itself takes O(n), therefore our algorithm is O(n²) (read about order of growth, if you don't understand Big-O notation). It's clear that we should better work with a proper optimized hash-table instead, and convert it to an alist when we need. Rewrite our fold:
(reduce (lambda (acc x)
(cl-incf (gethash (car x) acc 0))
acc)
my-alist
:initial-value (make-hash-table :test 'equal))
(gethash k d 0) is equivalent to Python's d.get('k', 0), where the last argument is default. cl-incf (Common Lisp equivalent incf) is a smart macro that increments its argument in-place (read about setf to understand smart assignments). make-hash-table requires custom test function, because strings can't be compared with default eql function. To get an alist, just convert the result hash-table of our fold with ht->alist function, that we either take from Wilfred's ht.el library, or write ourselves:
(defun ht->alist (table)
(let (alist)
(maphash (lambda (k v)
(push (cons k v) alist))
table)
alist))

(require 'cl)
(defun count-uniq (list)
(let ((k 1) (list (sort (mapcar #'car list) #'string<)))
(loop for (i . j) on list
when (string= i (car j)) do (incf k)
else collect (cons i k) and do (setf k 1))))

Using high-order functions sort and reduce.
First sorting (using string<) then reducing (counting consecutive string= values in cons cells):
(reduce (lambda (r e)
(if (and r (string= (caar r) e))
(cons
(cons (caar r) (1+ (cdar r)))
(cdr r))
(cons (cons e 1) r)))
(sort (mapcar 'car alist) 'string<)
:initial-value nil)

This is pretty easy and very straightforward using the dash library:
(require 'dash)
(-frequencies (mapcar #'car my-list))
-frequencies was introduced in v2.20.0.

Here's what I think is an elegant functional solution using Emacs' alist functions, yielding a reusable frequencies function similar to Eli's answer:
(defun frequencies (vals)
(reduce
(lambda (freqs key)
(cons (cons key (+ 1 (or (cdr (assoc key freqs)) 0)))
(assq-delete-all-with-test key freqs 'equal)))
vals
:initial-value nil)))
(frequencies (mapcar 'car
'(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))))
=> (("Alpha" . 4) ("Gamma" . 3) ("Rho" . 1) ("Beta" . 5))

Thanks to the support of cl-incf for alist-get:
;; (require 'cl-lib)
(defun simple-count (seq)
"Count each unique element in SEQ."
(let (counts)
(dolist (element seq)
(cl-incf (alist-get element counts 0 nil 'equal)))
counts))
Example:
(let ((data '(("Alpha" . 1538)
("Beta" . 8036)
("Gamma" . 8990)
("Beta" . 10052)
("Alpha" . 12837)
("Beta" . 13634)
("Beta" . 14977)
("Beta" . 15719)
("Alpha" . 17075)
("Rho" . 18949)
("Gamma" . 21118)
("Gamma" . 26923)
("Alpha" . 31609))))
(simple-count (mapcar 'car data)))
=> (("Rho" . 1) ("Gamma" . 3) ("Beta" . 5) ("Alpha" . 4))

Related

Check for proper list in Common Lisp

Is there a standard function in Common Lisp that can check against improper lists (i.e. circular and dotted lists) without signaling an error? list-length can check against circular lists (it returns nil for them), but signals type-error when given a dotted list.
Scheme's list? traverses the whole list to make sure it is not dotted or circular; Common Lisp's listp only checks that it's given nil or a cons cell.
Here's the simplest I could come up with:
(defun proper-list-p (x)
(not (null (handler-case (list-length x) (type-error () nil)))))
Since several implementations have been suggested and many unexpected problems have been found, here's a test suite for aspiring proper-list-p writers:
(defun circular (xs)
(let ((xs (copy-list xs)))
(setf (cdr (last xs)) xs)
xs))
(assert (eql t (proper-list-p '())))
(assert (eql t (proper-list-p '(1))))
(assert (eql t (proper-list-p '(1 2))))
(assert (eql t (proper-list-p '(1 2 3))))
(assert (not (proper-list-p 1)))
(assert (not (proper-list-p '(1 . 2))))
(assert (not (proper-list-p '(1 2 . 3))))
(assert (not (proper-list-p '(1 2 3 . 4))))
(assert (not (proper-list-p (circular '(1)))))
(assert (not (proper-list-p (circular '(1 2)))))
(assert (not (proper-list-p (circular '(1 2 3)))))
(assert (not (proper-list-p (list* 1 (circular '(2))))))
(assert (not (proper-list-p (list* 1 2 (circular '(3 4))))))
There is no standard function to do this, perhaps because such a function was seen as rather expensive if it was to be correct, but, really, this just seems like am omission from the language to me.
A minimal (not very performant) implementation, which does not rely on handling errors (Python people think that's a reasonable way to program, I don't, although this is a stylistic choice), is, I think
(defun proper-list-p (l)
(typecase l
(null t)
(cons
(loop for tail = l then (cdr tail)
for seen = (list tail) then (push tail seen)
do (cond ((null tail)
(return t))
((not (consp tail))
(return nil))
((member tail (rest seen))
(return nil)))))))
This takes time quadratic in the length of l, and conses proportional to the length of l. You can obviously do better using an hashtable for the occurs check, and you can use a tortoise-&-hare algorithm do avoid the occurs check (but I'm not sure what the complexity of that is off the top of my head).
I am sure there are much better functions than this in libraries. In particular Alexandria has one.
While thinking about this question, I also wrote this function:
(defun classify-list (l)
"Classify a possible list, returning four values.
The first value is a symbol which is
- NULL if the list is empty;
- LIST if the list is a proper list;
- CYCLIC-LIST if it contains a cycle;
- IMPROPER-LIST if it does not end with nil;
- NIL if it is not a list.
The second value is the total number of conses in the list (following
CDRs only). It will be 0 for an empty list or non-list.
The third value is the cons at which the cycle in the list begins, or
NIL if there is no cycle or the list isn't a list.
The fourth value is the number if conses in the cycle, or 0 if there is no cycle.
Note that you can deduce the length of the leading element of the list
by subtracting the total number of conses from the number of conses in
the cycle: you can then use NTHCDR to pull out the cycle."
;; This is written as a tail recursion, I know people don't like
;; that in CL, but I wrote it for me.
(typecase l
(null (values 'null 0 nil 0 0))
(cons
(let ((table (make-hash-table)))
(labels ((walk (tail previous-tail n)
(typecase tail
(null
(values 'list n nil 0))
(cons
(let ((m (gethash tail table nil)))
(if m
(values 'cyclic-list n tail (- n m))
(progn
(setf (gethash tail table) n)
(walk (cdr tail) tail (1+ n))))))
(t
(values 'improper-list n previous-tail 0)))))
(walk l nil 0))))
(t (values nil 0 nil 0))))
This can be used to get a bunch of information about a list: how long it is, if it is proper, if not if it's cyclic, and where the cycle is. Beware that in the cases of cyclic lists this will return circular structure as its third value. I believe that you need to use an occurs check to do this – tortoise & hare will tell you if a list is cyclic, but not where the cycle starts.
in addition, something slightly less verbose, than the accepted answer:
(defun improper-tail (ls)
(do ((x ls (cdr x))
(visited nil (cons x visited)))
((or (not (consp x)) (member x visited)) x)))
(defun proper-list-p (ls)
(null (improper-tail ls)))
or just like this:
(defun proper-list-p (ls)
(do ((x ls (cdr x))
(visited nil (cons x visited)))
((or (not (consp x)) (member x visited)) (null x))))
seen to pass all the op's test assertions
After our hopeless attempts with tailp, here, sth which uses the
sharp-representation of circular lists :) .
With regex (to detect circular sublist)
(setf *print-circle* t)
(ql:quickload :cl-ppcre)
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (cl-ppcre::scan "#\d+=(" (princ-to-string lst)))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
Without regex (cannot detect circular sublists)
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (string= "#" (subseq (princ-to-string lst) 0 1))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
(tailp l (cdr l)) is t for circular lists but nil for non-circular lists.
Credits to #tfp and #RainerJoswig who taught me this here .
So, your function would be:
(defun proper-listp (lst)
(or (null lst) ; either a `'()` or:
(and (consp lst) ; a cons
(not (tailp lst (cdr lst))) ; not circular
(null (cdr (last lst)))))) ; not a dotted list
By the way, I use proper-listp by purpose. Correct would be - by convetion proper-list-p. However, this name is already occupied in the CLISP implementation by SYSTEM::%PROPER-LIST-Pwhy the definition of the function raises a continuable error.
Conclusion of our discussion in the comment section:
The behavior of tailp for circular lists is undefined. Therefore this answer is wrong! Thank you #Lassi for figuring this out!

reversing list in Lisp

I'm trying to reverse a list in Lisp, but I get the error: " Error: Exception C0000005 [flags 0] at 20303FF3
{Offset 25 inside #}
eax 108 ebx 200925CA ecx 200 edx 2EFDD4D
esp 2EFDCC8 ebp 2EFDCE0 esi 628 edi 628 "
My code is as follows:
(defun rev (l)
(cond
((null l) '())
(T (append (rev (cdr l)) (list (car l))))))
Can anyone tell me what am I doing wrong? Thanks in advance!
Your code as written is logically correct and produces the result that you'd want it to:
CL-USER> (defun rev (l)
(cond
((null l) '())
(T (append (rev (cdr l)) (list (car l))))))
REV
CL-USER> (rev '(1 2 3 4))
(4 3 2 1)
CL-USER> (rev '())
NIL
CL-USER> (rev '(1 2))
(2 1)
That said, there are some issues with it in terms of performance. The append function produces a copy of all but its final argument. E.g., when you do (append '(1 2) '(a b) '(3 4)), you're creating a four new cons cells, whose cars are 1, 2, a, and b. The cdr of the final one is the existing list (3 4). That's because the implementation of append is something like this:
(defun append (l1 l2)
(if (null l1)
l2
(cons (first l1)
(append (rest l1)
l2))))
That's not exactly Common Lisp's append, because Common Lisp's append can take more than two arguments. It's close enough to demonstrate why all but the last list is copied, though. Now look at what that means in terms of your implementation of rev, though:
(defun rev (l)
(cond
((null l) '())
(T (append (rev (cdr l)) (list (car l))))))
This means that when you're reversing a list like (1 2 3 4), it's like you're:
(append '(4 3 2) '(1)) ; as a result of (1)
(append (append '(4 3) '(2)) '(1)) ; and so on... (2)
Now, in line (2), you're copying the list (4 3). In line one, you're copying the list (4 3 2) which includes a copy of (4 3). That is, you're copying a copy. That's a pretty wasteful use of memory.
A more common approach uses an accumulator variable and a helper function. (Note that I use endp, rest, first, and list* instead of null, cdr, car, and cons, since it makes it clearer that we're working with lists, not arbitrary cons-trees. They're pretty much the same (but there are a few differences).)
(defun rev-helper (list reversed)
"A helper function for reversing a list. Returns a new list
containing the elements of LIST in reverse order, followed by the
elements in REVERSED. (So, when REVERSED is the empty list, returns
exactly a reversed copy of LIST.)"
(if (endp list)
reversed
(rev-helper (rest list)
(list* (first list)
reversed))))
CL-USER> (rev-helper '(1 2 3) '(4 5))
(3 2 1 4 5)
CL-USER> (rev-helper '(1 2 3) '())
(3 2 1)
With this helper function, it's easy to define rev:
(defun rev (list)
"Returns a new list containing the elements of LIST in reverse
order."
(rev-helper list '()))
CL-USER> (rev '(1 2 3))
(3 2 1)
That said, rather than having an external helper function, it would probably be more common to use labels to define a local helper function:
(defun rev (list)
(labels ((rev-helper (list reversed)
#| ... |#))
(rev-helper list '())))
Or, since Common Lisp isn't guaranteed to optimize tail calls, a do loop is nice and clean here too:
(defun rev (list)
(do ((list list (rest list))
(reversed '() (list* (first list) reversed)))
((endp list) reversed)))
In ANSI Common Lisp, you can reverse a list using the reverse function (nondestructive: allocates a new list), or nreverse (rearranges the building blocks or data of the existing list to produce the reversed one).
> (reverse '(1 2 3))
(3 2 1)
Don't use nreverse on quoted list literals; it is undefined behavior and may behave in surprising ways, since it is de facto self-modifying code.
You've likely run out of stack space; this is the consequence of calling a recursive function, rev, outside of tail position. The approach to converting to a tail-recursive function involves introducing an accumulator, the variable result in the following:
(defun reving (list result)
(cond ((consp list) (reving (cdr list) (cons (car list) result)))
((null list) result)
(t (cons list result))))
You rev function then becomes:
(define rev (list) (reving list '()))
Examples:
* (reving '(1 2 3) '())
(3 2 1)
* (reving '(1 2 . 3) '())
(3 2 1)
* (reving '1 '())
(1)
If you can use the standard CL library functions like append, you should use reverse (as Kaz suggested).
Otherwise, if this is an exercise (h/w or not), you can try this:
(defun rev (l)
(labels ((r (todo)
(if todo
(multiple-value-bind (res-head res-tail) (r (cdr todo))
(if res-head
(setf (cdr res-tail) (list (car todo))
res-tail (cdr res-tail))
(setq res-head (list (car todo))
res-tail res-head))
(values res-head res-tail))
(values nil nil))))
(values (r l))))
PS. Your specific error is incomprehensible, please contact your vendor.

Converting a dotted pair to a two-element list in LISP

I am new to lisp and working on a homework problem to flatten a nested list. I have my funciton working except it needs to 'remove' dotted pairs. So given (1 (2 3) (4 . 5) ((6 7) (89))) my function should output (1 2 3 4 5 6 7 8 9).
So.. my actual question..
Given a dotted pair e.g (1 . 2), how can I get the list '(1 2)?
A cons cell is a structure that has two parts, called its car and its cdr. The pair (1 . 2) is a cons cell whose car is 1 and whose cdr is 2. Lists in Lisps are built up from cons cells and nil. How this works is described in lots of places, including the answer to Recursive range in Lisp adds a period? A list is either the empty list () (also called nil), or a cons whose car is the first element of the list and whose cdr is another list which is the rest of the list. That means that a list
(1 2)
is built of cons cells and nil as
(cons 1 (cons 2 nil))
If you've already got (1 . 2), then you can get 1 and 2 with car and cdr. You'd put them back together as just described. That is,
(let ((x '(1 . 2)))
(cons (car x) (cons (cdr x) nil)))
Alternatively, you could just use list:
(let ((x '(1 . 2)))
(list (car x) (cdr x)))
If you want to reuse the same cons cell, you could replace the cdr of the cell with (cons 2 nil). For instance (and note that we're not quoting the pair anymore, because modifying literal data is undefined behavior):
(let ((x (cons 1 2)))
(setf (cdr x) (cons (cdr x) nil))
x)
That could also be
(let ((x (cons 1 2)))
(setf (cdr x) (list (cdr x)))
x)
You could also use rplacd:
(let ((x (cons 1 2)))
(rplacd x (list (cdr x)))
x)

Lisp recursion with lists

I need a function that will take in a list with words and split that list into two lists if at any point the word 'FOO' is found. I have come up with a recursive solution, may not be the best, but I am having a bit of trouble. I only need to pass 1 argument, the list to be analyzed, but I do not know how to build up the second list off to the side. Any suggestions? Thanks!
;Splits a list into 2 if the word 'FOO' is present
;----------------------------------------------------------------------
;LOAD FILE: (load "C:\\split.lisp")
;USAGE: (split '(with great power foo comes great responsibility) '())
;OUTPUT: ((with great power)(comes great responsibility))
(defun split (x y)
(cond
( ;IF: first element in list is nil
(EQ (car x) nil)
x ;RETURN the list
)
( ;ELSE IF: first element is 'FOO'
(EQ (car x) 'FOO)
(cons (reverse y ) (cons (cdr x) nil))
)
( ;ELSE: recursively call split but pass the rest of x and
;prepend y with the head of x
t
(split (cdr x) (cons (car x) y))
)
) ;END cond
) ;END split
The first test should be different.
The following is not a really good solution: it is not tail-recursive and it uses side-effects. But still...
(defun split (x)
(cond ((null x) x)
((eq (first x) 'foo)
(list nil (rest x)))
(t (let ((l (split (rest x))))
(push (first x) (first l))
l))))
Above uses the PUSH macro. One of the interesting facilities of Common Lisp is that you can use places to modify. In this cases we modify the first sublist of our list to be returned. We push the first element of the list onto the first sublist.
CL-USER 12 > (split '(1 2 3 foo a b c))
((1 2 3) (A B C))
In Common Lisp one would usually write a solution in a non-recursive fashion.
In your recursive version, the typical way to reduce a function to one argument is this: Write the function with one argument and this function then calls a helper function with two arguments. The helper function can also be locally defined using LABELS.
Here's my take on it, using nothing but lists:
(defun split (lst)
(labels ((split-rec (lst a)
(cond
((or (null lst)
(eq (car lst) 'foo))
(values (reverse a) (cdr lst)))
(t (split-rec (cdr lst) (cons (car lst) a))))))
(split-rec lst ())))
split offloads most of the work to split-rec (defined in the labels call), which recursively consumes the list of tokens, until it reaches the end of the list, or sees 'foo. At that point, it immediately takes the remainder of the list and treats that as the second list. Because the first list (a) is being built-up recursively, split-rec has to reverse it before returning it.
Here are a couple of runs through the REPL:
> (split '(with great power foo comes great responsibility))
(WITH GREAT POWER) ;
(COMES GREAT RESPONSIBILITY)
> (split '(with great power comes great responsibility))
(WITH GREAT POWER COMES GREAT RESPONSIBILITY) ;
NIL
> (split nil)
NIL ;
NIL
> (split '(with great power foo comes great foo responsibility) :on 'foo)
(COMES GREAT) ;
(WITH GREAT POWER RESPONSIBILITY)
> (split '(foo with great power comes great responsibility) :on 'foo)
NIL ;
(WITH GREAT POWER COMES GREAT RESPONSIBILITY)
Most of the edge cases that I could think up are handled, and two lists are always returned. Callers can use multiple-value-bind to get both lists out, i.e.:
(multiple-value-bind (a b)
(split '(with great power foo comes great responsibility))
; do something useful with a and b
)
(defun split (lst)
(let* ((a (make-array (length lst) :initial-contents lst))
(index (position 'foo a)))
(cond ((null index) a)
(t (cons (loop for i from 0 to (1- index)
collect (aref a i))
(list (loop for i from (1+ index) to (1- (length a))
collect (aref a i))))))))
Create an array from the list so that there elements are easier to access.
Check if foo exists, if it does mark the index
Use loop to create two lists, one of the elements before foo, and another one of the elements after foo, and cons them together.
Here I've also tried! :)
There's one thing you would want to clarify though: in corner cases like: foo is the first element of the list, should you return two lists or only the second one? If foo is the last element in the list, should you return list and nil or only the first list? If foo isn't in the list, should you return just the list, or list and nil / nil and list?
(defun split (list &key (on-symbol 'foo))
(let (result result-head)
(mapl
#'(lambda (a)
(if (eql (car a) on-symbol)
(return-from split
(if result
(values result (copy-list (cdr a)))
(copy-list (cdr a))))
(if result
(setf (cdr result-head) (list (car a))
result-head (cdr result-head))
(setf result (list (car a))
result-head result)))) list) result))
(split '(1 2 3 4 5 foo a b c))
(split '(foo 1 2 3 4 5 foo a b c))
(split '(1 2 3 4 5 a b c))

(define (average ....)) in Lisp

I'm just playing around with scheme/lisp and was thinking about how I would right my own definition of average. I'm not sure how to do some things that I think are required though.
define a procedure that takes an arbitrary number of arguments
count those arguments
pass the argument list to (+) to sum them together
Does someone have an example of defining average? I don't seem to know enough about LISP to form a web search that gets back the results I'm looking for.
The definition would be a very simple one-liner, but without spoiling it, you should look into:
a "rest" argument -- this (define (foo . xs) ...xs...) defines foo as a function that takes any number of arguments and they're available as a list which will be the value of xs.
length returns the length of a list.
apply takes a function and a list of values and applies the function to these values.
When you get that, you can go for more:
see the foldl function to avoid applying a list on a potentially very big list (this can matter in some implementations where the length of the argument list is limited, but it wouldn't make much difference in Racket).
note that Racket has exact rationals, and you can use exact->inexact to make a more efficient floating-point version.
And the spoilers are:
(define (average . ns) (/ (apply + ns) (length ns)))
Make it require one argument: (define (average n . ns) (/ (apply + n ns) (add1 (length ns))))
Use foldl: (define (average n . ns) (/ (foldl + 0 (cons n ns)) (add1 (length ns))))
Make it use floating point: (define (average n . ns) (/ (foldl + 0.0 (cons n ns)) (add1 (length ns))))
In Common Lisp, it looks like you can do:
(defun average (&rest args)
(when args
(/ (apply #'+ args) (length args))))
although I have no idea if &rest is available on all implementations of Lisp. Reference here.
Putting that code into GNU CLISP results in:
[1]> (defun average (&rest args)
(when args
(/ (apply #'+ args) (length args))))
AVERAGE
[2]> (average 1 2 3 4 5 6)
7/2
which is 3.5 (correct).
Two versions in Common Lisp:
(defun average (items)
(destructuring-bind (l . s)
(reduce (lambda (c a)
(incf (car c))
(incf (cdr c) a)
c)
items
:initial-value (cons 0 0))
(/ s l)))
(defun average (items &aux (s 0) (l 0))
(dolist (i items (/ s l))
(incf s i)
(incf l)))
In Scheme, I prefer using a list instead of the "rest" argument because rest argument makes implementing procedures like the following difficult:
> (define (call-average . ns)
(average ns))
> (call-average 1 2 3) ;; => BANG!
Packing arbitrary number of arguments into a list allows you to perform any list operation on the arguments. You can do more with less syntax and confusion. Here is my Scheme version of average that take 'n' arguments:
(define (average the-list)
(let loop ((count 0) (sum 0) (args the-list))
(if (not (null? args))
(loop (add1 count) (+ sum (car args)) (cdr args))
(/ sum count))))
Here is the same procedure in Common Lisp:
(defun average (the-list)
(let ((count 0) (sum 0))
(dolist (n the-list)
(incf count)
(incf sum n))
(/ sum count)))
In Scheme R5RS:
(define (average . numbers)
(/ (apply + numbers) (length numbers)))