home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #27 / NN_1992_27.iso / spool / sci / math / symbolic / 3069 < prev    next >
Encoding:
Internet Message Format  |  1992-11-20  |  2.5 KB
  1. Path: sparky!uunet!zaphod.mps.ohio-state.edu!usc!news.service.uci.edu!network.ucsd.edu!sdcc12!oba!mstankus
  2. From: mstankus@oba.ucsd.edu (Mark Stankus)
  3. Newsgroups: sci.math.symbolic
  4. Subject: Inequalities posting: Convert1.m
  5. Message-ID: <41348@sdcc12.ucsd.edu>
  6. Date: 20 Nov 92 19:34:37 GMT
  7. References: <41345@sdcc12.ucsd.edu>
  8. Sender: news@sdcc12.ucsd.edu
  9. Organization: Mathematics @ UCSD
  10. Lines: 93
  11. Nntp-Posting-Host: oba.ucsd.edu
  12.  
  13. (* :Title:     Convert1 // Mathematica 2.0 *)
  14.  
  15. (* :Author:     Mark Stankus (mstankus).
  16.                 Based on the work of David Hurst (dhurst)
  17.                 in the file NCTools.m 
  18. *)
  19.  
  20. (* :Context:     Convert1` *)
  21.  
  22. (* :Summary:
  23.         Convert1 is similar to Convert1, but only works
  24.                 for commutative expressions. Convert1 does
  25.                 not depend on any NCAlgebra code.
  26. *)
  27.  
  28. (* :Alias:
  29. *)
  30.  
  31. (* :Warnings: 
  32. *)
  33.  
  34. (* :History: 
  35.    :8/26/92     Wrote code. (mstankus)
  36.    :10/18/92    Adapted Convert1 from Convert2. (mstankus)
  37. *)
  38. BeginPackage["Convert1`"];
  39.  
  40. Clear[Convert1];
  41.  
  42. Convert1::usage = 
  43.      "Convert1[expr] is a variant of Convert1[expr] which is \
  44.       recursive and follows a slightly different ordering.";
  45.  
  46. Begin["`Private`"];
  47.  
  48. (*
  49.       Change input given in the wrong format to the
  50.       correct format with a head of Equal.
  51. *)
  52. Convert1[x_Plus] := Convert1[x==0];
  53.  
  54. Convert1[x_Rule] := Convert1[x[[1]]==x[[2]]];
  55.  
  56. Convert1[x_RuleDelayed] := Convert1[x[[1]]==x[[2]]];
  57.  
  58. Convert1[x_List] := Map[Convert1,x];
  59.  
  60. Convert1[True] := 
  61. Module[{},
  62.     Print["Warning from Convert1: Converting True"];
  63.     Return[0->0]
  64. ];
  65.  
  66. Convert1[False] := 
  67. Module[{},
  68.     Print[" :-( Severe Warning from Convert1: Converting False"];
  69.     Abort[];
  70.     Return[0->0]
  71. ];
  72.  
  73. (* 
  74.       The important code.
  75. *)
  76. Convert1[x_Equal]:= Convert1[Equal[x[[1]]-x[[2]],0]] /; Not[x[[2]]===0]
  77.  
  78. Convert1[x_Equal]:=
  79. Module[{expr,expr2,orderedlist,left,right,coeff,
  80.         var,temp},
  81.      expr = Expand[x[[1]]];
  82.      If[Head[expr]===Plus,expr2 = Apply[List,expr];
  83.                          ,expr2 = {expr};
  84.      ];
  85.      orderedlist = Sort[expr2];
  86.      left = orderedlist[[-1]];
  87.      right = -expr + left;
  88.      If[Head[left]==Times, coeff= left[[1]];
  89.                            left = left/coeff;
  90.                            right = right/coeff;
  91.      ];
  92.      var = Unique[];
  93.      temp = right/.left->right;
  94.      If[Not[FreeQ[temp,var]], 
  95.            Print["Using the rule ",left->right];
  96.            Print["leads to an infinite loop."];
  97.      ];
  98.      Return[left->right]
  99. ] /; x[[2]]===0
  100.  
  101. End[];
  102. EndPackage[]
  103. -- 
  104. mstankus
  105. mstankus@oba 
  106.