Inequalities posting: Inequalities.m
- To: mathgroup at yoda.physics.unc.edu
- Subject: Inequalities posting: Inequalities.m
- From: mstankus at oba.ucsd.edu (Mark Stankus)
- Date: Fri, 20 Nov 92 11:22:38 PST
(* :Title: Inequalites // Mathematica 1.2 and 2.0 *)
(* :Author: Mark Stankus (mstankus). *)
(* :Context: Inequalities` *)
(* :Summary:
*)
(* :Alias:
*)
(* :Warnings:
*)
(* :History:
*)
BeginPackage["Inequalities`",
"Convert1`","Errors`"];
Clear[SetInequalityFactBase];
SetInequalityFactBase::usage =
"SetInequalityFactBase[aList] allows for InequalityFactQ, \
BoundedQ,LowerBound,and UpperBound to take one parameter \
and aList is put in for the second parameter.";
Clear[InequalityFactQ];
InequalityFactQ::usage =
"InequalityFactQ[eqn,aListOfFacts] gives True if the equation \
eqn can easily be deduced from the list of assumptions \
aListOfFacts eqn is a True inequality, False if it is False \
and unknown if the program algorithm cannot decide if it is \
True of False. Right now the code only works for GreaterEqual \
equations.";
Clear[InequalitySearch];
InequalitySearch::usage =
"InequalitySearch[expr,aHead,aListOfFacts] searches \
through the list aListOfFacts to find all expressions \
gamma such that aHead[expr,gamma]===True. For example, \
InequalitySearch[a-b,GreaterEqual, \
{a>=2, a<= 7, b<=9, b>= -10,b<=10}] \
would give {-7,-8} (since 2-9 == -7 and 2-10 == -8). \
list. See also NumericalLeafs.";
Clear[InequalityToStandardForm];
InequalityToStandardForm::usage =
"InequalityToStandardForm[eqn] takes an inequality eqn \
and changes it to a standardform. Here, standard form \
is defined in terms of the Convert1 algorithm. For \
example, InequalityToStandardForm[x-y <=0] is y>=x \
(becuase Convert1[x-y==0] is y->x and so the inequality \
is rearranged so that the left hand side is y).";
Clear[NumericalLeafs];
NumericalLeafs::usage =
"NumericalLeafs[expr,aHead,aListOfFacts] evaluates \
NumericalLeafs[expr,aHead,aListOfFacts,40]; \
NumericalLeafs[expr,>=,aListOfFacts,n] tries to find \
all expressions >= 0. Since >= is transitive, this \
may require many calls to InequalitySearch. n gives \
the maximum number of times NumercalLeafs calls the \
InequalitySearch module.";
Clear[BoundedQ];
BoundedQ::usage =
"BoundedQ[expr,aListOfFacts] returns True if the program \
can easily deduce from the list of assumptions given in \
aListOfFacts two inequalities m<= expr and expr<=n where m and \
n are numbers.";
Clear[LowerBound];
LowerBound::usage =
"LowerBound[expr,aListOfFacts] returns the maximum number n such \
that InequalitySearch can deduce expr>=n. If no such \
inequality is generated by InequalitySearch, \
LowerBound[expr,aListOfFacts] is -Infinity.";
Clear[UpperBound];
UpperBound::usage =
"UpperBound[expr,aListOfFacts] returns the minimum number n such \
that InequalitySearch can deduce n>=expr. If no such \
inequality is generated by InequalitySearch, \
UpperBound[expr,aListOfFacts] is Infinity.";
Begin["`Private`"];
InequalitiesDefault = {};
SetInequalityFactBase[aList_List] := InequalitiesDefault = Flatten[aList];
InequalityFactQ[x_] := InequalityFactQ[x,InequalitiesDefault];
LowerBound[x_] := LowerBound[x,InequalitiesDefault];
UpperBound[x_] := UpperBound[x,InequalitiesDefault];
BoundedQ[x_] := BoundedQ[x,InequalitiesDefault];
InequalityFactQ[True,aListOfFacts_List] := True;
InequalityFactQ[False,aListOfFacts_List] := False;
InequalityFactQ[x_Equal,aListOfFacts_List] := InequalityFactQ[x,aListOfFacts] =
Module[{first,second,result},
first = x[[1]];
second = x[[2]];
result = And[InequalityFactQAux[first >= second,aListOfFacts],
InequalityFactQAux[first <= second,aListOfFacts]
];
Return[result]
];
InequalityFactQ[x_,aListOfFacts_List] :=
InequalityFactQAux[x,aListOfFacts];
InequalityFactQ[x___] := BadCall["InequalityFactQ in Inequalities`",x];
InequalityFactQAux[anInequality_,aListOfFacts_List] :=
Module[{theInequality,difference,list,temp,result},
theInequality = InequalityToStandardForm[anInequality];
difference = theInequality[[1]] - theInequality[[2]];
list = InequalitySearch[difference,Head[theInequality],aListOfFacts];
temp = Map[(InequalityFactQ[Head[theInequality][#,0]])&,list];
If[MemberQ[temp,True], result = True
, result = unknown
, result = unknown
];
Return[result]
];
InequalityFactQAux[x___] :=
BadCall["InequalityFactQAux in Inequalities.m",x];
InequalitySearch[aSymbol_Symbol,aHead_,aListOfFacts_List] :=
Map[#[[2]]&,Select[aListOfFacts,(Head[#]==aHead && #[[1]] == aSymbol)&]];
InequalitySearch[x_ + y_,aHead_,aListOfFacts_List] :=
Module[{temp,temp2,len1,len2,j,k,result},
temp = InequalitySearch[x,aHead,aListOfFacts];
temp2 = InequalitySearch[y,aHead,aListOfFacts];
len1 = Length[temp];
len2 = Length[temp2];
result = Table[ temp[[j]] + temp2[[k]]
,{j,1,len1},{k,1,len2}];
result = Union[Flatten[result]];
Return[result]
];
InequalitySearch[c_?NumberQ x_Symbol,aHead_,aListOfFacts_List] :=
Module[{temp,result},
If[c > 0, temp = InequalitySearch[x,aHead,aListOfFacts]
, temp = InequalitySearch[x,Alternate[aHead],aListOfFacts]
];
result = c temp;
result = Union[Flatten[result]];
Return[result]
];
Alternate[GreaterEqual] := LessEqual;
Alternate[LessEqual] := GreaterEqual;
Alternate[Less] := Greater;
Alternate[Greater] := Less;
Alternate[Equal] := Equal;
Alternate[_] := "nothing";
Alternate[x___] := BadCall["Alternate",x];
InequalitySearch[c_?NumberQ,GreaterEqual,aListOfFacts_List] := {c};
InequalitySearch[c_?NumberQ,LessEqual,aListOfFacts_List] := {c};
InequalitySearch[c_?NumberQ,Equal,aListOfFacts_List] := {c};
InequalitySearch[c_?NumberQ,Less,aListOfFacts_List] := {Less};
InequalitySearch[c_?NumberQ,Greater,aListOfFacts_List] := {Greater};
InequalitySearch[Infinity,_,_List] := {};
InequalitySearch[-Infinity,_,_List] := {};
InequalitySearch[x___] := BadCall["InequalitySearch",x];
InequalityToStandardForm[x_List] := Map[InequalityToStandardForm,x];
InequalityToStandardForm[True] := True;
InequalityToStandardForm[False] := False;
InequalityToStandardForm[x_] :=
Module[{result,head,expr,ru,top,rest,leadcoeff},
result = {};
head = Head[x];
expr = x[[1]] - x[[2]];
ru = Convert1[expr==0];
top = ru[[1]];
rest = expr/.{top->0};
leadcoeff = Expand[(expr - rest)/top];
(*
Now expr ==something top + rest
*)
If[Not[FreeQ[leadcoeff,top]], Abort[]];
If[Positive[leadcoeff], result = Apply[head,{ru[[1]],ru[[2]]}]];
If[Negative[leadcoeff], result = Apply[Alternate[head],
{ru[[1]],ru[[2]]}
]
];
If[result == {},result = Apply[head,{leadcoeff top, -rest}]];
Return[result]
];
InequalityToStandardForm[x___] := BadCall["InequalityToStandardForm",x];
NumericalLeafs[expr_,aHead_,aListOfFacts_List] :=
NumericalLeafs[expr,aHead,aListOfFacts,40];
NumericalLeafs[expr_,aHead_,
aListOfFacts_List,NumberOfIterations_Integer?Positive] :=
Module[{temp,j},
temp = Union[Flatten[{expr}]];
For[j=1,j<=NumberOfIterations && Not[ListOfNumbersQ[temp]],j++,
temp = Map[InequalitySearch[#,aHead,aListOfFacts]&,temp];
temp = Union[Flatten[temp]];
];
Return[temp]
];
ListOfNumbersQ[{___?NumberQ}] := True;
ListOfNumbersQ[_] := False;
ListOfNumbersQ[x___] := BadCall["ListOfNumbersQ in Inequalities`",x];
BoundedQ[expr_,aListOfFacts_List] :=
TrueQ[And[LowerBound[expr,aListOfFacts] =!= -Infinity,
UpperBound[expr,aListOfFacts] =!= Infinity
]
];
LowerBound[expr_,aListOfFacts_List] := LowerBound[expr,aListOfFacts] =
Module[{lowerlist,aListOfNumbers,result},
lowerlist = NumericalLeafs[expr,GreaterEqual,aListOfFacts];
If[Not[ListOfNumbersQ[lowerlist]],
lowerlist = Sort[lowerlist];
Print["LowerBound has encountered symbols :-( ", lowerlist]
];
aListOfNumbers = Select[lowerlist,NumberQ];
If[aListOfNumbers ==={}, result = -Infinity
, result = Apply[Max,aListOfNumbers]
];
Return[result]
];
UpperBound[expr_,aListOfFacts_List] := UpperBound[expr,aListOfFacts] =
Module[{upperlist,aListOfNumbers,result},
upperlist = NumericalLeafs[expr,LessEqual,aListOfFacts];
If[Not[ListOfNumbersQ[upperlist]],
upperlist = Sort[upperlist];
Print["UpperBound has encountered symbols :-( ", upperlist]
];
aListOfNumbers = Select[upperlist,NumberQ];
If[aListOfNumbers ==={}, result = Infinity
, result = Apply[Min,aListOfNumbers]
];
result = Apply[Min,aListOfNumbers];
Return[result]
];
End[];
EndPackage[]