MathGroup Archive 2003

[Date Index] [Thread Index] [Author Index]

Search the Archive

A Hard Algebraic Transformation

  • To: mathgroup at smc.vnet.net
  • Subject: [mg45121] A Hard Algebraic Transformation
  • From: "Ersek, Ted CIV NASPATUXENTRIVERMD 4.5.1.2" <ted.ersek at navy.mil>
  • Date: Wed, 17 Dec 2003 07:54:37 -0500 (EST)
  • Sender: owner-wri-mathgroup at wolfram.com

A package I have posted at
 http://library.wolfram.com/infocenter/MathSource/705/
has a helpful function called PowerTogether. I recently found that 
PowerTogether in the above version can't handle certain tricky problems. 
I was able to fix the problem, but the solution is complicated. My best 
solution is given below, and I wanted to see if anyone can find problems 
with it, or offer a better solution. I should mention I intend to put an 
improved version of the package at the above site that will handle 
problems like the one below, and many problems the version below can't 
handle. Also the final version will use my HoldTemporary rather than 
HoldForm as below. The version below is a shortened version to only 
handle one type of transformation.



In[1]:=
ClearAll[TempTimes, TempTimes2, MapTempTimes, PowerTogether]


In[2]:=
Attributes[TempTimes2]={Flat,Orderless};

MapTempTimes[e:(_Integer^_Plus)]:=
    Map[MapTempTimes,TempTimes@@Thread[e,Plus]];

MapTempTimes[e_]:=e;

TempTimes[a1___,a_Integer^(n_Integer*s_Symbol),a3___]/;(n=!=-1):=
  TempTimes[a1,(a^n)^s,a3]


In[6]:=
PowerTogether[expr_]:=Module[{q1},
    q1=Map[MapTempTimes, expr, -1];
    q1=q1/.TempTimes[x_?NumericQ, y__] :> x*TempTimes[y];
    q1=q1//.TempTimes[a__]TempTimes[b__] :> TempTimes[a,b];
    q1=q1/.tt_TempTimes :>          
       =
Replace[Split[tt,(Last[#1]===Last[#2])&],TempTimes->Times,{2},Heads
->True];
    q1=q1/.TempTimes->TempTimes2;
    q1=q1//.
    {
       TempTimes2[n_Integer^s_Symbol, m_Integer^s_Symbol] :> (n*m)^s,
       TempTimes2[n_Integer^s_Symbol, m_Integer^-s_Symbol] :> (n/m)^s
    };
    q1=Apply[HoldForm, {q1}]/.TempTimes2 -> Times;
    q1/.HoldPattern[ Times[a__, Times[b__] ]] :> Times[a,b]
    ]


(*------ EXAMPLE -------*)
In[7]:=
expr= 2+2^z+(300+64)*(3/8)^y*(4950/169)^z/605

Out[7]=
2 + 2^z + 7*2^(2-3*y+z)*3^(y+2*z)*5^(-1+2*z)*11^(-2+z)*
  13^(1-2*z)

(*----- Ugly Output, Right?  PowerTogether makes it much better. -----*)

In[8]:=
PowerTogether[expr]

Out[8]=
HoldForm[2 + 2^z + (364*(3/8)^y*(4950/169)^z)/605]


-------
Any suggestions?
     Ted Ersek

Download Mathematica Tips From
http://www.verbeia.com/mathematica/tips/Tricks.html



  • Prev by Date: RE: animation
  • Next by Date: RE: 2 Simple Mathematica Questions. (regarding tensors and matrices)
  • Previous by thread: Re: Bernstein polynomails
  • Next by thread: Better Set or Set Delayed ?