;; fold and filter
(defun foldr (f a l)
  (if (null l) 
      a
     (f (car l) (foldr f a (cdr l)))
     )
)

(defun foldl (f a l)
  (if (null l) 
      a
     (foldl f (f a (car l)) (cdr l))
     )
)

(defun filter (p l) 
       (cond ((null l)  ())
       	     ((p (car l)) (cons (car l) (filter p (cdr l))))
       	     (t (filter p (cdr l)))
	     )
)


;; sample lists
(setq test '("apple" "orange" "banana" "pineapple" "ugli fruit" "tomato"))

(defun downfrom (n) 
  (if (zerop n) 
      nil 
    (cons n (downfrom (- n 1)))
    )
)

(defun randomlist (n m)
  (if (zerop n) 
      nil 
    (cons (random m) (randomlist (- n 1) m)
	  )
    )
  )

;; mergesort

(defun take (n l)
  (cond ((zerop n) nil)
	((null l) nil)
	(t (cons (car l) (take (- n 1) (cdr l))))
	)
  )

(defun drop (n l)
  (cond ((zerop n) l)
	((null l) nil)
	(t (drop (- n 1) (cdr l)))
	)
  )

(defun merge (l1 l2)
  (cond ((null l1) l2)
	((null l2) l1)
	(t (if (< (car l1) (car l2))
	       (cons (car l1) (merge (cdr l1) l2))
	       (cons (car l2) (merge l1 (cdr l2)))
	       )
	   )
	)
  )

(defun mergesort (l)
  (if (< (length l) 2)
      l
  (let ((first (take (/ (length l) 2) l))
	(second (drop (/ (length l) 2) l)))
    (merge (mergesort first) (mergesort second))
    )
  )
)


;; insertion sort

(defun insert (a l) 
  (cond ((null l) (list a))
	((< a (car l)) (cons a l))
	(t (cons (car l) (insert a (cdr l))))
  )
)

(defun insertionsort (l)
  (foldr insert () l)
)


;; quicksort

(defun qsort (l)
  (if (null l) 
      nil
    (let ((l1 (filter (lambda (a) (< a (car l))) (cdr l)))
	  (l2 (filter (lambda (a) (not (< a (car l)))) (cdr l))))
      (concatenate (qsort l1) (list (car l)) (qsort l2))
      )
    )
  )


;; instrumented compare
(defun icomp (a b) 
 (progn (print ".") (< a b))
)


;; generalized versions

(defun mergesort-gen (l comp) 
  (if (< (length l) 2)
      l
  (let ((first (take (/ (length l) 2) l))
	(second (drop (/ (length l) 2) l)))
    (merge-gen (mergesort-gen first comp) (mergesort-gen second comp) comp)
    )
  )
)

(defun merge-gen (l1 l2 comp)
  (cond ((null l1) l2)
	((null l2) l1)
	(t (if (comp (car l1) (car l2))
	       (cons (car l1) (merge-gen (cdr l1) l2 comp))
	       (cons (car l2) (merge-gen l1 (cdr l2) comp))
	       )
	   )
	)
  )


(defun insert-gen (comp)
  (lambda (a l)
    (cond ((null l) (list a))
	  ((comp a (car l)) (cons a l))
	  (t (cons (car l) ((insert-gen comp) a (cdr l))))
	  )
    )

  )

(defun isort-gen (l comp)
  (foldr (insert-gen comp) () l 
	 )
  )


(defun qsort-gen (l comp) 
  (if (null l) 
      nil
    (let ((l1 (filter (lambda (a) (comp a (car l))) (cdr l)))
	  (l2 (filter (lambda (a) (not (comp a (car l)))) (cdr l))))
      (concatenate (qsort-gen l1 comp) (list (car l)) (qsort-gen l2 comp))
      )
    )
  )

;; instrumented "less than" comparison operator
		   
(defun i< (a b)
  (progn (setq counter (+ 1 counter)) (< a b))
)

;; quicksort which doesn't scan the list twice

(defun qsort-better (l comp) 
  (if (null l)
      nil
    (qsort-h (car l) (cdr l) () () comp))
)

(defun qsort-h (pivot l first second comp)
  (if (null l)
      (concatenate (qsort-better first comp) (list pivot) (qsort-better second comp))
    (if (comp (car l) pivot) 
	(qsort-h pivot (cdr l) (cons (car l) first) second comp)
        (qsort-h pivot (cdr l)  first (cons (car l) second) comp)
	)
    )
  )