(******************************************************************* This file was generated automatically by the Mathematica front end. It contains Initialization cells from a Notebook file, which typically will have the same name as this file except ending in ".nb" instead of ".m". This file is intended to be loaded into the Mathematica kernel using the package loading commands Get or Needs. Doing so is equivalent to using the Evaluate Initialization Cells menu command in the front end. DO NOT EDIT THIS FILE. This entire file is regenerated automatically each time the parent Notebook file is saved in the Mathematica front end. Any changes you make to this file will be overwritten. ***********************************************************************) (* :Title: HoldTemporary*) (* :Author:Ted Ersek*) (* :Copyright: Copyright 2003 by Ted Ersek.Permission is hereby granted to use this \ package or any portion thereof provided this MathSource item and it's author \ are referenced. An exception is made for Wolfram Research who can use any portion \ of the package without giving credit.*) (* :Summary: This package defines a HoldTemporary function which work like HoldForm \ but is automatically released by nearly any function.A function called \ PowerTogether is also defined as an example of how HoldTemporary can be \ useful. Powertogether simplifies certain expressions involving Power[_,_] \ which can't be simplified using FullSimplify.*) (* :History: Version 1.0 was posted on MathSource in Feb 2001. Version 1.2 was posted on MathSource in Nov 2003. *) (* :Context:"Enhancements`HoldTemporary`"*) (* :Keywords:HoldAll,Hold,HoldForm,Evaluation,Formatting*) (* :Mathematica Version:3.0*) (* :Package Version:1.3, Jan 2004 *) (* :Acknowledgment:*) (* :Warning:*) (* :Limitations:*) (* :Discussion:*) BeginPackage["Enhancements`HoldTemporary`"]; HoldTemporary::usage= "HoldTemporary[expr] displays expr, with expr maintained in an \ unevaluated form. When the held result is used as an argument of almost any \ function the hold is automatically released. More precisely any symb for \ which ReleaseHoldTemporaryQ[symb] is True will automatically release the hold."; PowerTogether::usage= "PowerTogether[expr] tries to simplify expressions that make use of Power \ at more than one place. The result returned by PowerTogether is wrapped in \ HoldTemporary. PowerTogether[expr, assum] accounts for assumptions when deciding \ if powers can be combined."; ReleaseHoldTemporaryQ::usage= "ReleaseHoldTemporaryQ[symb] is True if symb will automatically release a \ hold due to HoldTemporay."; $ModifyReleaseHold::usage= "$ModifyReleaseHold is True by default and allows ReleaseHold to release \ a hold due to HoldTemporary at any level."; ReleaseHold::usage= "ReleaseHold[expr] removes Hold, HoldForm, HoldPattern, HoldComplete and \ HoldTemporary in expr."; Begin["`Private`"]; Unprotect["PowerTogether","HoldTemporary","$ModifyReleaseHold","ReleaseHoldTemporaryQ"]; SetAttributes[{HoldTemporary},HoldAll]; MakeBoxes[HoldTemporary[expr_],form_]:=MakeBoxes[expr,form]; Scan[(ReleaseHoldTemporaryQ[#]=False)&,{Set,SetDelayed,UpSet,UpSetDelayed, Head,Apply,Replace,ReplaceAll,ReplaceRepeated,ReplaceList,MakeBoxes, Hold,HoldComplete,HoldForm,Return,Catch,Check,CheckAbort, TimeConstrained,MemoryConstrained,AbortProtect, FullForm,InputForm,TraditionalForm }]; (* I would like to ensure the following formatting features preserve \ TemporaryHold, but this gets a little tricky. AccountingForm,BaseForm,CForm,ColumnForm,FortranForm,MatrixForm,\ NumberForm,OutputForm,PaddedForm,PrecedenceForm,ScientificForm,StandardForm,\ StyleForm,TableForm,TeXForm,TreeForm *) ReleaseHoldTemporaryQ[_]=True; HoldTemporary/:(h_[a1___,HoldTemporary[a2___],a3___]/; ReleaseHoldTemporaryQ[h]):=h[a1,a2,a3] func[e:(_?NumbTest^_Plus)]:=Times@@(Thread[e,Plus]/.Power\[Rule]pwr); func[n_?NumbTest^s_]:=pwr[n,s]; func[e_]:=e; NumbTest[a_]:=Complement[{Head[a]},{Integer,Rational}]==={} PowerTogether[expr_]:= If[expr=!=Null, Module[{result}, (* The first step is valid for any values, but we apply it in only specific cases. *) result=expr//.(n1_?NumbTest^p1_*n2_?NumbTest^p2_+ n3_?NumbTest^p3_*n2_?NumbTest^p2_)\[RuleDelayed](n1^p1+ n3^p3)n2^p2; result=Map[func,result,-1]/.Power\[Rule]pwr; result= result//.(pwr[a_?NonNegative, b_*c_]/;(Im[b]==0)&&(b!=-1))\[RuleDelayed]pwr[a^b,c]; result=result//.{ pwr[(c_.)*pwr[x_,-1],n_]\[RuleDelayed]pwr[c*Power[x,-1],n], pwr[Power[x_?Positive,-1],n_]\[RuleDelayed]pwr[x,-n], pwr[x_Rational?Positive,n_]/;(Numerator[x]===1)\[RuleDelayed] pwr[Denominator[x],-n], (c_.)*pwr[x_,n_]pwr[y_,n_]/;(Power[x,n]Power[y,n]===Power[x*y,n])\[RuleDelayed] c*pwr[x*y,n], ((c_.)* pwr[x_,n_?Positive]pwr[y_,m_]/;((n\[Equal]-m)&& Power[x,n]Power[y,-n]\[Equal] Power[x/y,n]))\[RuleDelayed]c*pwr[x/y,n], ((c_.)* pwr[x_,n_]pwr[y_,-n_]/;(Power[x,n]Power[y,-n]\[Equal] Power[x/y,n]))\[RuleDelayed]c*pwr[x/y,n], pwr[a_,pwr[b_,c_]]/;(-1pwr[a, b*c] }; result//.pwr[x_,m_]*pwr[x_,n_]\[RuleDelayed]pwr[x,m+n]; Apply[HoldTemporary,{result}]/.pwr\[Rule]Power ]]; PowerTogether[expr_,assum_]:=If[expr=!=Null,Module[{result}, result= expr//.(n1_?NumbTest^p1_*n2_?NumbTest^p2_+ n3_?NumbTest^p3_*n2_?NumbTest^p2_)\[RuleDelayed](n1^p1+ n3^p3)n2^p2; result=Map[func,result,-1]/.Power\[Rule]pwr; result= result//.(pwr[a_?NonNegative, b_*c_]/;(Im[b]==0)&&(b=!=-1))\[RuleDelayed]pwr[a^b,c]; result=result//.{ pwr[(c_.)*pwr[x_,-1],n_]\[RuleDelayed]pwr[c*Power[x,-1],n], pwr[Power[x_,-1],n_]/;Simplify[x>0,assum]\[RuleDelayed] pwr[x,-n], pwr[Power[x_,-1],n_]/;Simplify[n\[Element]Integers]\[RuleDelayed] pwr[x,-n], pwr[x_Rational?Positive,n_]/;(Numerator[x]===1)\[RuleDelayed] pwr[Denominator[x],-n], ((c_.)*pwr[x_,n_]pwr[y_,n_]/; Simplify[x\[GreaterEqual]0&&y\[GreaterEqual]0, assum])\[RuleDelayed] c*pwr[x*y,n], ((c_.)*pwr[x_,n_]pwr[y_,-(n_)]/; Simplify[y\[LessEqual]0&&x\[LessEqual]0, assum])\[RuleDelayed] c*pwr[x/y,n], ((c_.)*pwr[x_,n_]pwr[y_,-(n_)]/; Simplify[y\[GreaterEqual]0&&x\[GreaterEqual]0, assum])\[RuleDelayed] c*pwr[x/y,n], ((c_.)*pwr[x_,n_]pwr[y_,m_]/; Simplify[(n\[Equal]-m)&& y\[LessEqual]0 &&x \[LessEqual]0, assum])\[RuleDelayed] c*pwr[x/y,n], ((c_.)*pwr[x_,n_]pwr[y_,m_]/; Simplify[(n\[Equal]-m)&&y\[GreaterEqual]0&& x\[GreaterEqual]0,assum])\[RuleDelayed] c*pwr[x/y,n], (c_.)*pwr[x_,1/2]*pwr[y_,1/2]/; Simplify[x\[LessEqual]0&&y\[LessEqual]0, assum]\[RuleDelayed]-c*pwr[x*y,1/2], (c_.)*pwr[x_,1/2]*pwr[y_,-1/2]/; Simplify[x\[GreaterEqual]0&&y<0,assum]\[RuleDelayed]-c*pwr[x/y,1/2], (c_.)*pwr[Power[x_,-1],1/2]/;Simplify[x<0, assum]:> -c*pwr[x,-1/2] }; result=result//.{ ((c_.)*pwr[x_,n_]pwr[y_,n_]/;Simplify[n\[Element]Integers,assum])\[RuleDelayed] c*pwr[x*y,n], ((c_.)*pwr[x_,n_]*pwr[y_,-(n_)]/;Simplify[(n\[Element]Integers),assum])\[RuleDelayed] c*pwr[x/y,n], ((c_.)*pwr[x_,n_]*pwr[y_,m_]/;Simplify[(n\[Equal]-m)&&(n\[Element]Integers),assum])\[RuleDelayed] c*pwr[x/y,n], ((c_.)*pwr[x_,n_]*pwr[y_,n_]/;Simplify[x\[GreaterEqual]0||y\[GreaterEqual]0,assum])\[RuleDelayed] c*pwr[x*y,n], ((c_.)*pwr[x_,n_]*pwr[y_,-(n_)]/;Simplify[((y\[Element]Reals&&x\[LessEqual]0)||y\[GreaterEqual]0),assum])\[RuleDelayed] c*pwr[x/y,n], ((c_.)*pwr[x_,n_]*pwr[y_,m_]/;Simplify[(n\[Equal]-m)&&(n\[GreaterEqual]0)&&((y\[Element]Reals&&x\[LessEqual]0)||y\[GreaterEqual]0),assum])\[RuleDelayed]c*pwr[x/y,n], ((c_.)*pwr[x_,n_]pwr[y_,-n_]/;(Power[x,n]Power[y,-n]\[Equal]Power[x/y,n]))\[RuleDelayed]c*pwr[x/y,n] }; result= result//.{ (pwr[pwr[a_,b_],c_]/;Not[NumericQ[a]]&& Not[NumericQ[b]]&& Simplify[NonNegative[a]&&Element[b,Reals],assum])\[RuleDelayed]pwr[a,b*c], pwr[pwr[a_,b_],c_]/;Simplify[Element[c,Integers],assum]\[RuleDelayed]pwr[a,b*c], pwr[pwr[a_,b_],c_]/;Simplify[-1 pwr[a, b*c] }; result=Apply[HoldTemporary,{result}]/.pwr\[Rule]Power] ]; WereProtected=Unprotect[ReleaseHold]; ReleaseHold[expr_]/;$ModifyReleaseHold:= Block[{$ModifyReleaseHold}, Module[{g},ReleaseHold@@(g[expr]/.HoldTemporary\[Rule]Identity)]] $ModifyReleaseHold=True; Protect[Evaluate@WereProtected]; Protect[PowerTogether,HoldTemporary,$ModifyReleaseHold]; End[]; EndPackage[];