cgit.sxemacs.org Git - sxemacs/blob - tests/automated/ase-interval-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 (progn
  53   (and (featurep 'modules)
  54        (locate-module "ase-set")
  55        (require 'ase-set))
  56   (and (locate-module "ase-cartesian")
  57        (require 'ase-cartesian)))
  58
  59 (when (featurep 'ase-set)
  60   ;; create some intervals first
  61   (setq i1 (ase-interval 0 1))
  62   (setq i2 (ase-interval 1 2))
  63   (setq i3 (ase-interval 2 3))
  64   (setq i5 (ase-interval 0 1 t t))
  65   (setq i6 (ase-interval 1 2 t t))
  66   (setq i7 (ase-interval 2 3 t t))
  67   (setq i8 (ase-interval 0 2))
  68   (setq i9 (ase-interval 1 3))
  69   (setq ia (ase-interval 1 1))
  70   (setq ib (ase-interval 1 1 t t)) ;; should be transformed to empty interv
  71   (setq ic (ase-interval 1 1 nil t)) ;; should be transformed to empty interv
  72   (setq id (ase-interval 0 0))
  73   (setq ie (ase-interval 2 2))
  74   (setq if (ase-interval 3 3))
  75   (setq aei (ase-empty-interval))
  76   (setq aui (ase-universe-interval))
  77   (setq it (ase-interval 2))
  78   (setq i123 (ase-interval 0 3))
  79   (setq i23 (ase-interval 1 3))
  80
  81   (setq i56 (ase-interval-union i5 i6))
  82   (setq i67 (ase-interval-union i7 i6))
  83   (setq i567 (ase-interval-union i5 i6 i7))
  84   (setq i13 (ase-interval-union i3 i1))
  85   (setq isp (ase-interval-union
  86              (ase-interval -infinity
  87                            (if (featurep 'bigq) -3/2 -3)) (ase-interval -1)))
  88   (setq huge (ase-interval 0 10))
  89   (setq tiny (ase-interval 2 5))
  90
  91   (Assert (not (ase-interval-empty-p i1)))
  92   (Assert (not (ase-interval-empty-p i2)))
  93   (Assert (not (ase-interval-empty-p i3)))
  94   (Assert (not (ase-interval-empty-p i5)))
  95   (Assert (not (ase-interval-empty-p i6)))
  96   (Assert (not (ase-interval-empty-p i7)))
  97   (Assert (not (ase-interval-empty-p i8)))
  98   (Assert (not (ase-interval-empty-p ia)))
  99   (Assert (ase-interval-empty-p ib))
 100   (Assert (ase-interval-empty-p ic))
 101   (Assert (ase-interval-empty-p aei))
 102   (Assert (not (ase-interval-empty-p aui)))
 103   (Assert (ase-interval-empty-p (ase-interval-union)))
 104   (Assert (ase-interval-empty-p (ase-interval-union (ase-interval-union))))
 105
 106   (Assert (not (ase-interval-imprimitive-p i1)))
 107   (Assert (not (ase-interval-imprimitive-p i2)))
 108   (Assert (not (ase-interval-imprimitive-p i3)))
 109   (Assert (not (ase-interval-imprimitive-p i5)))
 110   (Assert (not (ase-interval-imprimitive-p i6)))
 111   (Assert (not (ase-interval-imprimitive-p i7)))
 112   (Assert (not (ase-interval-imprimitive-p i8)))
 113   (Assert (not (ase-interval-imprimitive-p i9)))
 114   (Assert (ase-interval-imprimitive-p i567))
 115   (Assert (ase-interval-imprimitive-p i13))
 116
 117   (Assert (ase-interval-contains-p i1 0))
 118   (Assert (ase-interval-contains-p i2 2))
 119   (Assert (not (ase-interval-contains-p i5 0)))
 120   (when (featurep 'bigq)
 121     (Assert (ase-interval-contains-p i5 1/2)))
 122   (Assert (ase-interval-contains-p i5 0.9999))
 123   (Assert (not (ase-interval-contains-p i8 i9)))
 124   (Assert (not (ase-interval-contains-p i9 i8)))
 125   (Assert (ase-interval-contains-p ia 1))
 126   (Assert (not (ase-interval-contains-p ib 1)))
 127   (Assert (not (ase-interval-contains-p i567 0)))
 128   (Assert (not (ase-interval-contains-p i567 1)))
 129   (when (featurep 'bigq)
 130     (Assert (ase-interval-contains-p i567 1/2)))
 131   (Assert (ase-interval-contains-p i567 i5))
 132   (Assert (ase-interval-contains-p i567 i56))
 133   (Assert (not (ase-interval-contains-p i567 i8)))
 134   (Assert (not (ase-interval-contains-p
 135                 i567 (ase-interval-union i5 it))))
 136   (when (featurep 'bigq)
 137     (Assert (ase-interval-contains-p
 138              i567 (ase-interval-union (ase-interval 1/2) (ase-interval 3/2))))
 139     (Assert (ase-interval-contains-p
 140              i123
 141              (ase-interval-union (ase-interval 1/2) (ase-interval 3/2)))))
 142   (Assert (not (ase-interval-contains-p i23 i56)))
 143   (Assert (ase-interval-contains-p i23 i67))
 144   (Assert (ase-interval-contains-p i123 i567))
 145   (Assert (not (ase-interval-contains-p i23 i567)))
 146   (Assert (not (ase-interval-contains-p aei aei)))
 147   (Assert (not (ase-interval-contains-p aei 0)))
 148   (Assert (not (ase-interval-contains-p aei -1)))
 149   (Assert (not (ase-interval-contains-p aei 1)))
 150   (Assert (not (ase-interval-contains-p aei +infinity)))
 151   (Assert (not (ase-interval-contains-p aei i1)))
 152   (Assert (not (ase-interval-contains-p aei i2)))
 153   (Assert (not (ase-interval-contains-p aei i3)))
 154   (Assert (not (ase-interval-contains-p aei i5)))
 155   (Assert (not (ase-interval-contains-p aei i6)))
 156   (Assert (not (ase-interval-contains-p aei i7)))
 157   (Assert (not (ase-interval-contains-p aei i8)))
 158   (Assert (not (ase-interval-contains-p aei i9)))
 159   (when (featurep 'bigq)
 160     (Assert (eq t (ase-interval-contains-where
 161                    i567 (ase-interval-union (ase-interval 1/2)
 162                                             (ase-interval 3/2)))))
 163     (Assert (eq t (ase-interval-contains-where
 164                    i123 (ase-interval-union (ase-interval 1/2)
 165                                             (ase-interval 3/2))))))
 166   (Assert (eq t (ase-interval-contains-where i123 i56)))
 167   (Assert (eq t (ase-interval-contains-where i123 i567)))
 168   (Assert (not (ase-interval-contains-where i23 i567)))
 169   (Assert (not (ase-interval-contains-where i567 0)))
 170   (Assert (not (ase-interval-contains-where i567 1)))
 171   (when (featurep 'bigq)
 172     (Assert (ase-interval-equal-p (ase-interval-contains-where i567 1/2) i5)))
 173   (Assert (ase-interval-equal-p (ase-interval-contains-where i567 i5) i5))
 174   (Assert (not (ase-interval-contains-p i6 ia)))
 175   (Assert (not (ase-interval-contains-p ia i6)))
 176
 177   (Assert (ase-interval-connected-p i1 i2))
 178   (Assert (not (ase-interval-connected-p i1 i3)))
 179   (Assert (ase-interval-connected-p i1 i5))
 180   (Assert (ase-interval-connected-p i1 i6))
 181   (Assert (not (ase-interval-connected-p i5 i6)))
 182   (Assert (ase-interval-connected-p ia i5))
 183   (Assert (ase-interval-connected-p i8 i9))
 184   (Assert (not (ase-interval-connected-p i1 i3)))
 185   (Assert (ase-interval-connected-p i2 i1 i3))
 186   (Assert (ase-interval-connected-p i2 i13 i1 i3))
 187   (Assert (not (ase-interval-connected-p i13 i1)))
 188   (Assert (not (ase-interval-connected-p i13)))
 189   (Assert (not (ase-interval-connected-p i13 i13)))
 190   (Assert (ase-interval-connected-p i13 i2))
 191   (Assert (ase-interval-connected-p aei i13 i2 aei i2))
 192   (Assert (ase-interval-connected-p ia i6))
 193   (Assert (ase-interval-connected-p i6 ia))
 194
 195   (Assert (not (ase-interval-disjoint-p i1 i2)))
 196   (Assert (ase-interval-disjoint-p i1 i3))
 197   (Assert (not (ase-interval-disjoint-p i1 i5)))
 198   (Assert (ase-interval-disjoint-p i1 i6))
 199   (Assert (ase-interval-disjoint-p i5 i6))
 200   (Assert (ase-interval-disjoint-p ia i5))
 201   (Assert (not (ase-interval-disjoint-p i8 i9)))
 202   (Assert (not (ase-interval-disjoint-p i13 i1)))
 203   (Assert (not (ase-interval-disjoint-p i13 i3)))
 204   (Assert (not (ase-interval-disjoint-p i1 i13)))
 205   (Assert (not (ase-interval-disjoint-p i3 i13)))
 206   (Assert (not (ase-interval-disjoint-p i1 i1 i3)))
 207   (Assert (not (ase-interval-disjoint-p i3 i1 i3)))
 208   (Assert (not (ase-interval-disjoint-p i13 i1)))
 209   (Assert (not (ase-interval-disjoint-p i13 i13)))
 210   (Assert (not (ase-interval-disjoint-p i13 (ase-interval-union i5 i7))))
 211   (Assert (ase-interval-disjoint-p i13 (ase-interval -infinity -1)))
 212   (Assert (ase-interval-disjoint-p i13 isp))
 213
 214   (let ((i02o (ase-interval 0 2 t t)))
 215     (Assert (ase-interval-equal-p i02o (ase-interval-union i5 ia i6)))
 216     (Assert (ase-interval-equal-p i02o (ase-interval-union i5 ia i6)))
 217     (Assert (ase-interval-equal-p i02o (ase-interval-union ia i5 i6)))
 218     (Assert (ase-interval-equal-p i02o (ase-interval-union ia i6 i5)))
 219     (Assert (ase-interval-equal-p i02o (ase-interval-union i5 i6 ia)))
 220     (Assert (ase-interval-equal-p i02o (ase-interval-union i6 ia i5)))
 221     (Assert (ase-interval-equal-p i02o (ase-interval-union i6 i5 ia))))
 222
 223   (Assert (ase-interval-open-p aei))
 224   (Assert (ase-interval-open-p aui))
 225   (Assert (ase-interval-open-p (ase-interval -infinity 2 t t)))
 226   (Assert (not (ase-interval-open-p (ase-interval -infinity 2))))
 227   (Assert (not (ase-interval-open-p i1)))
 228   (Assert (not (ase-interval-open-p i2)))
 229   (Assert (not (ase-interval-open-p i3)))
 230   (Assert (not (ase-interval-open-p (ase-interval 1 2 t))))
 231   (Assert (not (ase-interval-open-p (ase-interval 1 2 nil t))))
 232   (Assert (ase-interval-open-p (ase-interval 1 2 t t)))
 233   (Assert (ase-interval-open-p i5))
 234   (Assert (ase-interval-open-p i6))
 235   (Assert (ase-interval-open-p i7))
 236   (Assert (not (ase-interval-open-p i123)))
 237   (Assert (ase-interval-open-p i567))
 238   (Assert (not (ase-interval-open-p
 239                 (ase-interval-union i5 (ase-interval 2 4)))))
 240   (Assert (not (ase-interval-open-p
 241                 (ase-interval-union i1 (ase-interval 2 4)))))
 242   (Assert (ase-interval-open-p
 243            (ase-interval-union i5 (ase-interval 2 4 t t))))
 244
 245   (Assert (ase-interval-closed-p aei))
 246   (Assert (ase-interval-closed-p aui))
 247   (Assert (ase-interval-closed-p (ase-interval -infinity 2)))
 248   (Assert (not (ase-interval-closed-p (ase-interval -infinity 2 t t))))
 249   (Assert (ase-interval-closed-p i1))
 250   (Assert (ase-interval-closed-p i2))
 251   (Assert (ase-interval-closed-p i3))
 252   (Assert (not (ase-interval-closed-p (ase-interval 1 2 t))))
 253   (Assert (not (ase-interval-closed-p (ase-interval 1 2 nil t))))
 254   (Assert (not (ase-interval-closed-p (ase-interval 1 2 t t))))
 255   (Assert (not (ase-interval-closed-p i5)))
 256   (Assert (not (ase-interval-closed-p i6)))
 257   (Assert (not (ase-interval-closed-p i7)))
 258   (Assert (ase-interval-closed-p i123))
 259   (Assert (not (ase-interval-closed-p i567)))
 260   (Assert (not (ase-interval-closed-p
 261                 (ase-interval-union i5 (ase-interval 2 4)))))
 262   (Assert (ase-interval-closed-p
 263            (ase-interval-union i1 (ase-interval 2 4))))
 264   (Assert (not (ase-interval-closed-p
 265                 (ase-interval-union i5 (ase-interval 2 4 t t)))))
 266
 267   ;; testing unions
 268   (Assert (ase-interval-equal-p ia (ase-interval-union ia)))
 269   (Assert (ase-interval-equal-p huge (ase-interval-union huge)))
 270   (Assert (ase-interval-equal-p huge (ase-interval-union huge i1)))
 271   (Assert (ase-interval-equal-p huge (ase-interval-union huge i2)))
 272   (Assert (ase-interval-equal-p huge (ase-interval-union huge i3)))
 273   (Assert (ase-interval-equal-p huge (ase-interval-union huge i5)))
 274   (Assert (ase-interval-equal-p huge (ase-interval-union huge i6)))
 275   (Assert (ase-interval-equal-p huge (ase-interval-union huge i7)))
 276   (Assert (ase-interval-equal-p huge (ase-interval-union huge i123)))
 277   (Assert (ase-interval-equal-p huge (ase-interval-union huge i567)))
 278   (Assert (ase-interval-equal-p huge (ase-interval-union huge tiny)))
 279   (Assert (ase-interval-equal-p (ase-interval 1 2 nil t)
 280                                 (ase-interval-union i6 ia)))
 281   (Assert (ase-interval-equal-p (ase-interval 1 2 nil t)
 282                                 (ase-interval-union ia i6)))
 283   (Assert (ase-interval-equal-p (ase-interval-union i5 i3)
 284                                 (ase-interval-union aei i3 aei i5 i5 aei)))
 285   (Assert (ase-interval-equal-p (ase-interval-union i3 i5)
 286                                 (ase-interval-union aei i3 i5 aei i5 aei)))
 287   (Assert (ase-interval-equal-p
 288            huge (ase-interval-union
 289                  (ase-interval-union i1 i3 (ase-interval 1 6)) huge)))
 290
 291   (Assert (not (ase-interval-imprimitive-p (ase-interval-union ia))))
 292   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge))))
 293   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i1))))
 294   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i2))))
 295   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i3))))
 296   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i5))))
 297   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i6))))
 298   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i7))))
 299   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i123))))
 300   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge i567))))
 301   (Assert (not (ase-interval-imprimitive-p (ase-interval-union huge tiny))))
 302   (Assert (not (ase-interval-imprimitive-p (ase-interval-union i6 ia))))
 303   (Assert (not (ase-interval-imprimitive-p (ase-interval-union ia i6))))
 304   (Assert (ase-interval-imprimitive-p (ase-interval-union aei i3 i5 aei i5 aei)))
 305
 306
 307   ;; test measures
 308   (Assert (= (ase-interval-lebesgue-measure i1) 1))
 309   (Assert (= (ase-interval-lebesgue-measure i2) 1))
 310   (Assert (= (ase-interval-lebesgue-measure i3) 1))
 311   (Assert (= (ase-interval-lebesgue-measure i5) 1))
 312   (Assert (= (ase-interval-lebesgue-measure i6) 1))
 313   (Assert (= (ase-interval-lebesgue-measure i7) 1))
 314   (Assert (= (ase-interval-lebesgue-measure i8) 2))
 315   (Assert (= (ase-interval-lebesgue-measure i9) 2))
 316   (Assert (= (ase-interval-lebesgue-measure ia) 0))
 317   (Assert (= (ase-interval-lebesgue-measure ib) 0))
 318   (Assert (= (ase-interval-lebesgue-measure ic) 0))
 319   (Assert (= (ase-interval-lebesgue-measure aei) 0))
 320   (Assert (= (ase-interval-lebesgue-measure aui) +infinity))
 321   (Assert (= (ase-interval-lebesgue-measure i56) 2))
 322   (Assert (= (ase-interval-lebesgue-measure i567) 3))
 323   (Assert (= (ase-interval-lebesgue-measure i13) 2))
 324   (Assert (= (ase-interval-lebesgue-measure huge) 10))
 325   (Assert (= (ase-interval-lebesgue-measure tiny) 3))
 326   (Assert
 327    (almost= (ase-interval-lebesgue-measure (ase-interval 0.1 1.2)) 1.1 1e-4))
 328   (Assert
 329    (almost= (ase-interval-lebesgue-measure (ase-interval -0.1 0.2)) 0.3 1e-4))
 330   (Assert
 331    (almost= (ase-interval-lebesgue-measure (ase-interval -1.2 -1.1)) 0.1 1e-4))
 332
 333   (Assert (= (ase-interval-rational-measure i1) 2))
 334   (Assert (= (ase-interval-rational-measure i2) 2))
 335   (Assert (= (ase-interval-rational-measure i3) 2))
 336   (Assert (= (ase-interval-rational-measure i5) 0))
 337   (Assert (= (ase-interval-rational-measure i6) 0))
 338   (Assert (= (ase-interval-rational-measure i7) 0))
 339   (Assert (= (ase-interval-rational-measure i8) 3))
 340   (Assert (= (ase-interval-rational-measure i9) 3))
 341   (Assert (= (ase-interval-rational-measure ia) 1))
 342   (Assert (= (ase-interval-rational-measure ib) 0))
 343   (Assert (= (ase-interval-rational-measure ic) 0))
 344   (Assert (= (ase-interval-rational-measure aei) 0))
 345   (Assert (= (ase-interval-rational-measure aui) +infinity))
 346   (Assert (= (ase-interval-rational-measure i56) 0))
 347   (Assert (= (ase-interval-rational-measure i567) 0))
 348   (Assert (= (ase-interval-rational-measure i13) 4))
 349   (Assert (= (ase-interval-rational-measure huge) 11))
 350   (Assert (= (ase-interval-rational-measure tiny) 4))
 351   (Assert (= (ase-interval-rational-measure (ase-interval 0.1 1.2)) 1))
 352   (Assert (= (ase-interval-rational-measure (ase-interval -0.1 0.2)) 1))
 353   (Assert (= (ase-interval-rational-measure (ase-interval -1.2 -1.1)) 0))
 354   (Assert (= (ase-interval-rational-measure (ase-interval -1 1)) 3))
 355   (Assert (= (ase-interval-rational-measure (ase-interval -1 1 t t)) 1))
 356
 357
 358   ;; testing accessors
 359   (Assert (= (ase-interval-lower i1) 0))
 360   (Assert (= (ase-interval-lower i5) 0))
 361   (Assert (= (ase-interval-lower i2) 1))
 362   (Assert (= (ase-interval-lower i6) 1))
 363   (Assert (= (ase-interval-lower i3) 2))
 364   (Assert (= (ase-interval-lower i7) 2))
 365   (Assert (= (ase-interval-upper i1) 1))
 366   (Assert (= (ase-interval-upper i5) 1))
 367   (Assert (= (ase-interval-upper i2) 2))
 368   (Assert (= (ase-interval-upper i6) 2))
 369   (Assert (= (ase-interval-upper i3) 3))
 370   (Assert (= (ase-interval-upper i7) 3))
 371   (Assert (ase-interval-equal-p
 372            (dllist-car (ase-interval-explode-union i567)) i5))
 373
 374   ;; testing intersections
 375   (Assert (ase-interval-equal-p (ase-interval-intersection i123 i8) i8))
 376   (Assert (ase-interval-equal-p (ase-interval-intersection i567 i8) i56))
 377   (Assert (ase-interval-equal-p
 378            (ase-interval-intersection
 379             (ase-interval 1 3) (ase-interval 2 4)) i3))
 380   (Assert (eq
 381            (ase-interval-intersection
 382             (ase-interval 1 3) (ase-interval -2 -4)) aei))
 383   (Assert (ase-interval-equal-p
 384            (ase-interval-intersection huge tiny)
 385            (ase-interval-intersection tiny huge)))
 386   (Assert (ase-interval-equal-p
 387            (ase-interval-intersection tiny tiny tiny tiny) tiny))
 388   (Assert (eq
 389            (ase-interval-intersection tiny aei huge) aei))
 390   (Assert (ase-interval-equal-p
 391            (ase-interval-intersection huge aui) huge))
 392
 393   ;; testing differences
 394   (Assert (ase-interval-equal-p
 395            (ase-interval-difference i8 i9) ;; [0 1)
 396            (ase-interval 0 1 nil t)))
 397   (Assert (ase-interval-equal-p
 398            (ase-interval-difference i9 i8) ;; (2 3]
 399            (ase-interval 2 3 t)))
 400   (Assert (ase-interval-empty-p
 401            (ase-interval-difference tiny huge)))
 402   (Assert (ase-interval-empty-p
 403            (ase-interval-difference tiny tiny)))
 404   (Assert (ase-interval-empty-p
 405            (ase-interval-difference aei tiny)))
 406   (Assert (ase-interval-equal-p
 407            (ase-interval-difference huge tiny) ;; [0 2) + (5 10]
 408            (ase-interval-union
 409             (ase-interval 0 2 nil t) (ase-interval 5 10 t))))
 410   (Assert (ase-interval-equal-p
 411            (ase-interval-difference huge tiny tiny) ;; [0 2) + (5 10]
 412            (ase-interval-union
 413             (ase-interval 0 2 nil t) (ase-interval 5 10 t))))
 414   (Assert (ase-interval-equal-p
 415            (ase-interval-difference tiny aei) tiny))
 416   (Assert (ase-interval-equal-p
 417            (ase-interval-difference huge aei) huge))
 418   (Assert (ase-interval-equal-p
 419            (ase-interval-difference i567 aei) i567))
 420   (Assert (ase-interval-equal-p
 421            (ase-interval-difference tiny) tiny))
 422   (Assert (ase-interval-equal-p
 423            (ase-interval-difference i123 i3)
 424            (ase-interval 0 2 nil t)))
 425
 426   ;; boundaries
 427   (Assert (ase-interval-equal-p
 428            (ase-interval-boundary i1)
 429            (ase-interval-union (ase-interval 0) (ase-interval 1))))
 430   (Assert (ase-interval-empty-p
 431            (ase-interval-boundary ia)))
 432   (Assert (ase-interval-equal-p
 433            (ase-interval-boundary i567)
 434            (ase-interval-union
 435             (ase-interval 0) (ase-interval 1)
 436             (ase-interval 2) (ase-interval 3))))
 437   (Assert (ase-interval-empty-p
 438            (ase-interval-boundary
 439             (ase-interval-boundary i1))))
 440   (Assert (ase-interval-empty-p
 441            (ase-interval-boundary
 442             (ase-interval-boundary i567))))
 443   (Assert (ase-interval-equal-p
 444            ;; i123 \ b(i567) => i567
 445            (ase-interval-difference
 446             i123 (ase-interval-boundary i567)) i567))
 447   (Assert (ase-interval-empty-p
 448            ;; i567 n b(i567) => ( )
 449            (ase-interval-intersection
 450             i567 (ase-interval-boundary i567))))
 451   ;; interiors
 452   (Assert (ase-interval-equal-p (ase-interval-interior i1) i5))
 453   (Assert (ase-interval-equal-p (ase-interval-interior i5) i5))
 454   (Assert (ase-interval-empty-p (ase-interval-interior ia)))
 455   (Assert (ase-interval-equal-p
 456            (ase-interval-interior (ase-interval-union ia i7)) i7))
 457   (Assert (ase-interval-equal-p
 458            (ase-interval-interior i123) (ase-interval 0 3 t t)))
 459   ;; closures
 460   (Assert (ase-interval-equal-p (ase-interval-closure i1) i1))
 461   (Assert (ase-interval-equal-p (ase-interval-closure i5) i1))
 462   (Assert (ase-interval-equal-p (ase-interval-closure ia) ia))
 463   (Assert (ase-interval-equal-p
 464            (ase-interval-closure (ase-interval-union ia i7))
 465            (ase-interval-union ia i3)))
 466   (Assert (ase-interval-equal-p
 467            (ase-interval-closure i567) i123))
 468   )
 469
 470 ;; testing interior products of intervals
 471 (when (featurep 'ase-cartesian)
 472   ;; some interior products
 473   (setq c11 (ase-cartesian* i1 i1))
 474   (setq c12 (ase-cartesian* i1 i2))
 475   (setq c21 (ase-cartesian* i2 i1))
 476   (setq c22 (ase-cartesian* i2 i2))
 477   (setq c33 (ase-cartesian* i3 i3))
 478   (setq c555 (ase-cartesian* i5 i5 i5))
 479   (setq c777 (ase-cartesian* i7 i7 i7))
 480   (setq c788 (ase-cartesian* i7 i8 i8))
 481   (setq c55 (ase-cartesian* i5 i5))
 482   (setq c66 (ase-cartesian* i6 i6))
 483   (setq c15 (ase-cartesian* i1 i5))
 484   (setq c16 (ase-cartesian* i1 i6))
 485   (setq c51 (ase-cartesian* i5 i1))
 486   (setq c0303 (ase-cartesian* i123 i123))
 487   (setq c030303 (ase-cartesian* i123 i123 i123))
 488   (setq caa (ase-cartesian* ia ia))
 489   (setq cHO (ase-cartesian* (ase-interval 0 2 t)
 490                             (ase-interval -1 1 nil t)))
 491   ;; degenerated interior interval product
 492   (setq cdeg (ase-cartesian* ia i1))
 493   ;; only corner connected
 494   (setq ccc1 (ase-cartesian* (ase-interval 0 1 nil t)
 495                              (ase-interval 0 1 t))
 496         ccc2 (ase-cartesian* (ase-interval 1 2 nil t)
 497                              (ase-interval -1 0)))
 498   ;; points
 499   (setq p00 (ase-cartesian* 0 0))
 500   (setq p11 (ase-cartesian* 1 1))
 501   (setq phalfhalf (ase-cartesian* 0.5 0.5))
 502   ;; some unions
 503   (setq t1 (ase-interval-union c11 c22)) ;; doesnt merge
 504   (setq t2 (ase-interval-union c11 c12)) ;; does merge (2nd dimension)
 505   (setq t3 (ase-interval-union c21 c11)) ;; does merge (1st dimension)
 506   (setq t4 (ase-interval-union c11 c22 c21 c12)) ;; does merge (all dimensions)
 507   (setq t5 (ase-interval-union c21 c12))
 508   (setq t133 (ase-interval-union t1 c33))
 509   (setq t5566 (ase-interval-union c55 c66))
 510   (setq t15 (ase-interval-union t1 t5))
 511   (setq t555777 (ase-interval-union c555 c777))
 512   (setq t555788 (ase-interval-union c555 c788))
 513   (setq ttt12 (ase-interval-union ccc1 ccc2))
 514   (setq chuge (ase-cartesian* huge huge))
 515   (setq ctiny (ase-cartesian* tiny tiny))
 516   (setq cst1 (ase-cartesian* i3 i2))
 517   (setq cst2 (ase-cartesian* i123 i123))
 518   (setq cst3 (ase-cartesian* i1 i2))
 519   (setq cst4 (ase-cartesian* i8 i8))
 520   (setq cst5 (ase-cartesian* (ase-interval 2 4 t t) i2))
 521   (setq cst6 (ase-cartesian* (ase-interval 2 4 t t)
 522                              (ase-interval -1 1 t t)))
 523
 524   (Assert (ase-interval-imprimitive-p c11))
 525   (Assert (ase-interval-imprimitive-p c555))
 526   (Assert (eq (ase-cartesian-ground-domain c11) 'ase:interval))
 527   (Assert (eq (ase-cartesian-ground-domain c555) 'ase:interval))
 528   (Assert (ase-interval-closed-p c11))
 529   (Assert (not (ase-interval-open-p c11)))
 530   (Assert (ase-interval-open-p c555))
 531   (Assert (not (ase-interval-closed-p c555)))
 532   (Assert (not (ase-interval-open-p c15)))
 533   (Assert (not (ase-interval-closed-p c15)))
 534   (Assert (not (ase-interval-open-p c51)))
 535   (Assert (not (ase-interval-closed-p c15)))
 536   (Assert (ase-interval-empty-p (ase-cartesian* i1 aei)))
 537   (Assert (ase-interval-empty-p (ase-cartesian* aei i1)))
 538   (Assert (ase-interval-empty-p (ase-cartesian* i1 aei i1)))
 539   (Assert (ase-interval-empty-p (ase-cartesian* i1 i1 i1 aei)))
 540
 541   (Assert (ase-interval-contains-p c11 c55))
 542   (Assert (ase-interval-contains-p c0303 c11))
 543   (Assert (ase-interval-contains-p c0303 c55))
 544   (Assert (ase-interval-contains-p cHO c55))
 545   (Assert (not (ase-interval-contains-p cHO c11)))
 546   (Assert (not (ase-interval-contains-p c55 c11)))
 547   (Assert (ase-interval-contains-p c030303 c555))
 548   (Assert (not (ase-interval-contains-p c555 c030303)))
 549   (Check-Error embed-error (ase-interval-contains-p c11 c555))
 550   (Check-Error embed-error (ase-interval-contains-p c555 c55))
 551   (Check-Error embed-error (ase-interval-contains-p huge c11))
 552   (Check-Error embed-error (ase-interval-contains-p c11 i1))
 553   (Check-Error embed-error (ase-interval-contains-p c11 0))
 554   (Assert (ase-interval-contains-p c11 p00))
 555   (Assert (ase-interval-contains-p c11 p11))
 556   (Assert (ase-interval-contains-p c11 phalfhalf))
 557   (Assert (ase-interval-contains-p c55 phalfhalf))
 558   (Assert (not (ase-interval-contains-p c55 p00)))
 559   (Assert (not (ase-interval-contains-p c55 p11)))
 560
 561   (Assert (not (ase-interval-disjoint-p c55 c11)))
 562   (Assert (not (ase-interval-disjoint-p c11 c55)))
 563   (Assert (not (ase-interval-disjoint-p c11 c12)))
 564   (Assert (not (ase-interval-disjoint-p c12 c11)))
 565   (Assert (ase-interval-disjoint-p c15 c16))
 566   (Assert (ase-interval-disjoint-p c16 c15))
 567   (Assert (not (ase-interval-disjoint-p cHO c11)))
 568   (Assert (ase-interval-disjoint-p cHO c12))
 569   (Assert (ase-interval-disjoint-p c12 cHO))
 570   (Assert (not (ase-interval-disjoint-p c21 cHO)))
 571   (Assert (ase-interval-disjoint-p ccc1 ccc2))
 572   (Assert (ase-interval-disjoint-p c55 caa c66))
 573
 574   (Assert (ase-interval-equal-p c11 c11))
 575   (Assert (ase-interval-equal-p c15 c15))
 576   (Assert (not (ase-interval-equal-p c15 c51)))
 577   (Assert (not (ase-interval-equal-p c51 c15)))
 578
 579   (Assert (ase-interval-connected-p cdeg))
 580   (Assert (ase-interval-connected-p c11))
 581   (Check-Error embed-error (ase-interval-connected-p i1 c11))
 582   (Assert (ase-interval-connected-p c11 c11))
 583   (Assert (ase-interval-connected-p c11 caa))
 584   (Assert (ase-interval-connected-p caa c11))
 585   (Assert (ase-interval-connected-p c11 cdeg))
 586   (Assert (ase-interval-connected-p cdeg c11))
 587   (Assert (ase-interval-connected-p c12 c15))
 588   (Assert (ase-interval-connected-p c15 c12))
 589   (Assert (ase-interval-connected-p c51 c15))
 590   (Assert (ase-interval-connected-p c15 c51))
 591   (Assert (ase-interval-connected-p c51 c11))
 592   (Assert (ase-interval-connected-p c11 c51))
 593   (Assert (ase-interval-connected-p c51 c16))
 594   (Assert (ase-interval-connected-p c16 c51))
 595   (Assert (ase-interval-connected-p c11 c22))
 596   (Assert (ase-interval-connected-p c15 caa))
 597   (Assert (ase-interval-connected-p c15 cdeg))
 598   (Assert (ase-interval-connected-p caa cdeg))
 599   (Assert (ase-interval-connected-p c55 caa))
 600   (Assert (ase-interval-connected-p c55 cdeg))
 601   (Assert (not (ase-interval-connected-p c55 c66)))
 602   (Assert (ase-interval-connected-p caa c66))
 603   (Assert (ase-interval-connected-p c55 caa c66))
 604   (Assert (ase-interval-connected-p c030303 c555))
 605   (Assert (ase-interval-connected-p c0303 c55))
 606   (Assert (ase-interval-connected-p c0303 c11))
 607   (Assert (ase-interval-connected-p cHO))
 608   (Assert (ase-interval-connected-p cHO c11))
 609   (Assert (ase-interval-connected-p cHO c12))
 610   (Assert (ase-interval-connected-p c12 cHO))
 611   (Assert (ase-interval-connected-p c21 cHO))
 612   (Assert (ase-interval-connected-p ccc1 ccc2))
 613
 614   ;; testing unions of cartesian products
 615   (Assert (ase-interval-equal-p
 616            (ase-interval-union c11 aei) c11))
 617   (Assert (ase-interval-equal-p
 618            (ase-interval-union aei c11) c11))
 619   (Assert (ase-interval-equal-p
 620            (ase-interval-union c555 aei) c555))
 621   (Assert (ase-interval-equal-p
 622            (ase-interval-union aei c555) c555))
 623   (Assert (ase-interval-equal-p
 624            t133 (ase-interval-union c11 c22 c33)))
 625   (Assert (ase-interval-equal-p
 626            t133 (ase-interval-union c22 c33 c11)))
 627   (Assert (ase-interval-equal-p
 628            (ase-interval-union t1 c21)
 629            (ase-interval-union c21 c22 aei c11)))
 630   (Assert (ase-interval-equal-p t15 t4))
 631   (Assert (ase-interval-contains-p t133 p00))
 632   (Assert (ase-interval-contains-p t133 p11))
 633   (Assert (ase-interval-contains-p t133 phalfhalf))
 634   (Assert (ase-interval-contains-p t133 c55))
 635   (Assert (ase-interval-contains-p t133 c66))
 636   (Assert (not (ase-interval-contains-p t5566 p00)))
 637   (Assert (not (ase-interval-contains-p t5566 p11)))
 638   (Assert (ase-interval-contains-p t5566 phalfhalf))
 639   (Assert (ase-interval-connected-p t133))
 640   (Assert (not (ase-interval-connected-p t5566)))
 641   (Assert (ase-interval-connected-p t4 c33))
 642   (Assert (ase-interval-connected-p c33 t4))
 643   (Assert (not (ase-interval-disjoint-p t15 t4)))
 644   (Assert (not (ase-interval-disjoint-p t15 t4)))
 645   (Assert (not (ase-interval-disjoint-p t4 c11)))
 646   (Assert (not (ase-interval-disjoint-p c11 t4)))
 647   (Assert (not (ase-interval-disjoint-p c66 t15)))
 648   (Assert (not (ase-interval-disjoint-p t15 c66)))
 649   (Assert (not (ase-interval-disjoint-p t133 c55)))
 650   (Assert (not (ase-interval-disjoint-p c55 t133)))
 651   (Assert (not (ase-interval-disjoint-p t4 c11 c22 c55 c66)))
 652   (Assert (not (ase-interval-disjoint-p c11 t4 c22 c55 c66)))
 653   (Assert (not (ase-interval-disjoint-p c11 c22 t4)))
 654
 655   ;; boundaries
 656   (Assert (ase-interval-equal-p
 657            (ase-interval-boundary c11)
 658            ;; #<ase:interval-union [0] x [0 1] u [1] x [0 1] u
 659            ;;    [0 1] x [0] u [0 1] x [1]>
 660            (ase-interval-union
 661             (ase-cartesian* id i1)
 662             (ase-cartesian* ia i1)
 663             (ase-cartesian* i1 id)
 664             (ase-cartesian* i1 ia))))
 665   (Assert (ase-interval-equal-p
 666            (ase-interval-boundary cdeg)
 667            ;; #<ase:interval-union [1] x [0] u [1] x [1]>
 668            (ase-interval-union
 669             (ase-cartesian* ia id)
 670             (ase-cartesian* ia ia))))
 671   (Assert (ase-interval-empty-p
 672            (ase-interval-boundary caa)))
 673   (Assert (ase-interval-equal-p
 674            (ase-interval-boundary t1)
 675            ;; #<ase:interval-union
 676            ;;   [0] x [0 1] u [1] x [0 1] u [0 1] x [0] u [0 1] x [1] u
 677            ;;   [1] x [1 2] u [2] x [1 2] u [1 2] x [1] u [1 2] x [2]>
 678            (ase-interval-union
 679             (ase-cartesian* id i1)
 680             (ase-cartesian* ia i1)
 681             (ase-cartesian* i1 id)
 682             (ase-cartesian* i1 ia)
 683             (ase-cartesian* ia i2)
 684             (ase-cartesian* ie i2)
 685             (ase-cartesian* i2 ia)
 686             (ase-cartesian* i2 ie))))
 687   (Assert (ase-interval-equal-p
 688            (ase-interval-boundary cHO)
 689            ;; #<ase:interval-union [0] x [-1 1) u [2] x [-1 1) u
 690            ;;    (0 2] x [-1] u (0 2] x [1]>
 691            (ase-interval-union
 692             (ase-cartesian* id (ase-interval -1 1 nil t))
 693             (ase-cartesian* ie (ase-interval -1 1 nil t))
 694             (ase-cartesian* (ase-interval 0 2 t) (ase-interval -1 -1))
 695             (ase-cartesian* (ase-interval 0 2 t) (ase-interval 1 1)))))
 696   (Assert (ase-interval-equal-p
 697            (ase-interval-boundary (ase-interval-boundary c11))
 698            ;; #<ase:interval-union [0] x [0] u [0] x [1] u
 699            ;;   [1] x [0] u [1] x [1]>
 700            (ase-interval-union
 701             (ase-cartesian* id id)
 702             (ase-cartesian* id ia)
 703             (ase-cartesian* ia id)
 704             (ase-cartesian* ia ia))))
 705   (Assert (ase-interval-empty-p
 706            (ase-interval-boundary
 707             (ase-interval-union (ase-interval 0) ia))))
 708
 709   ;; closures
 710   (Assert (ase-interval-equal-p
 711            (ase-interval-closure c55) c11))
 712   (Assert (ase-interval-equal-p
 713            (ase-interval-closure c11) c11))
 714   (Assert (ase-interval-equal-p
 715            (ase-interval-closure t5566) t1))
 716
 717   ;; interiors
 718   (Assert (ase-interval-equal-p
 719            (ase-interval-interior c55) c55))
 720   (Assert (ase-interval-equal-p
 721            (ase-interval-interior c11) c55))
 722   (Assert (ase-interval-equal-p
 723            (ase-interval-interior t1) t5566))
 724
 725
 726   ;; measures
 727   (Assert (= (ase-interval-lebesgue-measure c11) 1))
 728   (Assert (= (ase-interval-lebesgue-measure c12) 1))
 729   (Assert (= (ase-interval-lebesgue-measure c555) 1))
 730   (Assert (= (ase-interval-lebesgue-measure c11) 1))
 731   (Assert (= (ase-interval-lebesgue-measure c0303) 9))
 732   (Assert (= (ase-interval-lebesgue-measure c030303) 27))
 733   (Assert (= (ase-interval-lebesgue-measure cHO) 4))
 734   (Assert (= (ase-interval-lebesgue-measure cdeg) 0))
 735   (Assert (= (ase-interval-lebesgue-measure caa) 0))
 736   (Assert (= (ase-interval-lebesgue-measure t1) 2))
 737   (Assert (= (ase-interval-lebesgue-measure t133) 3))
 738   (Assert (= (ase-interval-lebesgue-measure t5) 2))
 739   (Assert (= (ase-interval-lebesgue-measure t5566) 2))
 740   (Assert (= (ase-interval-lebesgue-measure t555777) 2))
 741   (Assert (= (ase-interval-lebesgue-measure t555788) 5))
 742   (Assert (= (ase-interval-lebesgue-measure ttt12) 2))
 743   (Assert (= (ase-interval-rational-measure c11) 4))
 744   (Assert (= (ase-interval-rational-measure c12) 4))
 745   (Assert (= (ase-interval-rational-measure c555) 0))
 746   (Assert (= (ase-interval-rational-measure c0303) 16))
 747   (Assert (= (ase-interval-rational-measure c030303) 64))
 748   (Assert (= (ase-interval-rational-measure cHO) 4))
 749   (Assert (= (ase-interval-rational-measure cdeg) 2))
 750   (Assert (= (ase-interval-rational-measure caa) 1))
 751   (Assert (= (ase-interval-rational-measure t1) 8))
 752   (Assert (= (ase-interval-rational-measure t133) 12))
 753   (Assert (= (ase-interval-rational-measure t5) 8))
 754   (Assert (= (ase-interval-rational-measure t5566) 0))
 755   (Assert (= (ase-interval-rational-measure t555777) 0))
 756   (Assert (= (ase-interval-rational-measure t555788) 0))
 757   (Assert (= (ase-interval-rational-measure ttt12) 3))
 758
 759
 760   ;; intersections
 761   (Assert (ase-interval-equal-p
 762            (ase-interval-intersection
 763             c11 (ase-cartesian*
 764                  (ase-interval 0.5 0.75) (ase-interval -1 2)))
 765            (ase-cartesian*
 766             (ase-interval 0.5 0.75) i1)))
 767   (Assert (ase-interval-equal-p
 768            (ase-interval-intersection t1 c11) c11))
 769   (Assert (ase-interval-equal-p
 770            (ase-interval-intersection t1 t2)
 771            ;; #<ase:interval-union [0 1] x [0 1] u [1] x [1 2]>
 772            (ase-interval-union
 773             c11 (ase-cartesian* ia i2))))
 774   (Assert (ase-interval-equal-p
 775            (ase-interval-intersection t1 t5)
 776            ;; [0 2] x [1] u [1] x [0 2]
 777            (ase-interval-union
 778             (ase-cartesian* (ase-interval 0 2) (ase-interval 1))
 779             (ase-cartesian* (ase-interval 1) (ase-interval 0 2)))))
 780
 781   ;; differences
 782   (Assert (ase-interval-equal-p
 783            (ase-interval-difference chuge cst1)
 784            ;;#<ase:interval-union [0 2) x [1 2] u (3 10] x [1 2] u
 785            ;;    [0 10] x [0 1) u [0 10] x (2 10]>
 786            (ase-interval-union
 787             (ase-cartesian* (ase-interval 0 2 nil t) i2)
 788             (ase-cartesian* (ase-interval 3 10 t) i2)
 789             (ase-cartesian* huge (ase-interval 0 1 nil t))
 790             (ase-cartesian* huge (ase-interval 2 10 t)))))
 791   (Assert (ase-interval-equal-p
 792            (ase-interval-difference cst2 cst1)
 793            ;;#<ase:interval-union [0 2) x [1 2] u [0 3] x [0 1) u
 794            ;;    [0 3] x (2 3]>
 795            (ase-interval-union
 796             (ase-cartesian* (ase-interval 0 2 nil t) i2)
 797             (ase-cartesian* i123 (ase-interval 0 1 nil t))
 798             (ase-cartesian* i123 (ase-interval 2 3 t)))))
 799   (Assert (ase-interval-equal-p
 800            (ase-interval-difference cst2 cst3)
 801            ;;#<ase:interval-union (1 3] x [1 2] u [0 3] x [0 1) u
 802            ;;    [0 3] x (2 3]>
 803            (ase-interval-union
 804             (ase-cartesian* (ase-interval 1 3 t) i2)
 805             (ase-cartesian* i123 (ase-interval 0 1 nil t))
 806             (ase-cartesian* i123 (ase-interval 2 3 t)))))
 807   (Assert (ase-interval-equal-p
 808            (ase-interval-difference cst4 cst1)
 809            ;; #<ase:interval-union [0 2) x [1 2] u [0 2] x [0 1)>
 810            (ase-interval-union
 811             (ase-cartesian* (ase-interval 0 2 nil t) i2)
 812             (ase-cartesian* i8 (ase-interval 0 1 nil t)))))
 813   (Assert (ase-interval-equal-p
 814            (ase-interval-difference cst2 cst5)
 815            ;;#<ase:interval-union [0 2] x [1 2] u [0 3] x [0 1) u
 816            ;;     [0 3] x (2 3]>
 817            (ase-interval-union
 818             (ase-cartesian* i8 i2)
 819             (ase-cartesian* i123 (ase-interval 0 1 nil t))
 820             (ase-cartesian* i123 (ase-interval 2 3 t)))))
 821   (Assert (ase-interval-equal-p
 822            (ase-interval-difference cst2 cst6)
 823            ;;#<ase:interval-union [0 2] x (-1 1) u [0 3] x [1 3]>
 824            (ase-interval-union
 825             (ase-cartesian* i8 (ase-interval -1 1 t t))
 826             (ase-cartesian* i123 (ase-interval 1 3)))))
 827
 828   ;;(+ i1 1)
 829   ;;(+ 2 i1)
 830   ;;(+ 2.0 i1)
 831   )
 832 ;; ase-interval-tests.el ends here