some lisp exercises

Mar 31, 2014  

Reading through ANSI Common Lisp, and doing some of the exercises as I come across them. Here are a few from Ch 4 and 5:

(defun rotate-square-array (arr)
  (let* ((dim (car (array-dimensions arr)))
	(newarr (make-array (list dim dim))))
    (dotimes (i dim)
      (dotimes (j dim)
	(setf (aref newarr j (- dim (1+ i))) (aref arr i j))))
    newarr))

(defun rev-l (lst)
  (reduce (lambda (elem acc) (cons acc elem)) lst :initial-value nil))

(defun copy-l (lst)
  (reduce (lambda (elem acc) (cons elem acc)) lst
	  :initial-value nil :from-end t))

(defun alist-to-ht (alist)
  (let ((ht (make-hash-table)))
    (mapcar (lambda (kvpair)
	      (setf (gethash (car kvpair) ht) (cdr kvpair)))
	    alist)
    ht))

(defun ht-to-alist (ht)
  (let ((alist '()))
    (maphash (lambda (k v)
	       (setf alist (acons k v alist)))
	     ht)
    alist))

(defun precedes-iter (obj vec)
  (let ((pos-list '()))
    (do* ((last-pos (position obj vec)
		    (position obj vec :start (1+ last-pos))))
	 ((eql last-pos nil) pos-list)
      (and (> last-pos 0)
	   (let ((elem (elt vec (- last-pos 1))))
	     (setf pos-list (adjoin elem pos-list)))))))


(defun precedes-recur (obj vec)
  (labels ((precedes-helper (obj vec pos-list start-pos)
	     (let ((next-pos (position obj vec :start start-pos)))
	       (if (null next-pos)
		   pos-list
		   (precedes-helper obj vec
				    (adjoin (elt vec (- next-pos 1))
					    pos-list)
				    (1+ next-pos))))))
    (precedes-helper obj vec '() 1)))


(defun intersperse-recur (obj lst)
  (labels ((intersperse-helper (obj lst)
	     (if (null lst)
		 nil
		 (cons obj (cons (car lst)
				 (intersperse-helper obj (cdr lst)))))))
    (cons (car lst) (intersperse-helper obj (cdr lst)))))

(defun intersperse-iter (obj lst)
  (do ((iter-lst (cdr lst) (cdr iter-lst))
       (result (list (car lst)) (cons (car iter-lst) (cons obj result))))
      ((null iter-lst)
       (reverse result))))

(defun within-one (x y)
  (or (= x (1+ y))
      (= y (1+ x))))

(defun orderedlistp-recur (lst)
  (labels ((ordered-list-helper (elem lst)
	     (if (null lst)
		 t
		 (let ((x (car lst)))
		   (and (within-one elem x)
			(ordered-list-helper x (cdr lst)))))))
    (ordered-list-helper (car lst) (cdr lst))))


(defun orderedlistp-iter (lst)
  (do* ((ordered t
		 (within-one first-elem (car remaining)))
	(first-elem (car lst)
		    (car remaining))
	(remaining (cdr lst)
		   (cdr remaining)))
       ((or (null remaining)
	    (not ordered))
	ordered)))

(defun orderedlistp-map (lst)
  (flet ((ordered-list-mapper (elem1 elem2)
	   (if (not (within-one elem1 elem2))
	       (return-from orderedlistp-map nil))))
  (mapc #'ordered-list-mapper lst (cdr lst))
  t))

(defun max-and-min (lst)
  (labels ((max-min-helper (lst curmin curmax)
	     (if (null lst)
		 (values curmin curmax)
		 (let ((elem (car lst))
		       (rest (cdr lst)))
		   (cond
		     ((and (eql curmin nil)
			   (eql curmax nil))
		      (max-min-helper rest elem elem))
		     ((> elem curmax)
		      (max-min-helper rest curmin elem))
		     ((< elem curmin)
		      (max-min-helper rest elem curmax))
		     (t
		      (max-min-helper rest curmin curmax)))))))
    (max-min-helper lst nil nil)))