62 lines
2.0 KiB
Plaintext
62 lines
2.0 KiB
Plaintext
(defun defarray (name size initial-element)
|
|
(cons name
|
|
(compress1 name
|
|
(cons (list :HEADER
|
|
:DIMENSIONS (list size)
|
|
:MAXIMUM-LENGTH (1+ size)
|
|
:DEFAULT initial-element
|
|
:NAME name)
|
|
nil))))
|
|
|
|
(defconst *dim* 100000)
|
|
|
|
(defun array-name (array)
|
|
(first array))
|
|
|
|
(defun set-at (array i val)
|
|
(cons (array-name array)
|
|
(aset1 (array-name array)
|
|
(cdr array)
|
|
i
|
|
val)))
|
|
|
|
(defun populate-array-ordered (array n)
|
|
(if (zp n)
|
|
array
|
|
(populate-array-ordered (set-at array
|
|
(- *dim* n)
|
|
(- *dim* n))
|
|
(1- n))))
|
|
(include-book "arithmetic-3/top" :dir :system)
|
|
|
|
(defun binary-search-r (needle haystack low high)
|
|
(declare (xargs :measure (nfix (1+ (- high low)))))
|
|
(let* ((mid (floor (+ low high) 2))
|
|
(current (aref1 (array-name haystack)
|
|
(cdr haystack)
|
|
mid)))
|
|
(cond ((not (and (natp low) (natp high))) nil)
|
|
((= current needle)
|
|
mid)
|
|
((zp (1+ (- high low))) nil)
|
|
((> current needle)
|
|
(binary-search-r needle
|
|
haystack
|
|
low
|
|
(1- mid)))
|
|
(t (binary-search-r needle
|
|
haystack
|
|
(1+ mid)
|
|
high)))))
|
|
|
|
(defun binary-search (needle haystack)
|
|
(binary-search-r needle haystack 0
|
|
(maximum-length (array-name haystack)
|
|
(cdr haystack))))
|
|
|
|
(defun test-bsearch (needle)
|
|
(binary-search needle
|
|
(populate-array-ordered
|
|
(defarray 'haystack *dim* 0)
|
|
*dim*)))
|