ExactNumber.m

A Package to Improve the Handling of Mixtures of Exact and Inexact Numbers

Stephen Wandzura
Hughes Research Laboratories
3011 Malibu Canyon Rd.
Malibu, CA  90265-4779

wandzura@macaw.hrl.hac.com

This research was supported by the Advanced Research Projects Agency of the Department of Defense and was monitored by the Air Force Office of Scientific Research under Contract No. F49620-91-C-0064. The United States Government is authorized to reproduce and distribute reprints for governmental purposes notwithstanding any copyright notation hereron.

Based on Roman Maeder's Skeleton.m.

The reason that the rules for sums and products of exact and inexact numbers are not simplified automatically is that I don't know a way to do so without causing time it take Times[_Real, __] and Plus[_Real,__] to grow exponentially with the number of arguments. This is because the evaluator is trying all possible combinations using the Flat and Orderless Attributes.

Set up the package context, including any imports.

*)
BeginPackage["ExactNumber`"];
(*

Usage messages for the exported functions and the context itself:

*)
ExactNumberQ::usage = "ExactNumberQ[expr] gives True if expr is an exact number, and False otherwise..";

Realize::usage = "Realize[expr] changes exact numbers in expr that are added to or multiplied by real numbers to be converted to Real with the appropriate precision.";
(*

Begin the private context:

*)
Begin["`Private`"];
(*

Unprotect and Clear  functions for which rules will be defined:

*)
Unprotect[ExactNumberQ, Realize];
Clear[ExactNumberQ, Realize];
(*

Define auxiliary functions and exported functions:

*)
ExactNumberQ[_Symbol]=False;
ExactNumberQ[_[___,_?(!ExactNumberQ[#]&),___]]=
	False;
ExactNumberQ[_Integer]=True;
ExactNumberQ[Rational[_?ExactNumberQ,_?ExactNumberQ]]=
	True;
ExactNumberQ[Complex[_?ExactNumberQ,_?ExactNumberQ]]=
	True;
ExactNumberQ[x_Plus] := 
	And[ExactNumberQ[First[x]],
		ExactNumberQ[Rest[x]]];
ExactNumberQ[x_Times] := 
	And[ExactNumberQ[First[x]],
		ExactNumberQ[Rest[x]]];
ExactNumberQ[
	Power[_?ExactNumberQ,_?ExactNumberQ]]=True;
Map[(ExactNumberQ[#]=True)&,
	{Pi, Degree, GoldenRatio,E, EulerGamma, Catalan}
   ];
ExactNumberQ[_]=False;

Realize[e_ /; FreeQ[e,_Real]] =e;
Realize[e_]:=e //.
	{Plus->plus, Times->times}
(*

*)
real= _Real | _Complex[_Real,_Real]
(*

*)

Clear[plus,times];
plus[a___, x:real, b___, y_?ExactNumberQ, c___] :=
	plus[a, x, b,
		 N[y,Accuracy[x]+Log[10,Abs[y]]//N], c
		]
plus[a___, y_?ExactNumberQ, x:real, b___, c___] :=
	plus[a, x, b,
		 N[y,Accuracy[x]+Log[10,Abs[y]]//N], c
		]
plus[x__]:=Plus[x]
DownValues[plus]=
	Join[
		{Literal[plus[x___ /; FreeQ[{x}, _Real]]]
			:> Plus[x], 
		 Literal[plus[x___ /; FreeQ[{x}, _?ExactNumberQ]]]
		 	:> Plus[x]
		},
   DownValues[plus]
	    ];  (* do it this way so that these rules are
	    		applied first*)
times[a___, x:real, b___, y_?ExactNumberQ, c___] :=
	times[a, x, b, N[y,Precision[x]], c]
times[a___, y_?ExactNumberQ, b___, x:real, c___] :=
	times[a, x, b, N[y,Precision[x]], c]
times[x__]:=Times[x]
DownValues[times]=
	Join[
		{Literal[times[x___ /; FreeQ[{x}, _Real]]]
			:> Times[x], 
		 Literal[times[x___ /; FreeQ[{x}, _?ExactNumberQ]]]
		 	:> Times[x]
		},
   DownValues[times]
	    ];  (* do it this way so that these rules are
	    		applied first*)


(*

Protect symbols:

*)
Protect[ExactNumberQ, Realize]
(*

End the private context:

*)
End[]
(*

End the package context:

*)
EndPackage[]
(*