cgit.sxemacs.org Git - sxemacs/blob - tests/automated/ase-metric-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-set")
  54      (require 'ase-set))
  55
  56 (when (featurep 'ase-set)
  57   (setq 2zero (ase-cartesian* 0 0)
  58         3zero (ase-cartesian* 0 0 0)
  59         2one (ase-cartesian* 1 0)
  60         3one (ase-cartesian* 1 0 0)
  61         2|11 (ase-cartesian* 1 1)
  62         2|1-1 (ase-cartesian* 1 -1)
  63         2|-11 (ase-cartesian* -1 1)
  64         2|-1-1 (ase-cartesian* -1 -1)
  65         3|111 (ase-cartesian* 1 1 1)
  66         3|-111 (ase-cartesian* -1 1 1)
  67         3|1-11 (ase-cartesian* 1 -1 1)
  68         3|11-1 (ase-cartesian* 1 1 -1)
  69         3|-11-1 (ase-cartesian* -1 1 -1)
  70         3|-1-11 (ase-cartesian* -1 -1 1)
  71         3|1-1-1 (ase-cartesian* 1 -1 -1)
  72         3|-1-1-1 (ase-cartesian* -1 -1 -1))
  73
  74   ;; euclidean metric (standard metric in maths)
  75   (Assert (= (ase-metric-distance ase-euclidean-metric 3 5) 2))
  76   (Assert (= (ase-metric-distance ase-euclidean-metric 3 5.5) 2.5))
  77   (Check-Error embed-error (ase-metric-distance ase-euclidean-metric 3zero 2one))
  78   (Assert (= (ase-metric-distance ase-euclidean-metric 2zero 2|-11) (sqrt 2)))
  79
  80   ;; supremum metric (default for intervals and neighbourhoods)
  81   (Assert (= (ase-metric-distance ase-supremum-metric 5 4) 1))
  82   (Assert (= (ase-metric-distance ase-supremum-metric 2zero 2|11) 1))
  83   (Assert (= (ase-metric-distance ase-supremum-metric 2|1-1 2zero) 1))
  84   (Assert (= (ase-metric-distance ase-supremum-metric 3|1-11 3zero) 1))
  85   (Assert (= (ase-metric-distance ase-supremum-metric 3|111 3|-1-1-1) 2))
  86   (Assert (= (ase-metric-distance ase-supremum-metric 3|111 3|11-1) 2))
  87   (Assert (= (ase-metric-distance ase-supremum-metric 3|11-1 3|11-1) 0))
  88   (Check-Error embed-error (ase-metric-distance ase-supremum-metric 3|111 2|11))
  89
  90   ;; trivial metric
  91   (Assert (= (ase-metric-distance ase-trivial-metric 2zero 2|11) 1))
  92   (Assert (= (ase-metric-distance ase-trivial-metric 2zero 2zero) 0))
  93   (Assert (= (ase-metric-distance ase-trivial-metric 3|111 3|-1-1-1) 1))
  94   (Assert (= (ase-metric-distance ase-trivial-metric 3zero 3|-1-1-1) 1))
  95
  96   ;; custom metrics
  97   (when (featurep 'bigfr)
  98     (setq R3m (ase-p-metric 3))
  99     (Assert (= (ase-metric-distance R3m 3zero 3|111) (cube-root 3)))
 100     (Assert (nonnegativep (ase-metric-distance R3m 3zero 3|-1-1-1)))
 101     (Assert (zerop (ase-metric-distance R3m 3|-1-1-1 3|-1-1-1))))
 102
 103   (when (featurep 'bigq)
 104     (setq mym (ase-metric
 105                #'(lambda (a b)
 106                    (if (= a b)
 107                        0
 108                      (// (+ a b) 2)))))
 109
 110     (Assert (zerop (ase-metric-distance mym 0 0)))
 111     (Assert (= (ase-metric-distance mym 0 1) 0.5))
 112     (Check-Error metric-distance-error (ase-metric-distance mym -1 -2)))
 113   )
 114 ;; ase-metric-tests.el ends here