cgit.sxemacs.org Git - sxemacs/blob - tests/automated/ase-heap-tests.el

   1 ;;;  ase-tests.el -- Tests for ASE
   2 ;; Copyright (C) 2006, 2007 Sebastian Freundt
   3 ;;
   4 ;; Author: Sebastian Freundt <hroptatyr@sxemacs.org>
   5 ;; Keywords: tests
   6 ;;
   7 ;; This file is part of SXEmacs.
   8 ;;
   9 ;; Redistribution and use in source and binary forms, with or without
  10 ;; modification, are permitted provided that the following conditions
  11 ;; are met:
  12 ;;
  13 ;; 1. Redistributions of source code must retain the above copyright
  14 ;;    notice, this list of conditions and the following disclaimer.
  15 ;;
  16 ;; 2. Redistributions in binary form must reproduce the above copyright
  17 ;;    notice, this list of conditions and the following disclaimer in the
  18 ;;    documentation and/or other materials provided with the distribution.
  19 ;;
  20 ;; 3. Neither the name of the author nor the names of any contributors
  21 ;;    may be used to endorse or promote products derived from this
  22 ;;    software without specific prior written permission.
  23 ;;
  24 ;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
  25 ;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
  26 ;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
  27 ;; DISCLAIMED.  IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
  28 ;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
  29 ;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
  30 ;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
  31 ;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
  32 ;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
  33 ;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
  34 ;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  35 ;;
  36 ;;; Synched up with: Not in FSF.
  37 ;;
  38 ;;; Commentary:
  39 ;; - test for conceptionally correct arithmetic
  40 ;; See test-harness.el for instructions on how to run these tests.
  41
  42 (eval-when-compile
  43   (condition-case nil
  44       (require 'test-harness)
  45     (file-error
  46      (push "." load-path)
  47      (when (and (boundp 'load-file-name) (stringp load-file-name))
  48        (push (file-name-directory load-file-name) load-path))
  49      (require 'test-harness))))
  50
  51 ;;;###eval-me-first
  52 (and (featurep 'modules)
  53      (locate-module "ase-heap")
  54      (require 'ase-heap))
  55
  56 (when (featurep 'ase-heap)
  57   (defun test-heaps (kind)
  58     (setq h (ase-heap :kind kind))
  59
  60     (ase-add-heap h 2)
  61     (ase-add-heap h 6)
  62     (ase-add-heap h 4)
  63     (ase-add-heap h 8)
  64     (ase-add-heap h 3)
  65
  66     ;;(ase-heap-to-list h)
  67     ;;(ase-heap-to-list* h)
  68
  69     (Assert (= (ase-heap-size h) 5))
  70     (ase-add-heap h 2)
  71     (Assert (= (ase-heap-size h) 6))
  72
  73     ;; pop elements off the heap slowly
  74     (Assert (= (ase-heap-top h) 8))
  75     (Assert (= (ase-heap-top-rank h) 8))
  76     (Assert (= (ase-pop-heap h) 8))
  77     (Assert (= (ase-heap-size h) 5))
  78
  79     (Assert (= (ase-heap-top h) 6))
  80     (Assert (= (ase-heap-top-rank h) 6))
  81     (Assert (= (ase-pop-heap h) 6))
  82     (Assert (= (ase-heap-size h) 4))
  83
  84     (Assert (= (ase-heap-top h) 4))
  85     (Assert (= (ase-heap-top-rank h) 4))
  86     (Assert (= (ase-pop-heap h) 4))
  87     (Assert (= (ase-heap-size h) 3))
  88
  89     (Assert (= (ase-heap-top h) 3))
  90     (Assert (= (ase-heap-top-rank h) 3))
  91     (Assert (= (ase-pop-heap h) 3))
  92     (Assert (= (ase-heap-size h) 2))
  93
  94     (Assert (= (ase-heap-top h) 2))
  95     (Assert (= (ase-heap-top-rank h) 2))
  96     (Assert (= (ase-pop-heap h) 2))
  97     (Assert (= (ase-heap-size h) 1))
  98
  99     (Assert (= (ase-heap-top h) 2))
 100     (Assert (= (ase-heap-top-rank h) 2))
 101     (Assert (= (ase-pop-heap h) 2))
 102     (Assert (= (ase-heap-size h) 0))
 103
 104     (Assert (null (ase-heap-top h)))
 105     (Assert (null (ase-heap-top-rank h)))
 106     (Assert (null (ase-pop-heap h)))
 107     (Assert (= (ase-heap-size h) 0))
 108
 109     (Assert (null (ase-heap-top h)))
 110     (Assert (null (ase-heap-top-rank h)))
 111     (Assert (null (ase-pop-heap h)))
 112     (Assert (= (ase-heap-size h) 0))
 113
 114     (let* ((l '(8 7 6 5 4 3 2 1))
 115            (k '(1 2 3 4 5 6 7 8)))
 116       ;; feed l
 117       (mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
 118       (Assert (= (ase-heap-size h) 8))
 119       (Assert (equal (ase-heap-to-list h) l))
 120       (Assert (= (ase-heap-size h) 8))
 121       (Assert (equal (ase-heap-to-list* h) l))
 122       (Assert (= (ase-heap-size h) 0))
 123       ;; feed k
 124       (mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
 125       (Assert (= (ase-heap-size h) 8))
 126       (Assert (equal (ase-heap-to-list h) l))
 127       (Assert (= (ase-heap-size h) 8))
 128       (Assert (equal (ase-heap-to-list* h) l))
 129       (Assert (= (ase-heap-size h) 0)))
 130
 131     (let* ((l '(8 7 6 5 4 3 2 1))
 132            (k '(1 2 3 4 5 6 7 8))
 133            (v [8 7 6 5 4 3 2 1]))
 134       ;; feed l
 135       (mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
 136       (Assert (= (ase-heap-size h) 8))
 137       (Assert (equal (ase-heap-to-vector h) v))
 138       (Assert (= (ase-heap-size h) 8))
 139       (Assert (equal (ase-heap-to-vector* h) v))
 140       (Assert (= (ase-heap-size h) 0))
 141       ;; feed k
 142       (mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
 143       (Assert (= (ase-heap-size h) 8))
 144       (Assert (equal (ase-heap-to-vector h) v))
 145       (Assert (= (ase-heap-size h) 8))
 146       (Assert (equal (ase-heap-to-vector* h) v))
 147       (Assert (= (ase-heap-size h) 0)))
 148
 149     (let* ((l '(8 7 6 5 4 3 2 1))
 150            (k '(1 2 3 4 5 6 7 8))
 151            (d (dllist 8 7 6 5 4 3 2 1)))
 152       ;; feed l
 153       (mapc-internal #'(lambda (e) (ase-add-heap h e)) l)
 154       (Assert (= (ase-heap-size h) 8))
 155       (Assert (equal (ase-heap-to-dllist h) d))
 156       (Assert (= (ase-heap-size h) 8))
 157       (Assert (equal (ase-heap-to-dllist* h) d))
 158       (Assert (= (ase-heap-size h) 0))
 159       ;; feed k
 160       (mapc-internal #'(lambda (e) (ase-add-heap h e)) k)
 161       (Assert (= (ase-heap-size h) 8))
 162       (Assert (equal (ase-heap-to-dllist h) d))
 163       (Assert (= (ase-heap-size h) 8))
 164       (Assert (equal (ase-heap-to-dllist* h) d))
 165       (Assert (= (ase-heap-size h) 0))))
 166
 167   ;;; testing coloured heaps
 168   (defun test-coloured-heaps (kind)
 169     (setq h (ase-heap :coloured t :kind kind))
 170
 171     (ase-add-heap h 2 'two)
 172     (ase-add-heap h 6 'six)
 173     (ase-add-heap h 4 'four)
 174     (ase-add-heap h 8 'eight)
 175     (ase-add-heap h 3 'three)
 176
 177     (Assert (= (ase-heap-size h) 5))
 178     (ase-add-heap h 2)
 179     (Assert (= (ase-heap-size h) 6))
 180
 181     ;; pop elements off the heap slowly
 182     (Assert (eq (ase-heap-top h) 'eight))
 183     (Assert (= (ase-heap-top-rank h) 8))
 184     (Assert (eq (ase-pop-heap h) 'eight))
 185     (Assert (= (ase-heap-size h) 5))
 186
 187     (Assert (eq (ase-heap-top h) 'six))
 188     (Assert (= (ase-heap-top-rank h) 6))
 189     (Assert (eq (ase-pop-heap h) 'six))
 190     (Assert (= (ase-heap-size h) 4))
 191
 192     (Assert (eq (ase-heap-top h) 'four))
 193     (Assert (= (ase-heap-top-rank h) 4))
 194     (Assert (eq (ase-pop-heap h) 'four))
 195     (Assert (= (ase-heap-size h) 3))
 196
 197     (Assert (eq (ase-heap-top h) 'three))
 198     (Assert (= (ase-heap-top-rank h) 3))
 199     (Assert (eq (ase-pop-heap h) 'three))
 200     (Assert (= (ase-heap-size h) 2))
 201
 202     (ase-pop-heap h)
 203     (Assert (= (ase-heap-size h) 1))
 204
 205     (ase-pop-heap h)
 206     (Assert (= (ase-heap-size h) 0))
 207
 208     (Assert (null (ase-heap-top h)))
 209     (Assert (null (ase-heap-top-rank h)))
 210     (Assert (null (ase-pop-heap h)))
 211     (Assert (= (ase-heap-size h) 0))
 212
 213     (Assert (null (ase-heap-top h)))
 214     (Assert (null (ase-heap-top-rank h)))
 215     (Assert (null (ase-pop-heap h)))
 216     (Assert (= (ase-heap-size h) 0)))
 217
 218   (defun test-char-heaps (kind)
 219     (setq h (ase-heap :kind kind))
 220     (ase-add-heap h ?a)
 221     (ase-add-heap h ?b)
 222     (ase-add-heap h ?c)
 223     (ase-add-heap h ?d)
 224     (ase-add-heap h ?e)
 225     (ase-add-heap h ?f)
 226     (ase-add-heap h ?g)
 227     (ase-add-heap h ?h)
 228     (ase-add-heap h ?i)
 229     (ase-add-heap h ?j)
 230     (ase-add-heap h ?k)
 231     (ase-add-heap h ?l)
 232     (ase-add-heap h ?m)
 233     (ase-add-heap h ?n)
 234     (ase-add-heap h ?o)
 235     (ase-add-heap h ?p)
 236     (ase-add-heap h ?q)
 237     (ase-add-heap h ?r)
 238     (ase-add-heap h ?s)
 239     (ase-add-heap h ?t)
 240     (ase-add-heap h ?u)
 241     (ase-add-heap h ?v)
 242     (ase-add-heap h ?w)
 243     (ase-add-heap h ?x)
 244     (ase-add-heap h ?y)
 245     (ase-add-heap h ?z)
 246
 247     (Assert
 248      (equal (ase-heap-to-vector* h)
 249             [?z ?y ?x ?w ?v ?u ?t ?s ?r ?q ?p ?o ?n ?m
 250                 ?l ?k ?j ?i ?h ?g ?f ?e ?d ?c ?b ?a])))
 251
 252   (defun test-mixed-heaps (kind)
 253     (setq h (ase-heap :kind kind))
 254     ;;(ase-add-heap h ?a)
 255     (ase-add-heap h 3)
 256     (ase-add-heap h 7.5)
 257     (when (featurep 'bigz)
 258       (ase-add-heap h (factorial 200)))
 259     (when (featurep 'bigq)
 260       (ase-add-heap h 1984319/5))
 261     (when (featurep 'bigfr)
 262       (ase-add-heap h euler-mascheroni)
 263       (ase-add-heap h euler))
 264     (when (featurep 'indefinite)
 265       (ase-add-heap h +infinity)
 266       (ase-add-heap h -infinity))
 267
 268     (when (featurep 'indefinite)
 269       (Assert (eq (ase-pop-heap h) +infinity)))
 270     (when (featurep 'bigz)
 271       (Assert (= (ase-pop-heap h) (factorial 200))))
 272     (when (featurep 'bigq)
 273       (Assert (= (ase-pop-heap h) 1984319/5)))
 274     ;;(Assert (= (ase-pop-heap h) ?a))
 275     (Assert (= (ase-pop-heap h) 7.5))
 276     (Assert (= (ase-pop-heap h) 3))
 277     (when (featurep 'bigfr)
 278       (Assert (= (ase-pop-heap h) euler))
 279       (Assert (= (ase-pop-heap h) euler-mascheroni)))
 280     (when (featurep 'indefinite)
 281       (Assert (eq (ase-pop-heap h) -infinity))))
 282
 283   ;; the actual test
 284   (mapcar #'test-heaps '(dynamic dense weak))
 285   (mapcar #'test-coloured-heaps '(dynamic dense weak))
 286
 287   (mapcar #'test-char-heaps '(dynamic dense weak))
 288   (mapcar #'test-mixed-heaps '(dynamic dense weak))
 289
 290   ;; hardcore test (only for weak heaps, no?)
 291   (setq h (ase-heap :kind 'weak))
 292   (dotimes (j 6)
 293     (dotimes (i (10^ j))
 294       (ase-add-heap h (random 80000)))
 295     (Assert (apply #'>= (ase-heap-to-list h)))
 296     (dotimes (i (10^ j))
 297       (ase-add-heap h (random 80000)))
 298     (Assert (apply #'>= (ase-heap-to-list* h))))
 299
 300
 301   ;; The cool thing about heaps is that you can add whatever you want, i.e. _no_
 302   ;; restrictions there.  However, when you add the second element to the heap it
 303   ;; has to be compared somehow.  Most domains, however, thwart you here since
 304   ;; they do not possess (or can't possess) a partial ordering.
 305
 306   (defun test-non-posets (kind)
 307     (setq h (ase-heap :kind kind))
 308     ;; lisp symbols dont form a poset
 309     (Assert (ase-add-heap h 'foo))
 310     ;; adding another symbol will make SXE cry
 311     (Check-Error relation-error (ase-add-heap h 'bar))
 312     ;; even if we add a poset object
 313     (Check-Error relation-error (ase-add-heap h 0))
 314     ;; however we can pop the original element we stored there
 315     (Assert (eq (ase-pop-heap h) 'foo))
 316
 317     ;; same for other non-posets
 318     (when (featurep 'bigg)
 319       (Assert (ase-add-heap h 1+i))
 320       (Check-Error relation-error (ase-add-heap h -1+i))
 321       (Check-Error relation-error (ase-add-heap h 1))
 322       (Assert (= (ase-pop-heap h) 1+i))))
 323
 324   ;;(mapcar #'test-non-posets '(dynamic dense weak))
 325   )
 326 ;; ase-heap-tests.el ends here