Inequalities posting: Convert1.m
- To: mathgroup at yoda.physics.unc.edu
- Subject: Inequalities posting: Convert1.m
- From: mstankus at oba.ucsd.edu (Mark Stankus)
- Date: Fri, 20 Nov 92 11:25:30 PST
(* :Title: Convert1 // Mathematica 2.0 *)
(* :Author: Mark Stankus (mstankus).
Based on the work of David Hurst (dhurst)
in the file NCTools.m
*)
(* :Context: Convert1` *)
(* :Summary:
Convert1 is similar to Convert1, but only works
for commutative expressions. Convert1 does
not depend on any NCAlgebra code.
*)
(* :Alias:
*)
(* :Warnings:
*)
(* :History:
:8/26/92 Wrote code. (mstankus)
:10/18/92 Adapted Convert1 from Convert2. (mstankus)
*)
BeginPackage["Convert1`"];
Clear[Convert1];
Convert1::usage =
"Convert1[expr] is a variant of Convert1[expr] which is \
recursive and follows a slightly different ordering.";
Begin["`Private`"];
(*
Change input given in the wrong format to the
correct format with a head of Equal.
*)
Convert1[x_Plus] := Convert1[x==0];
Convert1[x_Rule] := Convert1[x[[1]]==x[[2]]];
Convert1[x_RuleDelayed] := Convert1[x[[1]]==x[[2]]];
Convert1[x_List] := Map[Convert1,x];
Convert1[True] :=
Module[{},
Print["Warning from Convert1: Converting True"];
Return[0->0]
];
Convert1[False] :=
Module[{},
Print[" :-( Severe Warning from Convert1: Converting False"];
Abort[];
Return[0->0]
];
(*
The important code.
*)
Convert1[x_Equal]:= Convert1[Equal[x[[1]]-x[[2]],0]] /; Not[x[[2]]===0]
Convert1[x_Equal]:=
Module[{expr,expr2,orderedlist,left,right,coeff,
var,temp},
expr = Expand[x[[1]]];
If[Head[expr]===Plus,expr2 = Apply[List,expr];
,expr2 = {expr};
];
orderedlist = Sort[expr2];
left = orderedlist[[-1]];
right = -expr + left;
If[Head[left]==Times, coeff= left[[1]];
left = left/coeff;
right = right/coeff;
];
var = Unique[];
temp = right/.left->right;
If[Not[FreeQ[temp,var]],
Print["Using the rule ",left->right];
Print["leads to an infinite loop."];
];
Return[left->right]
] /; x[[2]]===0
End[];
EndPackage[]