(* Title: SwitchableRealOnly *)
(* Author: George Beck and Ted Ersek *)
(* :Summary:
RealOnly is a Standard Packages included with Mathematica, and is used to ensure a
Negative number to a Rational power is Negative when the exponent is Rational and
the Denominator of the exponent is odd. One problem with the RealOnly package is that
once the package is loaded restoring the normal Mathematica behavior is cumbersome at
best. A package called SwitchableRealOnly is provided which does the same thing as the
RealOnly package, and provides a simple method of switching between the normal
Mathematica implementation and the RealOnly implementation of (x^y). Another problem
with the RealOnly package is that once the package is loaded Roots and Solve incorrectly
indicate that some solutions to certain equations are not real. This error is corrected
in the SwitchableRealOnly package. The package and a tutorial are provided in
SwitchableRealOnly.m and SwitchableRealOnlyTutorial.nb respectively.
*)
(* :Context: Miscellaneous`SwitchableRealOnly` *)
(* :Package Version: 1.1 *)
(* :Mathematica Version: 3.0 *)
(* :Copyright: Copyright 1995-1999, Wolfram Research, Inc. *)
(* :History:
On 25 September, 2000 Ted Ersek finished this package which is based
on the RealOnly package included with Mathematica Version 4.0.
On 29 December, 2000 Ted Ersek improved the package by making it essentially
use Im[expr]==0 to determine if the imaginary part of expr is probably zero. If
Im[expr]==0 returns True then expr definitely has imaginary part equal to zero.
If (expr) is numeric and Im[expr]==0 still has the head Equal Mathematica was
unable to determine if this is True or False using arbitrary precision. In this
case expr probably has imaginary part equal to zero. This is much more reliable
than the earlier version which used N[Im[expr]]==0 instead. The earlier method was
less reliable since it used machine precision arithmatic.
*)
(* :Keywords:
algebra, root, radical, real
*)
(* :Source:
*)
(* :Warning:
Loading this package redefines Power, Solve, Roots, and $Post;
complex results are modified.
*)
(* :Limitation: Complex results are not modified for special functions. *)
(* :Discussion:
Two ideas are implemented here. Odd roots of negative numbers are defined to be
negative, and calculations with unavoidable complex numbers are condensed to the
symbol Nonreal. This is done by redefining the built-in functions Power and $Post.
The effect of the redefinition of Power is held off until after the nature of the
results of Solve or Roots have been taken into account.
*)
BeginPackage["Miscellaneous`SwitchableRealOnly`"];
Miscellaneous`SwitchableRealOnly::usage=
"Miscellaneous`SwitchableRealOnly provides the facility to have \
\
Mathematica use only real number solutions in many problems. It is \
turned on \
with RealOnlyOn[] and turned off with RealOnlyOff[].";
Nonreal::usage=
"Nonreal is a symbol that replaces a calculation result that involves
an unavoidable complex number.";
RealOnlyOn::usage=
"Evaluating RealOnlyOn[] ensures x^b returns a negative number when \
\
possible. Also complex numbers with imaginary part close to zero are \
replaced \
with the symbol Nonreal.";
RealOnlyOff::usage=
"Evaluating RealOnlyOff[] restores the normal evaluation of x^b and \
\
permits complex numbers in output as Mathematica normally does.";
Begin["`Private`"];
UseRealOnly=False;
protected=Unprotect[Power,Solve,Roots,$Post];
RealOnlyOn[]:=(UseRealOnly=True;)
RealOnlyOff[]:=(UseRealOnly=False;)
Power[b_?Negative,Rational[m_,n_?OddQ]]/;UseRealOnly:=(-(-b)^(1/n))^m
(*****NonrealRule is a rule that,when applied to an expression,
drops small imaginary parts,
replaces large imaginary parts by the object NonReal,
and forces NonReal up through most elementary calculations.******)
NonrealRule={Complex[a_,_?(Chop[#,10^-13]\[Equal]0&)]\[RuleDelayed]a,
Complex[_,_?(Chop[#,10^-13]=!=0&)]\[Rule]
Nonreal,(Plus|Times|Minus|Subtract|Sqrt|Power|PowerMod|Exp|Log|Sin|
Cos|Tan|Cot|Sec|Csc|ArcSin|ArcCos|ArcTan|ArcCot|ArcSec|ArcCsc|
Floor|Ceiling|Round|Mod|Quotient|Rationalize)[___,
Nonreal,___]\[RuleDelayed]Nonreal};
Nonreal::warning="Nonreal number encountered.";
Nonreal::error=
"A numeric value involving complex numbers was changed to the symbol \
\
Nonreal, but the numeric value may have imaginary part equal to zero.";
NonrealAux[result_]:=
If[TrueQ[UseRealOnly],
Module[{preliminary},preliminary=(result//.NonrealRule);
If[Not[FreeQ[preliminary,Nonreal,{0,Infinity}]],
Message[Nonreal::warning]];
preliminary],result]
(****In the new rules for Solve and Roots below a function CancelComplexParts \
is used on parts that contain complex numbers when the imaginary parts likely \
cancel with each other.Inside ComplexCancel Together@
TrigExpand@
ComplexExpand[x,
TargetFunctions\[Rule]{Re,
Im}] will often cancel imaginary parts.Simplify is used if \
the earlier transformation failed to cancel complex parts.If Simplify also \
fails to cancel complex parts CancelComplexParts sets a flag which causes a \
warning message to be posted.****)
CancelComplexParts[expr_]:=
Module[{x2},
x2=Together@TrigExpand@ComplexExpand[expr,TargetFunctions\[Rule]{Re,Im}];
If[FreeQ[x2,_Complex],
x2,(x2=Simplify[x2];If[!FreeQ[x2,_Complex],NonrealErrorQ=True];x2)]]
NonrealErrorQ=False;
ProbablyReal[x_?NumericQ]:=
With[{r=Block[{Message},Im[x]\[Equal]0]},r||Head[r]===Equal]
ProbablyReal[_]=False;
Solve[args___]/;UseRealOnly:=
Block[{UseRealOnly},
With[{result=
Solve[args]/.x_?(ProbablyReal[#1]&&!(FreeQ[#1,_Complex])&)\
\[RuleDelayed]CancelComplexParts[x]},
If[NonrealErrorQ,Message[Nonreal::error]];
NonrealErrorQ=False;
result]]
Roots[args___]/;UseRealOnly:=
Block[{UseRealOnly},
With[{result=
Roots[args]/.x_?(ProbablyReal[#1]&&!(FreeQ[#1,_Complex])&)\
\[RuleDelayed]CancelComplexParts[x]},
If[NonrealErrorQ,Message[Nonreal::error]];
NonrealErrorQ=False;
result]]
If[FreeQ[$Post,NonrealAux,Heads\[Rule]True],$Post=
Composition[NonrealAux,If[ValueQ[$Post],$Post,Identity]]];
Protect[protected];
Protect[RealOnlyOn,RealOnlyOff];
End[];
EndPackage[]