mirror of https://codeberg.org/cage/tinmop/
54 lines
2.2 KiB
Common Lisp
54 lines
2.2 KiB
Common Lisp
;; tinmop: a multiprotocol client
|
|
;; Copyright © cage
|
|
|
|
;; This program is free software: you can redistribute it and/or modify
|
|
;; it under the terms of the GNU General Public License as published by
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|
;; (at your option) any later version.
|
|
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program.
|
|
;; If not, see [[http://www.gnu.org/licenses/][http://www.gnu.org/licenses/]].
|
|
|
|
(in-package :numeric-tests)
|
|
|
|
(defsuite numeric-suite (all-suite))
|
|
|
|
(deftest test-shellsort (numeric-suite)
|
|
(assert-true
|
|
(let* ((bag (loop repeat 10000 collect (lcg-next-upto 10000)))
|
|
(sorted (shellsort bag #'<)))
|
|
(and (null (set-difference bag sorted :test #'=))
|
|
(not (find nil (mapcar #'< sorted (rest sorted))))))))
|
|
|
|
(deftest test-multisort (numeric-suite)
|
|
(let* ((bag '(("b" . 10) ("b" . 1) ("z" . 5) ("a" . 10) ("b" . 7) ("a" . 100)))
|
|
(sorted (multisort bag (list (gen-multisort-test string< string> car)
|
|
(gen-multisort-test < > cdr)))))
|
|
(assert-equalp
|
|
'(("a" . 10) ("a" . 100) ("b" . 1) ("b" . 7) ("b" . 10) ("z" . 5))
|
|
sorted)))
|
|
|
|
(deftest test-binary-search (numeric-suite)
|
|
(let* ((max-value 1000)
|
|
(all-values (loop for i from 0 below (num:lcg-next-upto max-value) collect i))
|
|
(results ()))
|
|
(loop repeat 10 do
|
|
(let* ((needle (misc:random-elt all-values))
|
|
(result (binary-search all-values needle)))
|
|
(push result results)))
|
|
(assert-true (notany #'null results))
|
|
(assert-true (binary-search '(1 2) 2))
|
|
(assert-true (binary-search '(1) 1))
|
|
(assert-false (binary-search '(1) 2))
|
|
(assert-false (binary-search '(1 2) 3))
|
|
(assert-false (binary-search '(2 3) 1))
|
|
(assert-false (binary-search '(2 4 5) 3))
|
|
(assert-false (binary-search '(2 4 5) 1))
|
|
(assert-false (binary-search all-values (1+ max-value)))))
|