From: Steven E. Harris
Subject: Re: More fun with Lisp
Date: 
Message-ID: <jk4sm8few81.fsf@W003275.na.alarismed.com>
William Bland <·······@abstractnonsense.com> writes:

> This evening I found an interesting exercise from Dave Thomas
> (author of The Pragmatic Programmer), and solved it in Common Lisp.

Weird, I just wrote a similar pair of functions about a month ago. For
mine, I was aping the Standard C++ Library's std::lower_bound and
std::binary_search functions, using a predicate function respecting a
strict weak ordering. My functions return two values: whether the item
was found, and the index of the found item. I see you used -1 as a
sentinel to indicate that the value was not found.

Just for comparison:

;; Recursive
(defun bsearch (item vector pred &key key)
  (labels ((rec (start end)
             (if (= start end)
                 (values nil start)
                 (let* ((mid (floor (+ start end) 2))
                        (candidate (if key
                                       (funcall key (aref vector mid))
                                       ;; TODO: Could also use identity.
                                       (aref vector mid))))
                   (cond ((funcall pred item candidate)
                          (rec start mid))
                         ((funcall pred candidate item)
                          (rec (1+ mid) end))
                         (t (values t mid)))))))
    (rec 0 (length vector))))


;; Iterative
(defun bsearch-nrec (item vector pred &key key)
  (do ((start 0)
       (end (length vector)))
      ((= start end) (values nil start))
    (let* ((mid (floor (+ start end) 2))
           (candidate (if key
                          (funcall key (aref vector mid))
                          ;; TODO: Could also use identity.
                          (aref vector mid))))
      (cond ((funcall pred item candidate)
             (setq end mid))
            ((funcall pred candidate item)
             (setq start (1+ mid)))
            (t (return (values t mid)))))))


In order to generalize the predicate function beyond '<', I introduced
a generic function:

(defgeneric lessp (lhs rhs)
  (:documentation "Determine whether lhs is less than rhs."))

(defmethod lessp ((lhs number) (rhs number))
  (< lhs rhs))


Then, to aid in writing compound lexicographic comparator functions, I
wrote the following:

(defun make-ordering-form (lhs-sym rhs-sym cmp-fun reader-funcs)
  (flet ((make-simple-form (lhs rhs func)
           `(,cmp-fun (,func ,lhs) (,func ,rhs))))
    (when reader-funcs
      (if (null (cdr reader-funcs))
          (make-simple-form lhs-sym rhs-sym (car reader-funcs))
          `(or ,(make-simple-form lhs-sym rhs-sym (car reader-funcs))
            (and (not ,(make-simple-form rhs-sym lhs-sym (car reader-funcs)))
             ,(make-ordering-form lhs-sym rhs-sym cmp-fun (cdr reader-funcs))))))))


(defmacro defcompoundordering (function-name type reader-funcs)
  (when reader-funcs
    `(defmethod ,function-name ((lhs ,type) (rhs ,type))
      ,(make-ordering-form 'lhs 'rhs function-name reader-funcs))))


Here we define a comparator function for a structure called
"endpoint":

(defstruct endpoint
  (address nil :type number)
  (port nil :type number))

(defcompoundordering lessp endpoint
  (endpoint-address endpoint-port))


The resultant macroexpansion:

(DEFMETHOD LESSP ((LHS ENDPOINT) (RHS ENDPOINT))
 (OR (LESSP (ENDPOINT-ADDRESS LHS) (ENDPOINT-ADDRESS RHS))
  (AND (NOT (LESSP (ENDPOINT-ADDRESS RHS) (ENDPOINT-ADDRESS LHS)))
   (LESSP (ENDPOINT-PORT LHS) (ENDPOINT-PORT RHS)))))


We can then run binary search on a vector of endpoints passing #'lessp
as the predicate function.

-- 
Steven E. Harris