map, some, every, notany, notevery, reduce, remove-if and
many more.
Among the interesting additional functions used in the examples below are:
dolist, when, unless, push, nreverse .
Note also the use of keywords when calling functions and of auxiliary
arguments to functions.
;;;; FILTER
;;;; filters from the list l the elements that satisfy
;;;; the filter predicate and returns them in a list
;;; recursive definition
(defun filter (fn l)
(cond ((null l) nil)
((funcall fn (car l))
(cons (car l) (filter fn (cdr l))))
(t (filter fn (cdr l)))))
;;; iterative version
;;; note the use of &aux in the list of arguments to specify a local variable
;;; and, if needed, to initialize it
(defun filter (fn l &aux (newlist nil))
(dolist (elt l)
(when (funcall fn elt)
(push elt newlist)))
;; nreverse is the destructive version of reverse - faster and a better
;; choice when there is no risk of destroying a useful data structure
(nreverse newlist))
;;;; MAPPING AND REDUCTION
;;; the result type is specified by the first argument
(map 'string
;; note the use of # to specify the argument is a function
#'(lambda(x) (if (oddp x) #\1 #\0))
'(1 2 3 4))
;;; finds if there is at least an odd number in the sequence
(some #'oddp '(1 2 3 4 5))
;;; finds if all elements of the sequence are odd numbers
(every #'oddp '(1 2 3 4 5))
;;; finds if no element in the sequence is odd
(notany #'oddp '(1 2 3 4 5))
;;; finds if not every element in the sequence is odd
(notevery #'oddp '(1 2 3 4 5))
;;; combines all the elements of the sequence using a
;;; binary operation in a left associative way.
;;; Equivalent to (+ (+ (+ 1 2) 3) 4)
(reduce #'+ '(1 2 3 4))
;;; by default reduce is left associative
;;; this returns (((1 2) 3) 4)
(reduce #'list '(1 2 3 4))
;;; this is right associative since we are specifying that the keyword
;;; :from-end is true
;;; this produces (1 (2 (3 4)))
(reduce #'list '(1 2 3 4) :from-end t)
;;; COMPUTE THE INNER PRODUCT OF TWO VECTORS (STORED AS LISTS)
;;; The inner product is computed by multiplying each element of one list by
;;; the corresponding element of the other list and adding up all of those
;;; products. The two lists must have the same length.
(defun inner-product (lst1 lst2)
(if (not (eql (length lst1) (length lst2)))
(error "List Lengths are not equal")
(reduce #'+ (mapcar #'* lst1 lst2))))
(inner-product '(1 2 3) '(1 10 100)) = 321
;;; SUM THE SQUARE ROOTS OF THE POSITIVE NUMBERS IN A LIST
;;; from Norvig - page 840
(reduce #'+ (mapcar #'sqrt (remove-if-not #'plusp lst)))
;:: or, more efficiently
(let ((sum 0))
(dolist (num lst sum)
(when (plusp num)
(incf sum (sqrt num)))))
;;; mapcan is useful to return a variable number of arguments from a filter
(mapcan #'(lambda (x)
(when (and (numberp x) (evenp x))
(list x)))
'(1 2 3 4 x 5 y 6 z 7))
= (2 4 6)
do, dolist, dotimes.
The mapping functions we saw earlier can also be used to avoid writing
iterations explicitely.
;;;; REMOVE FROM A LIST ALL THE ELEMENTS THAT BELONG TO ANOTHER LIST
;;; recursive function. This is not tail recursive
;;; not a good way of writing it!
(defun remove-seen (items list)
(cond ((null items) nil)
;; we use equal since the elements can be of any type
((member (car items) list :test #'equal)
(remove-seen (cdr items) list))
(t (cons (car items)
(remove-seen (cdr items) list)))))
;;; iterative version. This is faster
(defun remove-seen-2 (items list &aux (newseq nil))
(dolist (item items)
(unless (member item list :test #'equal)
(push item newseq)))
(nreverse newseq))
;;; this is simpler. It uses the function remove-if
;;; remove-if is non destructive, delete-if is destructive
(defun remove-seen (items list)
;; note the use of lambda to specify the predicate to be applied
;; to each element of items
(remove-if #'(lambda (node) (member node list :test #'equal))
items))
;;;; INVERT AN ASSOCIATION LIST
;;; iterative version
(defun invert (alist &aux newlist)
(dolist (entry alist)
(let ((key (car entry))
(value (cadr entry)))
(let ((newentry (assoc value newlist)))
;; if there is no entry for value create it
(cond ((null newentry)
(push (list value key) newlist))
;; otherwise change it
;; as suggested by Doug Perrin (thanks!)
(t (push key (cdr newentry)))
))))
newlist)
; Example:
; (invert '((apple red)(raisin yellow)(banana yellow)
; (carrot orange)(cherry red)))
;
; ((ORANGE CARROT) (YELLOW BANANA RAISIN) (RED CHERRY APPLE))
;;; this uses mapcar and remove-if/remove-if-not as filters
(defun invert (alist)
(if (null alist)
nil
(cons (cons
;; takes the first value
(cadar alist)
;; collects keys of entries with same value
(mapcar #'car
(remove-if-not
#'(lambda (record)
(eql (cadr record) (cadar alist)))
alist)))
;; removes all pairs already considered and continues
(invert (remove-if
#'(lambda (record)
(eql (cadr record) (cadar alist)))
alist)))))
; Example:
; (invert '((apple red)(raisin yellow)(banana yellow)
; (carrot orange)(cherry red)))
;
;((RED APPLE CHERRY) (YELLOW RAISIN BANANA) (ORANGE CARROT))
;;; TRANSPOSE A 2-DIMENSIONAL MATRIX.
;;; this solution is iterative and uses the array functions
(defun transpose (matrix &aux newmatrix)
;; this creates a new array
(let ((newmatrix (make-array (array-dimensions matrix))))
(dotimes (i (car (array-dimensions matrix)))
(dotimes (j (car (array-dimensions matrix)))
(setf (aref newmatrix i j)
(aref matrix j i))))
newmatrix))
;;; this solution assumes the matrix is a list of lists
;;; can you figure out how it works?
(defun transpose-1 (m)
(cond ((null (car m)) nil)
(t (cons (mapcar #'car m) (transpose-1 (mapcar #'cdr m))))))
; try this example
(transpose-1 '((1 2 3) (4 5 6) (7 8 9)))
;;; this also assumes the matrix is a list of lists. It is more compact
;;; then the previous one but very similar
(defun transpose-2 (m)
(apply #'mapcar (cons #'list m)))