arnesi

Manipulating sequences 

(defun tail (seq &optional (how-many 1))
  "Returns the last HOW-MANY elements of the sequence SEQ. HOW-MANY is
  greater than (length SEQ) then all of SEQ is returned."[...]
  (let ((seq-length (length seq)))
    (cond
      ((<= 0 how-many seq-length)
       (subseq seq (- seq-length how-many)))
      ((< seq-length how-many)
       (copy-seq seq))
      (t ; (< how-many 0)
       (head seq (- how-many))))))

(defun but-tail (seq &optional (how-many 1))
  "Returns SEQ with the last HOW-MANY elements removed."
  (let ((seq-length (length seq)))[...]
    (cond
      ((<= 0 how-many seq-length)
       (subseq seq 0 (- seq-length how-many)))
      ((< seq-length how-many)
       (copy-seq seq))
      (t
       (but-head seq (- how-many))))))

(defun head (seq &optional (how-many 1))
  "Returns the first HOW-MANY elements of SEQ."
  (let ((seq-length (length seq)))[...]
    (cond
      ((<= 0 how-many (length seq))
       (subseq seq 0 how-many))
      ((< seq-length how-many)
       (copy-seq seq))
      (t
       (tail seq (- how-many))))))

(defun but-head (seq &optional (how-many 1))
  "Returns SEQ with the first HOW-MANY elements removed."
  (let ((seq-length (length seq)))[...]
    (cond ((<= 0 how-many (length seq))
           (subseq seq how-many))
          ((< seq-length how-many)
           (copy-seq seq))
          (t
           (but-tail seq (- how-many))))))

(defun starts-with (sequence prefix &key (test #'eql))
  "Test whether the first elements of SEQUENCE are the same (as
  per TEST) as the elements of PREFIX."[...]
  (let ((length1 (length sequence))
        (length2 (length prefix)))
    (when (< length1 length2)
      (return-from starts-with nil))
    (dotimes (index length2 t)
      (when (not (funcall test (elt sequence index) (elt prefix index)))
        (return-from starts-with nil)))))

(defun ends-with (seq1 seq2 &key (test #'eql))
  "Test whether SEQ1 ends with SEQ2. In other words: return true if
  the last (length seq2) elements of seq1 are equal to seq2."[...]
  (let ((length1 (length seq1))
        (length2 (length seq2)))
    (when (< length1 length2)
      (return-from ends-with nil)) ;; if seq1 is shorter than seq2 than seq1 can't end with seq2.
    (loop
       for seq1-index from (- length1 length2) below length1
       for seq2-index from 0 below length2
       when (not (funcall test (elt seq1 seq1-index) (elt seq2 seq2-index)))
         do (return-from ends-with nil)
       finally (return t))))

(defun read-sequence* (sequence stream &key (start 0) end)
  "Like READ-SEQUENCE except the sequence is returned as well.
[...]
The second value returned is READ-SEQUENCE's primary value, the
primary value returned by READ-SEQUENCE* is the medified
sequence."
  (let ((pos (read-sequence sequence stream :start start :end end)))
    (values sequence pos)))

(defmacro deletef
    (item sequence &rest delete-args
     &environment e)[...]
  "Delete ITEM from SEQUENCE, using cl:delete, and update SEQUENCE.

DELETE-ARGS are passed directly to cl:delete."
  (multiple-value-bind (vars vals store-vars writer-form reader-form)
      (get-setf-expansion sequence e)
    `(let* (,@(mapcar #'list vars vals)
            (,(car store-vars) ,reader-form))
       (setq ,(car store-vars) (delete ,item ,(car store-vars)
                                       ,@delete-args))
       ,writer-form)))

Levenshtein Distance 

1) Set n to be the length of s. Set m to be the length of t. If n = 0, return m and exit. If m = 0, return n and exit. Construct a matrix containing 0..m rows and 0..n columns.

2) Initialize the first row to 0..n. Initialize the first column to 0..m.

3) Examine each character of s (i from 1 to n).

4) Examine each character of t (j from 1 to m).

5) If s[i] equals t[j], the cost is 0. If s[i] doesn't equal t[j], the cost is 1.

6) Set cell d[i,j] of the matrix equal to the minimum of: a. The cell immediately above plus 1: d[i-1,j] + 1. b. The cell immediately to the left plus 1: d[i,j-1] + 1. c. The cell diagonally above and to the left plus the cost: d[i-1,j-1] + cost.

7) After the iteration steps (3, 4, 5, 6) are complete, the distance is found in cell d[n,m].

(defun levenshtein-distance (source target &key (test #'eql))
  (block nil
    (let ((source-length (length source))[...]
	  (target-length (length target)))
      (when (zerop source-length)
	(return target-length))
      (when (zerop target-length)
	(return source-length))
      (let ((buffer (make-array (1+ target-length))))
	(dotimes (i (1+ target-length))
	  (setf (aref buffer i) i))
	;; we make a slight modification to the alogrithm described
	;; above. we don't create the entire array, just enough to
	;; keep the info we need, which is an array of size
	;; target-length + the "above" value and the "over". (this is
	;; similar to the optimizaiont for determining lcs).
	(loop
	   for i from 1 upto source-length
	   do (setf (aref buffer 0) i)
	   do (loop
		 with above-value = i
		 with over-value = (1- i)
		 for j from 1 upto target-length
		 for cost = (if (funcall test (elt source (1- i))
					      (elt target (1- j)))
				0 1)
		 do (let ((over-value* (aref buffer j)))
		      (setf (aref buffer j) (min (1+ above-value)
						 (1+ (aref buffer j))
						 (+ cost over-value))
			    above-value (aref buffer j)
			    over-value over-value*))))
	(return (aref buffer target-length))))))