How to resolve the algorithm Closest-pair problem step by step in the Common Lisp programming language

Published on 12 May 2024 09:40 PM
#Common lisp

How to resolve the algorithm Closest-pair problem step by step in the Common Lisp programming language

Table of Contents

Problem Statement

Provide a function to find the closest two points among a set of given points in two dimensions,   i.e. to solve the   Closest pair of points problem   in the   planar   case. The straightforward solution is a   O(n2)   algorithm   (which we can call brute-force algorithm);   the pseudo-code (using indexes) could be simply: A better algorithm is based on the recursive divide&conquer approach,   as explained also at   Wikipedia's Closest pair of points problem,   which is   O(n log n);   a pseudo-code could be:

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Closest-pair problem step by step in the Common Lisp programming language

Source code in the common programming language

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

You may also check:How to resolve the algorithm Sorting algorithms/Radix sort step by step in the EasyLang programming language
You may also check:How to resolve the algorithm Formatted numeric output step by step in the PL/I programming language
You may also check:How to resolve the algorithm Scope modifiers step by step in the Racket programming language
You may also check:How to resolve the algorithm Arithmetic/Rational step by step in the Fermat programming language
You may also check:How to resolve the algorithm Left factorials step by step in the BBC BASIC programming language