(*:Mathematica Version: 2.2 *) (*:Package Version: 1.4 *) (*:Copyright: Copyright 1990-1992, Wolfram Research, Inc.*) (*:Context: Calculus`LaplaceTransform` *) (*:Title: LaplaceTransform *) (*:Author: Eran Yehudai & E.C. Martin *) (*:Summary: Implements Laplace and inverse Laplace transforms. *) (*:Keywords: Laplace, transform, differential equations *) (*:Requirements: None. *) (*:Source: Fritz Oberhettinger and Larry Badii, Tables of Laplace Transforms, New York: Springer-Verlag, 1973. *) (*:History: Version 1.1 by Eran Yehudai, October 1990. Extensively modified by ECM (Wolfram Research), January-November 1991. Modified to use UnitStep and DiracDelta, ECM (Wolfram Research), January 1992. Modified for multivariate functions, Jeff Adams (Wolfram Research), May 1992. Added CombinePlusRule, Jeff Adams (Wolfram Research), December 1992. *) (*:Limitations: As in the case of integration, there are additional special cases that appear in the reference book, yet are not covered here. LaplaceTransform can be evaluated numerically by performing the integral in the definition using NIntegrate. Although that is possible in principle for InverseLaplaceTransform, the convergence of the typical integrals one encounters is much poorer (goes like Sin[t]/t). If, at some point, NIntegrate will be more successful in evaluating these, a numeric rule for InverseLaplaceTransform could be added. *) (* :Discussion: The option ZeroLimit determines how to treat the limit t->0, Direction->1 in the case of symbolic functions. The option DefiniteIntegral determines whether to use the definition of the Laplace transform and perform a definite integral on the expression if no other rules match. When True, many expressions that do not need the definite integral are slowed down quite a bit. *) BeginPackage["Calculus`LaplaceTransform`", "Calculus`DiracDelta`", "Calculus`Common`Support`"] ClearAll[LaplaceTransform,InverseLaplaceTransform]; LaplaceTransform::usage = "LaplaceTransform[expr, t, s, opts] gives a function of s, which is the Laplace transform of expr, a function of t. It is defined by LaplaceTransform[expr, t, s] = Integrate[Exp[-s t] expr, {t, 0, Infinity}]." Options[LaplaceTransform] = {ZeroLimit->Automatic, DefiniteIntegral->False} InverseLaplaceTransform::usage = "InverseLaplaceTransform[expr, s, t, opts] gives a function of t, the Laplace transform of which is expr, a function of s." Options[InverseLaplaceTransform] = Options[LaplaceTransform] ZeroLimit::usage = "ZeroLimit is an option of LaplaceTransform which is used to determine how the limit t -> 0, Direction -> 1 is treated in the transform definition. ZeroLimit -> All uses the Limit function only. ZeroLimit -> Automatic (default) is the same as ZeroLimit -> All unless the Limit fails to evaluate. In this case, the result is the expression evaluated at 0." DefiniteIntegral::usage = "DefiniteIntegral is an option of LaplaceTransform which is used to determine whether the integral definition of the LaplaceTransform will be used if no rules match the expression to be transformed. The default of DefiniteIntegral is False." (************************************************************************) Begin["`Private`"] (************************************************************************) CombinePlusRule[s_Symbol] := Plus[y___, w_. r_, x_. r_] :> Plus[y, (w+x) r] /; FreeQ[{w,x},s] && !FreeQ[r,s] DI[f_, _, _, _, 0] := f DI[f_, s_, ss_Symbol, Infinity, n_Integer?Positive] := Module[{v = If[SameQ[Head[s],Symbol], Unique[ToString[s]], Unique[]]}, Integrate[Collect[ DI[f /. ss->v, s, v, Infinity, n-1], DiracDelta], {v, ss, Infinity}] ] DI[f_, t_, 0, tt_Symbol, n_Integer?Positive] := Module[{v = If[SameQ[Head[t],Symbol], Unique[ToString[t]], Unique[]]}, Integrate[Collect[ DI[f /. tt->v, t, 0, v, n-1], DiracDelta], {v, 0, tt}] ] (*****************************************************************************) (* Laplace Transform *) (*****************************************************************************) (* ============================ Numeric Value ============================== *) N[LaplaceTransform[f_, t_Symbol, s_?NumberQ, ___]] := NIntegrate[Exp[-s t]f, {t,0,Infinity}] N[LaplaceTransform[f_, t_Symbol, s_?NumberQ, ___], d_] := NIntegrate[Exp[-s t]f, {t, 0, Infinity}, WorkingPrecision->d] (* ============================== UnitStep ================================= *) LaplaceTransform[f_. UnitStep[t_, r___Rule], t_Symbol, s_, opt___] := LaplaceTransform[f, t, s, opt] LaplaceTransform[f_. UnitStep[t_, others__, r___Rule], t_Symbol, s_, opt___] := LaplaceTransform[f UnitStep[others,r], t, s, opt] LaplaceTransform[UnitStep[a_. t_ + b_., r___Rule], t_Symbol, s_, opt___] := Exp[s b/a]/s /; positive[a] && FreeQ[{b,s},t] LaplaceTransform[UnitStep[a_. t_ + b_., others__, r___Rule], t_Symbol, s_, opt___] := Exp[s b/a]/s UnitStep[others,r] /; positive[a] && FreeQ[{b,s},t] LaplaceTransform[f_. UnitStep[a_?negative t_ + b_?negative, others___, r___Rule], t_Symbol, s_, opt___] := 0 LaplaceTransform[f_. UnitStep[a_?negative t_ + b_., r___Rule], t_Symbol, s_, opt___] := Module[{result = LaplaceTransform[f, t, s, opt] - LaplaceTransform[f UnitStep[t + b/a, r], t, s, opt]}, result /; FreeQ[result, LaplaceTransform] ] /; positive[b] && FreeQ[{b,s},t] LaplaceTransform[f_. UnitStep[a_?negative t_ + b_., others__,r___Rule], t_Symbol, s_, opt___] := Module[{result = LaplaceTransform[f UnitStep[others,r] , t, s, opt] - LaplaceTransform[f UnitStep[t + b/a, others,r], t, s, opt]}, result /; FreeQ[result, LaplaceTransform] ] /; positive[b] && FreeQ[{b,s},t] (* ============================== DiracDelta ================================= *) LaplaceTransform[f_. DiracDelta[a_. t_], t_Symbol, s_, opt___] := (1/Abs[a] f /. t->0) /; FreeQ[{a,s},t] LaplaceTransform[f_. DiracDelta[a_. t_,others__], t_Symbol, s_, opt___] := (1/Abs[a] DiracDelta[others] f /. t->0) /; FreeQ[{a,s},t] LaplaceTransform[f_. DiracDelta[c_ + b_.], t_Symbol, s_, opt___] := Module[{d}, (1/Abs[d] Exp[ s b/d] f (1-UnitStep[b/d]) /. t->-b/d ) /; FreeQ[d = Factor[c]/t, t] ] /; !FreeQ[c,t] && FreeQ[{b,s},t] LaplaceTransform[f_. DiracDelta[c_ + b_.,others__], t_Symbol, s_, opt___] := Module[{d}, (1/Abs[d] Exp[ s b/d] DiracDelta[others] f (1-UnitStep[b/d]) /. t->-b/d ) /; FreeQ[d = Factor[c]/t, t] ] /; !FreeQ[c,t] && FreeQ[{b,s},t] (* ============================= Using Apart =============================== *) LaplaceTransform[f:Power[x_, n_?Negative], t_Symbol, s_, opt___] := Module[{ff = Chop[Apart[Factor[f], t]]}, LaplaceTransform[ff, t, s, opt] /; ((SameQ[Head[ff],Plus] || (SameQ[Head[ff],Power] && ff[[2]] != n)) && FreeQ[LaplaceTransform[ff, t, s, opt], LaplaceTransform]) ] /; !FreeQ[x, t] && FreeQ[s,t] LaplaceTransform[f:Times[c__, Power[x_, n_?Negative]], t_Symbol, s_, opt___] := Module[{ff = Chop[Apart[Factor[f], t]]}, LaplaceTransform[ff, t, s, opt] /; ((SameQ[Head[ff],Plus] || (SameQ[Head[Denominator[ff]],Power] && Denominator[ff][[2]] != -n)) && FreeQ[LaplaceTransform[ff, t, s, opt], LaplaceTransform]) ] /; !FreeQ[{c}, t] && !FreeQ[x, t] && FreeQ[s,t] (* ============================== Linearity ================================ *) LaplaceTransform[c_, t_Symbol, s_, opt___] := c/s /; FreeQ[{c, s}, t] LaplaceTransform[c_ f_, t_Symbol, s_, opt___] := c LaplaceTransform[f, t, s, opt] /; FreeQ[{c, s}, t] LaplaceTransform[x_Plus, t_Symbol, s_, opt___] := (LaplaceTransform[#, t, s, opt]& /@ x) /; FreeQ[s,t] LaplaceTransform[x_Plus f_, t_Symbol, s_, opt___] := LaplaceTransform[Expand[x f], t, s, opt] /; FreeQ[s,t] LaplaceTransform[Sum[f_, {i_, i1_, i2_}], t_Symbol, s_, opt___] := Sum[LaplaceTransform[f,t,s,opt],{i,i1,i2}] /; FreeQ[{i,i1,i2,s},t] && FreeQ[i,s] LaplaceTransform[f_Equal, t_Symbol, s_, opt___] := LaplaceTransform[#, t, s, opt]& /@ f /; FreeQ[s,t] LaplaceTransform[f:Power[x_Plus, _Integer?Positive], t_Symbol, s_, opt___] := Module[{ff = Expand[f]}, LaplaceTransform[ff, t, s, opt] ] /; !FreeQ[x, t] && FreeQ[s,t] (* ================ LaplaceTransform, Listable on First arg only =========== *) LaplaceTransform[expr_List, args___] := Map[ LaplaceTransform[#,args]&,expr] (* ================ LaplaceTransform, Multidimensional Easy Form =========== *) LaplaceTransform[expr_, {t_Symbol}, {s_}, opts___] := LaplaceTransform[expr, t, s, opts] /; FreeQ[s,t] LaplaceTransform[expr_, ts:{__Symbol}, ss_List, opts___] := Module[{lt, index}, LaplaceTransform[lt, Delete[ts, index], Delete[ss, index], opts] /; (Length[Union[ts]] == Length[ts] == Length[ss] && And @@ Map[FreeQ[ss,#]&,ts] && Scan[(If[Head[lt = LaplaceTransform[expr, ts[[#]], ss[[#]], opts]] =!= LaplaceTransform, index = #; Return[True]])&, Range[Length[ts]]]) ] (* ========================= Other Rational Functions ====================== *) LaplaceTransform[(c_ + b_.)^n_, t_Symbol, s_, ___] := Module[{a}, ( (Exp[b s/a]/a ( Gamma[n+1] (s/a)^(-n-1) - b^(1+n) Hypergeometric1F1[1+n,2+n,-b s/a]/(1+n) ) // PowerExpand // Factor) ) /; FreeQ[a = Factor[c]/t, t] && positive[a] ] /; FreeQ[{b,n,s},t] && !FreeQ[c,t] && -1 -1,True] && FreeQ[s,t] LaplaceTransform[a_ t_^n_., t_Symbol, s_, opt___] := Module[{ss}, ((-1)^n D[LaplaceTransform[a, t, ss, opt], {ss, n}] /. ss->s) ] /; IntegerQ[n] && n > 0 && FreeQ[s,t] LaplaceTransform[a_ t_^(n_Integer?Negative), t_Symbol, s_, opt___] := Module[{ss}, DI[LaplaceTransform[a,t,ss,opt], s, ss, Infinity, -n] /. ss->s ] /; FreeQ[s,t] (* ======================= Trigonometric Functions ======================= *) LaplaceTransform[Sin[c_ + b_.], t_Symbol, s_, ___] := Module[{a}, (Cos[b] a + Sin[b] s)/(a^2+s^2) /; FreeQ[a = Factor[c]/t, t] ] /; FreeQ[{b,s},t] && !FreeQ[c,t] LaplaceTransform[Cos[c_ + b_.], t_Symbol, s_, ___] := Module[{a}, (Cos[b] s - Sin[b] a)/(a^2+s^2) /; FreeQ[a = Factor[c]/t, t] ] /; FreeQ[{b,s},t] && !FreeQ[c,t] (* ==================== Inverse Trigonometric Functions ==================== *) LaplaceTransform[ArcTan[c_], t_Symbol, s_, ___] := Module[{a}, (CosIntegral[s/a]Sin[s/a]- (SinIntegral[s/a]-Pi/2)Cos[s/a])/s /; FreeQ[a = Factor[c]/t, t] ] /; FreeQ[s,t] && !FreeQ[c,t] LaplaceTransform[ArcCot[c_], t_Symbol, s_, ___] := Module[{a}, ((Pi/2-CosIntegral[s/a])Sin[s/a] - (SinIntegral[s/a]-Pi/2)Cos[s/a])/s /; FreeQ[a = Factor[c]/t, t] ] /; FreeQ[s,t] && !FreeQ[c,t] (* ======================== Hyperbolic Functions =========================== *) LaplaceTransform[Sinh[c_ + b_.], t_Symbol, s_, ___] := Module[{a}, (Cosh[b] a + Sinh[b] s)/(s^2 - a^2) /; FreeQ[a = Factor[c]/t, t] ] /; FreeQ[{b,s},t] && !FreeQ[c,t] LaplaceTransform[Cosh[c_ + b_.], t_Symbol, s_, ___] := Module[{a}, (Cosh[b] s + Sin[b] a)/(s^2 - a^2) /; FreeQ[a = Factor[c]/t, t] ] /; FreeQ[{b,s},t] && !FreeQ[c,t] LaplaceTransform[Tanh[c_], t_Symbol, s_, ___] := Module[{a}, (PolyGamma[1/2+s/(4a)]-PolyGamma[s/(4a)])/(2a) - 1/s /; FreeQ[a = Factor[c]/t, t] ] /; FreeQ[s,t] && !FreeQ[c,t] (* ====================== Derivatives and Integrals ======================== *) LaplaceTransform[Derivative[n__Integer?(#>=0&)][f_][tt__], t_Symbol, s_, opt___] := Module[{zerolimit = ZeroLimit /. {opt} /. Options[LaplaceTransform], init, nt= Position[{tt},t], nn, ns}, nn = Part[{n},nt[[1,1]]]; ( ns = Sequence @@ MapAt[#-1-i&,{n},nt]; init = Limit[ Sum[s^i Derivative[ns][f][tt], {i,0, nn-1}], t->0, Direction->1]; If[zerolimit===Automatic && !FreeQ[init,Limit], init = Sum[s^i (Derivative[ns][f][tt] /. t->0), {i,0,nn-1}] ]; s^nn LaplaceTransform[Derivative[ns][f][tt],t,s,opt] - init /. i->nn-1 ) /; ((zerolimit===Automatic || zerolimit===All) && (nn > 0)) ] /; (Apply[And,FreeQ[s,#]& /@ {tt}] && Count[{tt},t]==1) LaplaceTransform[ Derivative[0, 0, n_Integer?Positive, ___] [InverseLaplaceTransform][f_,s1_Symbol,t_Symbol,opt1___], t_Symbol,s2_,opt2___] := Module[{zerolimit = ZeroLimit /. {opt2} /. Options[LaplaceTransform], init}, (init = Limit[ Sum[ (s1^i /. s1->s2) * D[InverseLaplaceTransform[f,s1,t,opt1], {t, n-1-i}], {i, 0, n-1}], t->0, Direction->1]; If[zerolimit===Automatic && !FreeQ[init,Limit], init = Sum[ (s1^i /. s1->s2) * (D[InverseLaplaceTransform[f,s1,t,opt1], {t, n-1-i}] /. t->0), {i, 0, n-1}] ]; ((s1^n f) /. s1->s2) - init ) /; (zerolimit===Automatic || zerolimit===All) ] /; FreeQ[{f,s1,s2},t] LaplaceTransform[Literal[Integrate][f_, {tt_Symbol, a_, t_}], t_Symbol, s_, opt___] := ( LaplaceTransform[f /. tt->t, t, s, opt] - Integrate[f,{tt,0,a}] )/ s /; FreeQ[s,t] && FreeQ[f,t] (* Convolution solution *) LaplaceTransform[Literal[Integrate][f_ g_, {u_Symbol, 0, t_}], t_Symbol, s_, opt___] := LaplaceTransform[f /. u->t,t,s] LaplaceTransform[Simplify[g /. t->t+u],t,s] /; FreeQ[s,t] && FreeQ[f,t] && !FreeQ[g,t] && FreeQ[Simplify[g /. t->t+u],u] (* =============== LaplaceTransform of InverseLaplaceTransform ============= *) LaplaceTransform[InverseLaplaceTransform[f_, s_Symbol, t_, ___], t_Symbol, s1_, ___] := (f /. s->s1) /; FreeQ[s1,t] LaplaceTransform[InverseLaplaceTransform[f_, s:{__Symbol}, t_, ___], t:{__Symbol}, s1_List, ___] := (f /. Thread[Rule[s,s1]]) /; (Length[s] == Length[t] == Length[s1] && And @@ Map[FreeQ[s1,#]&, t]) (* ======================== Composed Function Case ========================= *) LaplaceTransform[f_, t_Symbol, s_, opt___] := Module[{g = ComposedFunctionQ[f, t]}, With[{a = g[[1]]/t}, LaplaceTransform[f /. g[[1]]->t, t, s/a, opt] / a ] /; (SameQ @@ g && MatchQ[g[[1]], _Times]) ] /; FreeQ[s,t] && FreeQ[f, LaplaceTransform] && !Apply[Or, Map[(MatchQ[#[[1]], c1_. + c2_. t /; negative[c2]])&, Cases[f, UnitStep[_, ___Rule], Infinity] ]] LaplaceTransform[f_ UnitStep[t_ + b_, r___Rule], t_Symbol, s_, opt___] := Module[{g1 = ComposedFunctionQ[f, t], g, f1, tau}, With[{a = g[[1]] - t}, LaplaceTransform[(f1 /. tau -> t), t, s, opt] Exp[b s] ] /; g1 =!= False && (g1 = Union[g1, {t+b}]; g = Select[g1, Head[#] === Plus&]; g =!= {} && SameQ @@ g) && FreeQ[f1 = (f /. {t+b :> tau, -(t+b) :> -tau}), t] ] /; FreeQ[{b, s}, t] && FreeQ[f, UnitStep] LaplaceTransform[f_, t_Symbol, s_, opt___] := Module[{g1 = ComposedFunctionQ[f, t], g, f1, tau, integrand, term, z, cases, k}, With[{a = g[[1]] - t}, f1 = f1 //. tau -> t; integrand = (f1 Exp[-s t]) (* //. {Exp[x_] :> Exp[Collect[x, t]] /; PolynomialQ[x, t]} *); term = LaplaceTransform[f1, t, s, opt] - (Integrate[integrand, {t, 0, a}] //. {Power[y_, n_?EvenQ] :> z /; !FreeQ[y^n, Complex] && FreeQ[z = Factor[y^n], Complex]}); term = term //. {(d_ + c1_?ComplexQ)^n_. (d_ + c2_?ComplexQ)^n_. :> ((d + Re[c1])^2 + Im[c1]^2)^n /; c1 == Conjugate[c2] && FreeQ[d, Complex], (d_ + c1_?ComplexQ)^n_. (-d_ + c2_?ComplexQ)^n_. :> -((d + Re[c1])^2 + Im[c1]^2)^n /; c1 == Conjugate[-c2] && FreeQ[d, Complex]}; term = term //. {e1_. (c_. + d1_)^n_Integer?Negative + e2_. (c_. + d2_)^n_Integer?Negative :> 0 /; Together[e1(c+d1)^n + e2(c+d2)^n] == 0}; If[Length[cases = Cases[term, Exp[_], Infinity]] > 1 && SameQ @@ cases, term = Collect[term, cases[[1]]]]; If[FreeQ[term, Integrate], If[Length[cases = Cases[term, Power[_, _?Negative], Infinity]] > 1 && SameQ @@ cases, term = Factor[term //. {cases[[1]] :> k}] //. {k :> cases[[1]]}];]; ( Exp[a s] term ) //. {Exp[x_] :> Exp[Simplify[x]]} ] /; g1 =!= False && (g = Select[g1, Head[#] === Plus&]; g =!= {} && SameQ @@ g) && FreeQ[f1 = (f /. {g[[1]] -> tau}), t] ] /; FreeQ[s,t] && FreeQ[f, UnitStep] && FreeQ[f, DiracDelta] (* ========== Combine like expressions in Plus patterns ================== *) LaplaceTransform[f_, t_Symbol, s_, opt___] := Module[{newf = f //. CombinePlusRule[t]}, LaplaceTransform[newf, t, s, opt] /; !SameQ[newf,f] ] /; FreeQ[s,t] (* ======================== Using the Definition ========================== *) LaplaceTransform[f_, t_Symbol, s_, opt___] := Module[{transform = (If[!SameQ[Head[s], DirectedInfinity], If[!FreeQ[f, DiracDelta], Module[{indefint = Integrate[Exp[-s t] f, t], defint}, If[!FreeQ[indefint, Integrate], $Failed, If[!FreeQ[(defint = Limit[indefint, t->Infinity] - Limit[indefint, t->0, Direction->1]), Limit], $Failed, defint] ] ], Integrate[Exp[-s t] f, {t,0,Infinity}] ], Indeterminate])}, transform /; Apply[And, Map[FreeQ[transform,#]&, {$Failed,Integrate,Infinity,Indeterminate}]] ] /; FreeQ[s,t] && FreeQ[Map[Context, Select[Variables[s], MatchQ[Head[#], Symbol]&]], "Integrate`"] && (DefiniteIntegral /. {opt} /. Options[LaplaceTransform]) (* ================== Derivative of LaplaceTransform ======================= *) Unprotect[D, Derivative] (*** Derivative of LaplaceTransform, Linearity ***) Literal[D[x_Plus,y_Symbol]] := Map[D[#,y]&,x] /; !FreeQ[x,LaplaceTransform] Literal[D[x_Plus,{y_Symbol,n_Integer?Positive}]] := Map[D[#,{y,n}]&,x] /; !FreeQ[x,LaplaceTransform] Literal[D[x_Times,y_Symbol]] := Module[{e = Expand[x]}, D[e,y] /; !SameQ[x,e] ] /; !FreeQ[x,LaplaceTransform] Literal[D[x_Times,{y_Symbol,n_Integer?Positive}]] := Module[{e = Expand[x]}, D[e,{y,n}] /; !SameQ[x,e] ] /; !FreeQ[x,LaplaceTransform] Derivative[0,0,m_Integer?Positive][LaplaceTransform][f_, t_Symbol, s_] := Module[{laplace, s1}, (D[laplace, {s1, m}] /. s1->s) /; FreeQ[laplace = LaplaceTransform[f, t, s1], LaplaceTransform] ] /; FreeQ[s, t] Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, t_Symbol,s_,opt__] := Module[{laplace, s1}, (D[laplace, {s1, m}] /. s1->s) /; FreeQ[laplace = LaplaceTransform[f, t, s1], LaplaceTransform] ] /; ((Length[{z}] == Length[{opt}]) && FreeQ[s,t]) (*** Derivative of LaplaceTransform wrt s ***) Literal[D[LaplaceTransform[f_,t_Symbol,s_,opt__],s_Symbol]] := Apply[Derivative,Join[{0,0,1}, Table[0,{Length[{opt}]}]]][LaplaceTransform][f,t,s,opt] /; FreeQ[s,t] Literal[D[LaplaceTransform[f_,t_Symbol,s_,opt__], {s_Symbol,n_Integer?Positive}]] := Apply[Derivative,Join[{0,0,n}, Table[0,{Length[{opt}]}]]][LaplaceTransform][f,t,s,opt] /; FreeQ[s,t] (*** Derivative of LaplaceTransform wrt t ***) Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___],t_]] := D[u,t] LaplaceTransform[f,t,s,opt] /; FreeQ[u,LaplaceTransform] && FreeQ[s,t] Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___], {t_,n_Integer?Positive}]] := D[u,{t,n}] LaplaceTransform[f,t,s,opt] /; FreeQ[u,LaplaceTransform] && FreeQ[s,t] (*** Derivative of LaplaceTransform wrt x (!=t, !=s) ***) Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___],x_Symbol]] := u LaplaceTransform[D[f,x] - f D[s,x] t,t,s,opt] + D[u,x] LaplaceTransform[f,t,s,opt] /; FreeQ[u,LaplaceTransform] && !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t] Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___], {x_Symbol,n_Integer?Positive}]] := Nest[D[#,x]&, u LaplaceTransform[f,t,s,opt], n] /; !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t] (*** Derivative of Derivative of Laplace wrt s (with options) ***) Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, t_Symbol,s_Symbol,opt__], s_]] := u Derivative[0,0,m+1,z][LaplaceTransform][f,t,s,opt] + D[u,s] Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt] /; (Length[{z}] == Length[{opt}]) && FreeQ[u,LaplaceTransform] && FreeQ[s,t] Literal[D[Derivative[0,0,m1_Integer?Positive,z1:(0)..][LaplaceTransform][f1_, t1_Symbol,s_Symbol,opt1__] * Derivative[0,0,m2_Integer?Positive,z2:(0)..][LaplaceTransform][f2_, t2_Symbol,s_Symbol,opt2__], s_]] := Derivative[0,0,m1,z1][LaplaceTransform][f1,t1,s,opt] * Derivative[0,0,m2+1,z2][LaplaceTransform][f2,t2,s,opt] + Derivative[0,0,m1+1,z1][LaplaceTransform][f1,t1,s,opt] * Derivative[0,0,m2,z2][LaplaceTransform][f2,t2,s,opt] /; (Length[{z1}] == Length[{opt1}]) && (Length[{z2}] == Length[{opt2}]) && FreeQ[s,t1] && FreeQ[s,t2] Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, t_Symbol,s_Symbol,opt__], {s_,n_Integer?Positive}]] := Nest[D[#,s]&, u Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt], n] /; (Length[{z}] == Length[{opt}]) && FreeQ[s,t] (*** Derivative of Derivative of Laplace wrt t ***) Literal[D[u_. Derivative[0,0,m_Integer?Positive][LaplaceTransform][f_, t_Symbol,s_], t_]] := D[u,t] Derivative[0,0,m][LaplaceTransform][f,t,s] /; FreeQ[u,LaplaceTransform] && FreeQ[s,t] Literal[D[u_. Derivative[0,0,m_Integer?Positive][LaplaceTransform][f_, t_Symbol,s_], {t_,n_Integer?Positive}]] := Nest[D[#,t]&, u Derivative[0,0,m][LaplaceTransform][f,t,s], n] /; FreeQ[s,t] Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, t_Symbol,s_,opt__], t_]] := D[u,t] Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt] /; (Length[{z}] == Length[{opt}]) && FreeQ[u,LaplaceTransform] && FreeQ[s,t] Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, t_Symbol,s_,opt__], {t_,n_Integer?Positive}]] := Nest[D[#,t]&, u Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt], n] /; (Length[{z}] == Length[{opt}]) && FreeQ[s,t] (*** Derivative of Derivative of Laplace wrt x (!=t, !=s) ***) Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, t_Symbol,s_,opt__], x_Symbol]] := D[u,x] Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt] + u (Derivative[0,0,m,z][LaplaceTransform][D[f,x],t,s,opt] + D[s,x] Derivative[0,0,m+1,z][LaplaceTransform][f,t,s,opt]) /; (Length[{z}] == Length[{opt}]) && FreeQ[u,LaplaceTransform] && !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t] Literal[D[Derivative[0,0,m1_Integer?Positive,z1:(0)..][LaplaceTransform][f1_, t1_Symbol,s1_,opt1__] * Derivative[0,0,m2_Integer?Positive,z2:(0)..][LaplaceTransform][f2_, t2_Symbol,s2_,opt2__], x_Symbol]] := (Derivative[0,0,m1,z1][LaplaceTransform][D[f1,x],t1,s1,opt] + D[s1,x] * Derivative[0,0,m1+1,z1][LaplaceTransform][f1,t1,s1,opt])* Derivative[0,0,m2,z2][LaplaceTransform][f2,t2,s2,opt] + (Derivative[0,0,m2,z2][LaplaceTransform][D[f2,x],t2,s2,opt] + D[s2,x] * Derivative[0,0,m1+1,z2][LaplaceTransform][f2,t2,s2,opt])* Derivative[0,0,m1,z1][LaplaceTransform][f1,t1,s1,opt] /; (Length[{z1}] == Length[{opt1}]) && (Length[{z2}] == Length[{opt2}]) && !(SameQ[x,t1] || SameQ[x,t2] || SameQ[x,s1] || SameQ[x,s2]) && FreeQ[s1,t1] && FreeQ[s2,t2] Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, t_Symbol,s_,opt__], {x_Symbol,n_Integer?Positive}]] := Nest[D[#,x]&, u Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt], n] /; (Length[{z}] == Length[{opt}]) && !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t] Protect[D, Derivative] (************************************************************************) (* Inverse Laplace Transform *) (************************************************************************) (* =========================== Using Apart =============================== *) InverseLaplaceTransform[f:Power[x_, n_?Negative], s_Symbol, t_, opt___] := Module[{ff = Chop[Apart[Factor[f], s]]}, InverseLaplaceTransform[ff, s, t, opt] /; SameQ[Head[ff],Plus] || (SameQ[Head[ff],Power] && ff[[2]] != n) ] /; !FreeQ[x, s] && FreeQ[t,s] InverseLaplaceTransform[f:Times[c__, Power[x_, n_?Negative]], s_Symbol, t_, opt___] := Module[{ff = Chop[Apart[Factor[f], s]]}, InverseLaplaceTransform[ff, s, t, opt] /; SameQ[Head[ff],Plus] || (SameQ[Head[Denominator[ff]],Power] && Denominator[ff][[2]] != -n) ] /; !FreeQ[{c},s] && !FreeQ[x, s] && FreeQ[t,s] InverseLaplaceTransform[f_, s_Symbol, t_, opt___] := Module[{num = Numerator[f], den = Denominator[f], ff = Chop[Apart[Factor[f, GaussianIntegers->True],s]]}, ((InverseLaplaceTransform[ff,s,t,opt] // Expand) //. ExpRules2) /; (!FreeQ[den,s] && PolynomialQ[num,s] && PolynomialQ[den,s] && Exponent[den,s]>0 && !(Exponent[num,s]t ] /; IntegerQ[n] && Positive[n] && FreeQ[t,s] InverseLaplaceTransform[s_^c1_, s_Symbol, t_, opt___] := With[{p = If[SameQ[Head[c1],Plus], Map[-#&,c1], -c1]}, (t^(p-1) / Gamma[p]) ] /; FreeQ[{c1, t}, s] && (MatchQ[c1, n1_?Negative n2_. /; FreeQ[{n1,n2},s]] || (SameQ[Head[c1],Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_. /; FreeQ[{n1,n2},s]]&, Apply[List,c1]]])) SqrtRule = { Sqrt[x_?Negative] :> I Sqrt[-x], 1/Sqrt[x_?Negative] :> -I / Sqrt[-x] } ExpRules1 = { Exp[x_. + Complex[r_, i_] y_.] :> Expand[Exp[x + r y](Cos[i y] + I Sin[i y])], Exp[x_] :> Exp[Expand[x]] /; !SameQ[x,Expand[x]] } ExpRules2 = { a1_. Exp[Complex[r_,i1_] t_.] + a2_. Exp[Complex[r_,i2_] t_.] :> 2 a1 I Sin[i1 t] Exp[r t] /; a1+a2==0 && i1+i2==0 && i1>0, a_. Exp[Complex[r_,i1_] t_.] + a_. Exp[Complex[r_,i2_] t_.] :> 2 a Cos[i1 t] Exp[r t] /; i1+i2==0, a1_. Exp[(-1)^b1_Rational t_.] + a2_. Exp[(-1)^b2_Rational t_.] :> 2 a1 I Sin[Sin[b1 Pi] t] Exp[Cos[b1 Pi] t] /; a1+a2==0 && Mod[b1+b2,2]==0 && Mod[b1,2]<1, a_. Exp[(-1)^b1_Rational t_.] + a_. Exp[(-1)^b2_Rational t_.] :> 2 a Cos[Sin[b1 Pi] t] Exp[Cos[b1 Pi] t] /; Mod[b1+b2,2]==0, a1_. Exp[b1_. t_.] + a2_. Exp[b2_. t_.] :> 2 a1 Sinh[b1 t] /; NumberQ[b1] && NumberQ[b2] && a1+a2==0 && b1+b2==0 && FreeQ[{b1,b2},Complex] && b1>0, a_. Exp[b1_] + a_. Exp[b2_] :> 2 a Cosh[b1] /; b1+b2==0 && FreeQ[{b1,b2},Complex], a_. Complex[re1_,im1_] Exp[(-1)^b1_Rational t_.] + a_. Complex[re2_,im2_] Exp[(-1)^b2_Rational t_.] :> a(re1 Exp[(-1)^b1 t] + re2 Exp[(-1)^b2 t]) + a I(im1 Exp[(-1)^b1 t] + im2 Exp[(-1)^b2 t]) /; ((Abs[re1] == Abs[re2] == Abs[im1] == Abs[im2]) && Mod[b1+b2,2]==0) } InverseLaplaceTransform[1/(a1_ + b1_ + c_.), s_Symbol, t_, opt___] := Module[{x, a, b, re, im}, ( v = ((x /. Solve[a x^2+b x+c==0, x]) /. SqrtRule); ExpandAll[ If[SameQ @@ v, t Exp[v[[1]] t], If[SameQ[Head[v[[1]]],Complex], {re,im} = {Re[v[[1]]],Im[v[[1]]]}; Exp[re t] Sin[im t]/(a im), (Exp[v[[1]] t]-Exp[v[[2]] t])/(a (v[[1]]-v[[2]])) ] ] /. Exp[xx:Times[_Plus, __]] :> Exp[Expand[xx]] //. ExpRules1 ] ) /; FreeQ[a = Factor[a1]/s^2, s] && FreeQ[b = Factor[b1]/s, s] ] /; FreeQ[{c,t},s] && !FreeQ[a1,s] && !FreeQ[b1,s] InverseLaplaceTransform[1/(s_^2+c_?Negative b_.), s_Symbol, t_, opt___] := With[{a = Sqrt[-b c]}, Sinh[a t]/a ] /; FreeQ[{b,c,t},s] InverseLaplaceTransform[1/(s_^2+b_), s_Symbol, t_, opt___] := Module[{a = Sqrt[b]}, Sin[a t]/a ] /; FreeQ[{b,t},s] InverseLaplaceTransform[1/(d_ + b_), s_Symbol, t_, opt___] := Module[{k, a, c, temp, n = Exponent[d,s]}, a = Coefficient[d, s, n]; c = b/a; temp = Expand[ (-1/(b n)) Sum[ Module[{z = If[TrueQ[c<0], (-c)^(1/n) Exp[I Pi 2k/n], (c)^(1/n) Exp[I Pi (2k+1)/n]]}, z Exp[z t] ], {k,0,n-1}] //. ExpRules1 ]; temp //. ExpRules2 ] /; FreeQ[{b,t},s] && !FreeQ[d,s] && MatchQ[Factor[d], a_. s^n_Integer?Positive /; FreeQ[a,s]] InverseLaplaceTransform[Sqrt[s_+b_.]/(s_+a_.), s_Symbol, t_, opt___] := Exp[-b t]/Sqrt[Pi t] + Sqrt[b-a] Exp[-a t] Erf[Sqrt[(b-a)t]] /; FreeQ[{a, b, t}, s] InverseLaplaceTransform[1/Sqrt[s_+a_.]/Sqrt[s_+b_.], s_Symbol, t_, opt___] := Exp[-(a+b)t/2] BesselI[0, (a-b)t/2] /; FreeQ[{a,b,t},s] InverseLaplaceTransform[(s_+a_.)^(-1/2)(s_+b_.)^(-3/2), s_Symbol, t_, opt___] := t Exp[-(a+b)t/2] (BesselI[0, (a-b)t/2] + BesselI[1, (a-b)t/2]) /; FreeQ[{a,b,t},s] InverseLaplaceTransform[Sqrt[s_+a_.]/(s_+b_.)^(3/2), s_Symbol, t_, opt___] := Exp[-(a+b)t/2]((1+(a-b)t)BesselI[0, (a-b)t/2] + (a-b)t BesselI[1, (a-b)t/2]) /; FreeQ[{a,b,t},s] InverseLaplaceTransform[(a1_+b1_+c_.)^Rational[k_Integer?Negative, 2], s_Symbol,t_,opt___] := Module[{a, b}, ( InverseLaplaceTransform[ ((s + b / (2 a))^2 + (4 a c - b^2) / (4 a))^(k/2), s, t, opt] / a ) /; FreeQ[a = Factor[a1]/s^2, s] && FreeQ[b = Factor[b1]/s, s] ] /; FreeQ[{c,t},s] && !FreeQ[a1,s] && !FreeQ[b1,s] InverseLaplaceTransform[(d1_ + b1_)^Rational[k_Integer?Negative, 2], s_Symbol,t_,opt___] := Module[{n = -k/2-1/2, d, a}, ( a = Sqrt[-b1/d]; t^n BesselI[n, a t]/(If[n==0, 1, (2n-1)!!] a^n d) ) /; FreeQ[d = Factor[d1]/s^2, s] ] /; FreeQ[{b1, t}, s] && !FreeQ[d1, s] && (MatchQ[b1, b_?Negative c_. /; FreeQ[{b,c}, s]] || (SameQ[Head[b1], Plus] && Apply[And, Map[MatchQ[#, b_?Negative c_. /; FreeQ[{b,c}, s]]&, Apply[List, b1]]])) InverseLaplaceTransform[(d1_ + c_)^Rational[k_Integer?Negative, 2], s_Symbol, t_, opt___] := Module[{n = -k/2-1/2, d, a}, ( a = Sqrt[c/d]; t^n BesselJ[n, a t]/(If[n==0, 1, (2n-1)!!] a^n d) ) /; FreeQ[d = Factor[d1]/s^2, s] ] /; FreeQ[{c, t}, s] && !FreeQ[d1, s] InverseLaplaceTransform[ (a1_ + b1_)^n_., s_Symbol, t_, opt___] := Module[{a, c, b, d}, (a^n) InverseLaplaceTransform[(s + (b Sqrt[c] / a) Sqrt[s^2 + d/c])^n, s, t, opt] /; (FreeQ[a = Factor[a1]/s, s] && MatchQ[Factor[b1], b2_. Sqrt[c1_ + d2_] /; (FreeQ[b = b2, s] && FreeQ[d = d2, s] && FreeQ[c = Factor[c1]/s^2, s] && (a =!= 1 || c =!= 1))] ) ] /; FreeQ[{n, t}, s] InverseLaplaceTransform[ (s_ - Sqrt[s_^2 + c1_?Negative c2_.])^n_., s_Symbol, t_, opt___] := (n/t) Sqrt[-c1 c2]^n BesselI[n, Sqrt[-c1 c2] t] /; FreeQ[{c1, c2, n, t}, s] InverseLaplaceTransform[(s_ - Sqrt[s_^2 + c_])^n_., s_Symbol, t_, opt___] := (-1)^n (n/t) Sqrt[c]^n BesselJ[n, Sqrt[c] t] /; FreeQ[{c, n, t}, s] InverseLaplaceTransform[(c1_ + b3_)^(n3_), s_Symbol, t_, opt___] := Module[{c, a, n = -n3}, ( a = PowerExpand[Sqrt[Expand[-b3]/c]]; Collect[ (Sqrt[Pi] (2a)^(1/2-n) / Gamma[n] t^(n-1/2) BesselI[n-1/2, a t] / c^n) // PowerExpand // Expand, {Cosh[a t], Sinh[a t]} ] ) /; FreeQ[c = Factor[c1]/s^2, s] && positive[c] ] /; FreeQ[{b3, n3, t}, s] && !FreeQ[c1, s] && (MatchQ[b3, b1_?Negative b2_.] || (SameQ[Head[b3], Plus] && Apply[And, Map[MatchQ[#, b1_?Negative b2_.]&, Apply[List, b3]]])) && (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) InverseLaplaceTransform[(c1_ + b_)^(n3_), s_Symbol, t_, opt___] := Module[{c, a, n = -n3}, ( a = PowerExpand[Sqrt[b/c]]; Collect[ (Sqrt[Pi] (2a)^(1/2-n) / Gamma[n] t^(n-1/2) BesselJ[n-1/2, a t] / c^n) // PowerExpand // Expand, {Cos[a t], Sin[a t]} ] ) /; FreeQ[c = Factor[c1]/s^2, s] ] /; FreeQ[{b, n3, t}, s] && !FreeQ[c1, s] && (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) (* ============================== Exponentials ============================== *) InverseLaplaceTransform[f_. Power[e_,c_ + b_.], s_Symbol, t_, opt___] := Module[{a}, SimplifyUnitStep[ e^b (InverseLaplaceTransform[f, s, t, opt] /. t -> t+a Log[e]) UnitStep[t+a Log[e]]] /; FreeQ[a = Factor[c]/s, s] ] /; FreeQ[{b,t}, s] && !FreeQ[c,s] && FreeQ[f, Integrate] InverseLaplaceTransform[Exp[a3_ + b_.], s_Symbol, t_, opt___] := Module[{a, a4}, ( a = -a4; Expand[Exp[b] (DiracDelta[t] - Sqrt[a/t] BesselJ[1, 2 Sqrt[a t]])] ) /; FreeQ[a4 = Factor[a3] s, s] && (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, a4]]])) ] /; FreeQ[{b, t}, s] && !FreeQ[a3, s] InverseLaplaceTransform[Exp[a1_ + b_.], s_Symbol, t_, opt___] := Module[{a}, Exp[b] (Sqrt[a/t] BesselI[1, 2 Sqrt[a t]] + DiracDelta[t]) /; FreeQ[a = Factor[a1] s, s] ] /; FreeQ[{b, t}, s] InverseLaplaceTransform[s_^(n3_) Exp[a3_ + b_.], s_Symbol, t_, opt___] := Module[{n = -n3 - 1, a, a4}, ( a = -a4; Exp[b] (t/a)^(n/2) BesselJ[n, 2Sqrt[a t]] ) /; FreeQ[a4 = Factor[a3] s, s] && (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] && Apply[And, Map[MatchQ[#, a1_?Negative a2_.]&, Apply[List, a4]]])) ] /; FreeQ[{n3, b, t}, s] && !FreeQ[a3, s] (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) InverseLaplaceTransform[s_^(n3_) Exp[a3_ + b_], s_Symbol, t_, opt___] := Module[{a, n = -n3 - 1}, Exp[b] (t/a)^(n/2) BesselI[n, 2Sqrt[a t]] /; FreeQ[a = Factor[a3] s, s] ] /; FreeQ[{n3, b, t}, s] && !FreeQ[a3, s] (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) InverseLaplaceTransform[Exp[a3_ + b_.], s_Symbol, t_, opt___] := Module[{a, a4}, ( a = -a4; Exp[b - a^2/(4t)] a/(2 Sqrt[Pi t^3]) ) /; FreeQ[a4 = Factor[a3]/Sqrt[s], s] && (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] && Apply[And, Map[MatchQ[#, a1_?Negative a2_.]&, Apply[List, a4]]])) ] /; FreeQ[{b, t}, s] && !FreeQ[a3, s] InverseLaplaceTransform[s_^n_. Exp[a3_ + b_.], s_Symbol, t_, opt___] := Module[{a, a4}, ( a = -a4; Exp[b] 2^(-n-1/2) Pi^(-1/2) t^(-n-1) Exp[-a^2/(8t)] * ParabolicCylinderD[2n+1, a/Sqrt[2t]] ) /; FreeQ[a4 = Factor[a3]/Sqrt[s], s] && (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] && Apply[And, Map[MatchQ[#, a1_?Negative a2_.]&, Apply[List, a4]]])) ] /; FreeQ[{b, n, t}, s] && !FreeQ[a3, s] (* ======================== Logarithmic Functions ========================== *) InverseLaplaceTransform[Log[s_] s_^(n3_), s_Symbol, t_, opt___] := t^(-n3-1)(PolyGamma[-n3]-Log[t])/Gamma[-n3] /; FreeQ[{n3, t}, s] && (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) InverseLaplaceTransform[Log[a1_ + b_] s_^(n_Integer?Negative), s_Symbol, t_, opt___] := Module[{a, tt}, (DI[Log[b] - ExpIntegralEi[-b tt/a], t, 0, tt, -1-n] /. tt->t) /; FreeQ[a = Factor[a1]/s, s] ] /; FreeQ[{b, t}, s] && !FreeQ[a1, s] InverseLaplaceTransform[Log[e_. + f_], s_Symbol, t_, opt___] := Module[{a, b, c, d, f1}, Log[e + a/c] DiracDelta[t] + (-Exp[-(d e + b) t/(c e + a)] + Exp[-d t/c])/t /; (f1 = Together[f]; MatchQ[Collect[Numerator[f1], s]/Collect[Denominator[f1], s], (a1_. s + b1_.)/(c1_. s + d1_.) /; FreeQ[{a, b, c, d} = {a1, b1, c1, d1}, s]]) ] /; FreeQ[{e, t}, s] && If[Head[f]===Plus, Apply[And, Map[!FreeQ[#, s]&, Apply[List, f]]], !FreeQ[f, s]] InverseLaplaceTransform[Log[e_. + f_], s_Symbol, t_, opt___] := Module[{b, c, d, f1}, Log[e] DiracDelta[t] + (-Exp[-(d e + b) t/(c e)] + Exp[-d t/c])/t /; (f1 = Together[f]; MatchQ[Numerator[f1]/Collect[Denominator[f1], s], b1_. / (c1_. s + d1_.) /; FreeQ[{b, c, d} = {b1, c1, d1}, s]]) ] /; FreeQ[{e, t}, s] && If[Head[f]===Plus, Apply[And, Map[!FreeQ[#, s]&, Apply[List, f]]], !FreeQ[f, s]] InverseLaplaceTransform[s_^(n3_) Log[s_]^2, s_Symbol, t_, opt___] := With[{n = -n3}, t^(n-1)((PolyGamma[n]-Log[t])^2 - PolyGamma[1, n]) / Gamma[n] ] /; FreeQ[{n3, t}, s] && (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) ilLog[a_, b_, c_, d_, t_] := (2/t)(Cos[Sqrt[-c^2/4+d]t]Exp[-c t/2]-Cos[Sqrt[-a^2/4+b]t]Exp[-a t/2]) //. { Cos[Complex[aa_, bb_] cc_.] :> Cos[aa cc]Cosh[bb cc] - I Sin[aa cc]Sinh[bb cc], Cos[Sqrt[a1_?Negative] a2_.] :> Cosh[Sqrt[Expand[-a1]] a2] } InverseLaplaceTransform[Log[d_. (a1_+c_.)/s_^2], s_Symbol, t_, opt___] := Module[{a}, Log[a d]DiracDelta[t] + ilLog[0, c/a, 0, 0, t] /; FreeQ[a = Factor[a1]/s^2, s] ] /; FreeQ[{c,d,t},s] && !FreeQ[a1,s] InverseLaplaceTransform[Log[(a_. s_^2+c_.)/(d_. s_^2+f_.)], s_Symbol, t_, opt___] := Log[a/d]DiracDelta[t] + ilLog[0, c/a, 0, f/d, t] /; FreeQ[{a,c,d,f,t},s] InverseLaplaceTransform[ Log[(a_. s_^2+c_.)/(d_. s_^2+e_. s_+f_.)], s_Symbol, t_, opt___] := Log[a/d]DiracDelta[t] + ilLog[0, c/a, e/d, f/d, t] /; FreeQ[{a,c,d,e,f,t},s] InverseLaplaceTransform[ Log[(a_. s_^2+b_. s_+c_.)/(d_. s_^2+f_.)], s_Symbol, t_, opt___] := Log[a/d]DiracDelta[t] + ilLog[b/a, c/a, 0, f/d, t] /; FreeQ[{a,b,c,d,f,t},s] InverseLaplaceTransform[ Log[(a_. s_^2+b_. s_+c_.)/(d_. s_^2+e_. s_+f_.)], s_Symbol, t_, opt___] := Log[a/d]DiracDelta[t] + ilLog[b/a, c/a, e/d, f/d, t] /; FreeQ[{a,b,c,d,e,f,t},s] InverseLaplaceTransform[ Log[expr:Plus[a_.,Times[b_.,Power[_,_?Negative]]]], s_Symbol, t_, opt___] := Module[{expr1 = MapAt[Collect[#, s]&, ExpandNumerator[ExpandDenominator[Together[expr]]], {{2, 1}, {1}}]}, InverseLaplaceTransform[Log[expr1], s, t, opt] /; expr1 =!= expr ] /; FreeQ[t,s] (* ====================== Trigonometric Functions ========================== *) InverseLaplaceTransform[s_^(n3_) Sin[a1_], s_Symbol, t_, opt___] := Module[{a, n = -n3}, (t/a)^((n-1)/2) (Sin[3Pi n/4 + Pi/4] ThomsonBer[n-1, 2Sqrt[a t]] - Cos[3Pi n/4+Pi/4] ThomsonBei[n-1, 2Sqrt[a t]]) /; FreeQ[a = Factor[a1] s, s] ] /; FreeQ[{n3, t}, s] && (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) InverseLaplaceTransform[s_^(n3_) Cos[a1_], s_Symbol, t_, opt___] := Module[{a, n = -n3}, -(t/a)^((n-1)/2) (Cos[3Pi n/4 + Pi/4] ThomsonBer[n-1, 2Sqrt[a t]] - Sin[3Pi n/4+Pi/4] ThomsonBei[n-1, 2Sqrt[a t]]) /; FreeQ[a = Factor[a1] s, s] ] /; FreeQ[{n3, t}, s] && (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] && Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]])) InverseLaplaceTransform[ArcTan[a1_], s_Symbol, t_, opt___] := Module[{a}, Sin[a t] / t /; FreeQ[a = Factor[a1] s, s] ] /; FreeQ[t, s] && !FreeQ[a1, s] (* ====================== Derivatives and Integrals ======================== *) InverseLaplaceTransform[ Derivative[n_Integer?Positive][f_][s_], s_Symbol, t_, opt___] := (-1)^n t^n InverseLaplaceTransform[f[s], s, t, opt] /; FreeQ[t,s] InverseLaplaceTransform[ Derivative[0,0,n_Integer?Positive,___] [LaplaceTransform][f_,t1_Symbol,s_Symbol,opt1___], s_Symbol,t2_,opt2___] := ((-1)^n (t1^n f) /. t1->t2) /; FreeQ[{f,t},s] InverseLaplaceTransform[ Exp[a_. ss_Symbol] Literal[Integrate][Exp[-ss_Symbol tt_] f_, {tt_Symbol, 0, a_}], s_Symbol, t_, opt___] := InverseLaplaceTransform[Exp[a ss] LaplaceTransform[f,t,s,opt] /. {ss->s, tt->t}, s, t, opt] - (f /. tt->t+a) /; FreeQ[t,s] InverseLaplaceTransform[Literal[Integrate][f_, {ss_Symbol, s_, Infinity}], s_Symbol, t_, opt___] := InverseLaplaceTransform[f /. ss->s, s, t, opt] / t /; FreeQ[t,s] (* ===================== Products Involving Powers ======================== *) InverseLaplaceTransform[a_ s_^n_., s_Symbol, t_, opt___] := Module[{tt = If[SameQ[Head[t], Symbol], Unique[ToString[t]], Unique[]], v, f, init, k, zerolimit = ZeroLimit /. {opt} /. Options[LaplaceTransform]}, (f = InverseLaplaceTransform[a, s, tt, opt]; init = Limit[ Sum[ s^(n-k-1) D[f, {tt, k}], {k, 0, n-1}], tt->0, Direction->1]; If[!FreeQ[init,Limit], If[zerolimit===Automatic, init = Sum[ s^(n-k-1) (D[f, {tt, k}] /. tt->0), {k, 0, n-1}], v = If[SameQ[Head[t], Symbol], t, Unique[]]; init = init /. tt->v ] ]; ((D[f, {tt, n}]) /. tt->t) + InverseLaplaceTransform[init,s,t,opt] ) /; (zerolimit===Automatic || zerolimit===All) ] /; IntegerQ[n] && n > 0 && FreeQ[t,s] InverseLaplaceTransform[a_ s_^(n_Integer?Negative), s_Symbol, t_, opt___] := Module[{tt}, DI[InverseLaplaceTransform[a, s, tt, opt], t, 0, tt, -n] /. tt->t ] /; FreeQ[t,s] (* ============== InverseLaplaceTransform of LaplaceTransform ============ *) Literal[InverseLaplaceTransform[LaplaceTransform[f_, t_Symbol, s_, ___], s_Symbol, t1_, ___]] := (f /. t->t1) /; FreeQ[t1,s] Literal[InverseLaplaceTransform[LaplaceTransform[f_, t:{__Symbol}, s_, ___], s:{__Symbol}, t1_List, ___]] := (f /. Thread[Rule[t,t1]]) /; (Length[t] == Length[s] == Length[t1] && And @@ Map[FreeQ[t1,#]&, s]) (* ======================= Composed Functions ============================= *) InverseLaplaceTransform[g1_ g2_, s_Symbol, t_, opt___] := Module[{v = If[SameQ[Head[t], Symbol], Unique[ToString[t]], Unique[]]}, Integrate[ Collect[ (InverseLaplaceTransform[g1, s, t, opt] /. t->v) * (InverseLaplaceTransform[g2, s, t, opt] /. t->t-v), DiracDelta], {v, 0, t}] ] /; FreeQ[{InverseLaplaceTransform[g1, s, t, opt], InverseLaplaceTransform[g2, s, t, opt]}, InverseLaplaceTransform] && FreeQ[t,s] InverseLaplaceTransform[f_, s_Symbol, t_, opt___] := Module[ {gg = Module[ {newf = f (* //. CombinePlusRule[s] *), g}, g = ComposedFunctionQ[newf, s]; If[( (SameQ @@ g) && (MatchQ[g[[1]], _Times] || MatchQ[g[[1]], _Plus]) ) || (And @@ (MatchQ[#, Power[s, Rational[_Integer?Negative, 2]]]& /@ g)), Switch[ g[[1]], _Times, Module[ {a = g[[1]]/s}, InverseLaplaceTransform[newf /. g[[1]]->s, s, t/a, opt] / a ], _Plus, Module[ {a = g[[1]]-s}, InverseLaplaceTransform[newf /. g[[1]]->s, s, t, opt] Exp[-a t] ], _, Module[ {ff = InverseLaplaceTransform[ PowerExpand[newf /. s->s^2], s, t, opt]}, If[ FreeQ[ff,InverseLaplaceTransform], Expand[ Module[ {v = If[SameQ[Head[t],Symbol], Unique[ToString[t]], Unique[]]}, Integrate[ Collect[v Exp[-v^2/(4 t)](ff /. t->v), DiracDelta], {v, 0, Infinity}] ] / (2 Sqrt[Pi t^3]) ], $Failed ] ] ], $Failed ] ] }, gg /; !SameQ[Head[gg],InverseLaplaceTransform] && !SameQ[gg, $Failed] ] /; FreeQ[t,s] (* ========== Combine like expressions in Plus patterns ================== *) InverseLaplaceTransform[f_, s_Symbol, t_, opt___] := Module[{newf = f //. CombinePlusRule[s]}, InverseLaplaceTransform[newf, s, t, opt] /; !SameQ[newf,f] ] /; FreeQ[t,s] (* ================== Derivative of InverseLaplaceTransform ================ *) Unprotect[D, Derivative] (*** Derivative of InverseLaplaceTransform, Linearity ***) Literal[D[x_Plus,y_Symbol]] := Map[D[#,y]&,x] /; !FreeQ[x,InverseLaplaceTransform] Literal[D[x_Plus,{y_Symbol,n_Integer?Positive}]] := Map[D[#,{y,n}]&,x] /; !FreeQ[x,InverseLaplaceTransform] Literal[D[x_Times,y_Symbol]] := Module[{e = Expand[x]}, D[e,y] /; !SameQ[x,e] ] /; !FreeQ[x,InverseLaplaceTransform] Literal[D[x_Times,{y_Symbol,n_Integer?Positive}]] := Module[{e = Expand[x]}, D[e,{y,n}] /; !SameQ[x,e] ] /; !FreeQ[x,InverseLaplaceTransform] Derivative[0,0,m_Integer?Positive][InverseLaplaceTransform][f_, s_Symbol, t_] := Module[{inverse, t1}, (D[inverse, {t1, m}] /. t1->t) /; FreeQ[inverse = InverseLaplaceTransform[f, s, t1], InverseLaplaceTransform] ] /; FreeQ[t, s] Derivative[0,0,m_Integer?Positive,z:(0)..][InverseLaplaceTransform][f_, s_Symbol,t_,opt__] := Module[{inverse, t1}, (D[inverse, {t1, m}] /. t1->t) /; FreeQ[inverse = InverseLaplaceTransform[f, s, t1], InverseLaplaceTransform] ] /; ((Length[{z}] == Length[{opt}]) && FreeQ[t,s]) (*** Derivative of InverseLaplaceTransform wrt t ***) Literal[D[InverseLaplaceTransform[f_,s_Symbol,t_,opt__],t_Symbol]] := Apply[Derivative,Join[{0,0,1}, Table[0,{Length[{opt}]}]]][InverseLaplaceTransform][f,s,t,opt] /; FreeQ[t,s] Literal[D[InverseLaplaceTransform[f_,s_Symbol,t_,opt__], {t_Symbol,n_Integer?Positive}]] := Apply[Derivative,Join[{0,0,n}, Table[0,{Length[{opt}]}]]][InverseLaplaceTransform][f,s,t,opt] /; FreeQ[t,s] (*** Derivative of InverseLaplaceTransform wrt s ***) Literal[D[u_. InverseLaplaceTransform[f_,s_Symbol,t_,opt___],s_]] := D[u,s] InverseLaplaceTransform[f,s,t,opt] /; FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s] Literal[D[u_. InverseLaplaceTransform[f_,s_Symbol,t_,opt___], {s_,n_Integer?Positive}]] := D[u,{s,n}] InverseLaplaceTransform[f,s,t,opt] /; FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s] (*** Derivative of Derivative of InverseLaplace wrt t (with options) ***) Literal[D[u_. Derivative[0,0,m_Integer?Positive, z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_Symbol,opt__], t_]] := u Derivative[0,0,m+1,z][InverseLaplaceTransform][f,s,t,opt] + D[u,t] Derivative[0,0,m,z][InverseLaplaceTransform][f,s,t,opt] /; (Length[{z}] == Length[{opt}]) && FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s] Literal[D[Derivative[0,0,m1_Integer?Positive, z1:(0)..][InverseLaplaceTransform][f1_,s1_Symbol,t_Symbol,opt1__] * Derivative[0,0,m2_Integer?Positive, z2:(0)..][InverseLaplaceTransform][f2_,s2_Symbol,t_Symbol,opt2__], t_]] := Derivative[0,0,m1,z1][InverseLaplaceTransform][f1,s1,t,opt] * Derivative[0,0,m2+1,z2][InverseLaplaceTransform][f2,s2,t,opt] + Derivative[0,0,m1+1,z1][InverseLaplaceTransform][f1,s1,t,opt] * Derivative[0,0,m2,z2][InverseLaplaceTransform][f2,s2,t,opt] /; (Length[{z1}] == Length[{opt1}]) && (Length[{z2}] == Length[{opt2}]) && FreeQ[t,s1] && FreeQ[t,s2] Literal[D[u_. Derivative[0,0,m_Integer?Positive, z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_Symbol,opt__], {t_,n_Integer?Positive}]] := Nest[D[#,t]&, u Derivative[0,0,m,z][InverseLaplaceTransform][f, s,t,opt], n] /; (Length[{z}] == Length[{opt}]) && FreeQ[t,s] (*** Derivative of Derivative of InverseLaplace wrt s ***) Literal[D[u_. Derivative[0,0,m_Integer?Positive][InverseLaplaceTransform][f_, s_Symbol,t_], s_]] := D[u,s] Derivative[0,0,m][InverseLaplaceTransform][f,s,t] /; FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s] Literal[D[u_. Derivative[0,0,m_Integer?Positive][InverseLaplaceTransform][f_, s_Symbol,t_], {s_,n_Integer?Positive}]] := Nest[D[#,s]&, u Derivative[0,0,m][InverseLaplaceTransform][f,s,t], n] /; FreeQ[t,s] Literal[D[u_. Derivative[0,0,m_Integer?Positive, z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_,opt__], s_]] := D[u,s] Derivative[0,0,m,z][InverseLaplaceTransform][f, s,t,opt] /; (Length[{z}] == Length[{opt}]) && FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s] Literal[D[u_. Derivative[0,0,m_Integer?Positive, z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_,opt__], {s_,n_Integer?Positive}]] := Nest[D[#,s]&, u Derivative[0,0,m,z][InverseLaplaceTransform][f, s,t,opt], n] /; (Length[{z}] == Length[{opt}]) && FreeQ[t,s] Protect[D, Derivative] positive[a_] := Positive[a] /; NumberQ[N[a]] positive[a_Times] := Apply[And, Map[positive, a]] positive[a_] := True negative[a_] := Negative[a] /; NumberQ[N[a]] negative[a_Times] := Apply[Or, Map[negative, a]] negative[a_] := False ComplexQ[a_] := Head[a] === Complex (*****************************************************************************) End[] (* end `Private` Context *) (*****************************************************************************) (*****************************************************************************) EndPackage[] (* end package Context *) (*****************************************************************************)