(defun point-distance (p1 p2)
  (destructuring-bind (x1 . y1) p1
    (destructuring-bind (x2 . y2) p2
      (let ((dx (- x2 x1)) (dy (- y2 y1)))
        (sqrt (+ (* dx dx) (* dy dy)))))))

(defun closest-pair-bf (points)
  (let ((pair (list (first points) (second points)))
        (dist (point-distance (first points) (second points))))
    (dolist (p1 points (values pair dist))
      (dolist (p2 points)
        (unless (eq p1 p2)
          (let ((pdist (point-distance p1 p2)))
            (when (< pdist dist)
              (setf (first pair) p1
                    (second pair) p2
                    dist pdist))))))))

(defun closest-pair (points)
  (labels
      ((cp (xp &aux (length (length xp)))
         (if (<= length 3)
           (multiple-value-bind (pair distance) (closest-pair-bf xp)
             (values pair distance (sort xp '< :key 'cdr)))
           (let* ((xr (nthcdr (1- (floor length 2)) xp))
                  (xm (/ (+ (caar xr) (caadr xr)) 2)))
             (psetf xr (rest xr)
                    (rest xr) '())
             (multiple-value-bind (lpair ldist yl) (cp xp)
               (multiple-value-bind (rpair rdist yr) (cp xr)
                 (multiple-value-bind (dist pair)
                     (if (< ldist rdist)
                       (values ldist lpair)
                       (values rdist rpair))
                   (let* ((all-ys (merge 'vector yl yr '< :key 'cdr))
                          (ys (remove-if #'(lambda (p)
                                             (> (abs (- (car p) xm)) dist))
                                         all-ys))
                          (ns (length ys)))
                     (dotimes (i ns)
                       (do ((k (1+ i) (1+ k)))
                           ((or (= k ns)
                                (> (- (cdr (aref ys k))
                                      (cdr (aref ys i)))
                                   dist)))
                         (let ((pd (point-distance (aref ys i)
                                                   (aref ys k))))
                           (when (< pd dist)
                             (setf dist pd
                                   (first pair) (aref ys i)
                                   (second pair) (aref ys k))))))
                     (values pair dist all-ys)))))))))
    (multiple-value-bind (pair distance)
        (cp (sort (copy-list points) '< :key 'car))
      (values pair distance))))