[r2004-09-30 15:43:48 by afrisch] Interval arithmetic for *

Original author: afrisch
Date: 2004-09-30 15:46:04+00:00

CHANGES

+Since 0.2.1
+- interval arithmetic for the * operator
+- warning for potential division by 0
+
 0.2.1
 
 - string:// scheme for load_xml and others

Makefile.distrib

 include Makefile.conf
-VERSION = 0.2.1
+VERSION = 0.2.1+1
 
 all: cduce dtd2cduce validate cdo2ml cduce_lib.cma
 ifeq ($(NATIVE),true)

types/builtin.ml

@@ -270,8 +270,11 @@ binary_op "-"
      | (Value.Integer x, Value.Integer y) -> Value.Integer (Intervals.V.sub x y)
      | _ -> assert false);;
 
-binary_op_cst "*"
-  int int int
+binary_op "*"
+  int int
+  (fun t1 t2 ->
+     Types.interval 
+     (Intervals.mul (Types.Int.get t1) (Types.Int.get t2)))
   (fun v1 v2 -> match (v1,v2) with
      | (Value.Integer x, Value.Integer y) -> Value.Integer (Intervals.V.mult x y)
      | _ -> assert false);;

types/intervals.ml

@@ -285,7 +285,8 @@ let print =
     )
 
 
-let (+) = add_big_int
+let ( + ) = add_big_int
+let ( * ) = mult_big_int
 
 
 let add_inter i1 i2 = 
@@ -322,6 +323,61 @@ let negat =
 let sub l1 l2 =
   add l1 (negat l2)
 
+type i = PlusInf | MinusInf | Int of V.t
+
+let ( * ) x y = 
+  match (x,y) with
+    | PlusInf,PlusInf | MinusInf,MinusInf -> PlusInf
+    | PlusInf,MinusInf | MinusInf,PlusInf -> MinusInf
+    | Int x, Int y -> Int (x * y)
+    | i,(Int x as ix) | (Int x as ix), i ->
+	(match i, sign_big_int x with
+	   | PlusInf,1 | MinusInf,-1 -> PlusInf
+	   | PlusInf,-1 | MinusInf,1 -> MinusInf
+	   | _ -> ix)
+
+let min a b =
+  match (a,b) with
+    | MinusInf,_ | _,PlusInf -> a
+    | PlusInf,_ | _,MinusInf -> b
+    | Int x, Int y -> if le_big_int x y then a else b
+
+let max a b =
+  match (a,b) with
+    | MinusInf,_ | _,PlusInf -> b
+    | PlusInf,_ | _,MinusInf -> a
+    | Int x, Int y -> if le_big_int x y then b else a
+
+let max4 a b c d = max a (max b (max c d))
+let min4 a b c d = min a (min b (min c d))
+
+let ival = function
+  | Bounded (a,b) -> (Int a,Int b)
+  | Left a -> (MinusInf,Int a)
+  | Right a -> (Int a,PlusInf)
+  | Any -> (MinusInf,PlusInf)
+
+let vali = function
+  | (Int a, Int b) -> Bounded (a,b)
+  | (MinusInf, Int a) -> Left a
+  | (Int a, PlusInf) -> Right a
+  | (MinusInf, PlusInf) -> Any
+  | _ -> assert false
+
+let mul_inter i1 i2 =
+  let (a1,b1) = ival i1 and (a2,b2) = ival i2 in
+  let a = a1 * a2 and b = b1 * b2 and c = a1 * b2 and d = a2 * b1 in
+  vali (min4 a b c d, max4 a b c d)
+
+let mul l1 l2 =
+  List.fold_left 
+    (fun accu i1 ->
+       List.fold_left
+	 (fun accu i2 -> iadd accu (mul_inter i1 i2))
+	 accu l2
+	 
+    ) empty l1
+
 (*
 let dump s i =
   let ppf = Format.std_formatter in

types/intervals.mli

@@ -55,5 +55,6 @@ val sample : t -> V.t
 
 
 val add : t -> t -> t
+val mul : t -> t -> t
 val sub : t -> t -> t
 val negat : t -> t