NetNews Usenet Archive 1992 #27/NN_1992_27.iso/spool/sci/math/symbolic/3067

Internet Message Format | 1992-11-20 | 9.2 KB

Path: sparky!uunet!zaphod.mps.ohio-state.edu!usc!news.service.uci.edu!network.ucsd.edu!sdcc12!oba!mstankus
From: [e-mail] (Mark Stankus)
Newsgroups: sci.math.symbolic
Subject: Inequalites posting: Inequalities.m
Message-ID: <[e-mail]>
Date: 20 Nov 92 19:29:54 GMT
References: <[e-mail]>
Sender: [e-mail]
Organization: Mathematics @ UCSD
Lines: 273
Nntp-Posting-Host: oba.ucsd.edu

(* :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[]
--
mstankus
mstankus@oba