` 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)))