home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 9 / 09.iso / e / e032 / 3.ddi / FILES / CALCULUS.PAK / LAPLACET.M < prev    next >
Encoding:
Text File  |  1992-07-29  |  49.3 KB  |  1,312 lines
  1.  
  2. (*:Mathematica Version: 2.0 *)
  3.  
  4. (*:Context: Calculus` *)
  5.  
  6. (*:Title: LaplaceTransform *)
  7.  
  8. (*:Author: Eran Yehudai & E.C.Martin *)
  9.  
  10. (*:Summary: Implements Laplace and inverse Laplace transforms.
  11. *)
  12.  
  13. (*:Keywords: Laplace, transform, differential equations
  14. *)
  15.  
  16. (*:Requirements: none. *)
  17.  
  18. (*:Sources:
  19.     Fritz Oberhettinger and Larry Badii, Tables of Laplace
  20.     Transforms, New-York: Springer-Verlag, 1973.
  21. *)
  22.  
  23. (*:History:
  24.     Version 1.1 by Eran Yehudai, October, 1990.
  25.     Extensively modified by ECM (Wolfram Research), Jan., Nov. 1991.
  26.     Modified to use UnitStep and DiracDelta, ECM (WRI) Jan.1992.
  27. *)
  28.  
  29. BeginPackage["Calculus`LaplaceTransform`", "Calculus`DiracDelta`",
  30.          "Calculus`Common`Support`"]
  31.  
  32. LaplaceTransform::usage =
  33. "LaplaceTransform[expr, t, s, opts] gives a function of s, which is the Laplace
  34. transform of expr, a function of t. It is defined by 
  35. LaplaceTransform[expr, t, s] = Integrate[Exp[-s t] expr, {t, 0, Infinity}]."
  36. Options[LaplaceTransform] = {ZeroLimit->Automatic}
  37. SetAttributes[LaplaceTransform, Listable]
  38.  
  39. InverseLaplaceTransform::usage =
  40. "InverseLaplaceTransform[expr, s, t, opts] gives a function of t, the Laplace
  41. transform of which is expr, a function of s."
  42. Options[InverseLaplaceTransform] = Options[LaplaceTransform]
  43. SetAttributes[InverseLaplaceTransform, Listable]
  44.  
  45. (* The option ZeroLimit determines how to treat the limit t->0, Direction->1
  46.    in the case of symbolic functions. *)
  47.  
  48.  
  49. (************************************************************************)
  50. Begin["`Private`"]
  51. (************************************************************************)
  52.  
  53. DI[f_, _, _, _, 0] := f
  54.  
  55. DI[f_, s_, ss_Symbol, Infinity, n_Integer?Positive] :=
  56.   Module[{v = If[SameQ[Head[s],Symbol], Unique[ToString[s]], Unique[]]},
  57.         Integrate[Collect[
  58.         DI[f /. ss->v, s, v, Infinity, n-1],
  59.             DiracDelta], {v, ss, Infinity}]
  60.   ]
  61.  
  62. DI[f_, t_, 0, tt_Symbol, n_Integer?Positive] :=
  63.   Module[{v = If[SameQ[Head[t],Symbol], Unique[ToString[t]], Unique[]]},
  64.     Integrate[Collect[
  65.         DI[f /. tt->v, t, 0, v, n-1],
  66.             DiracDelta], {v, 0, tt}]
  67.   ]
  68.  
  69.  
  70.  
  71. (*****************************************************************************)
  72. (*                            Laplace Transform                              *)
  73. (*****************************************************************************)
  74.  
  75. (* ============================ Numeric Value ============================== *)
  76.  
  77. N[LaplaceTransform[f_, t_Symbol, s_?NumberQ, ___]] := NIntegrate[Exp[-s t]f,
  78.     {t,0,Infinity}]
  79.  
  80. N[LaplaceTransform[f_, t_Symbol, s_?NumberQ, ___], d_] :=
  81.   NIntegrate[Exp[-s t]f, {t, 0, Infinity}, WorkingPrecision->d]
  82.  
  83.  
  84. (* ============================== UnitStep ================================= *)
  85.  
  86. LaplaceTransform[f_. UnitStep[t_, r___Rule], t_Symbol, s_, opt___] :=
  87.     LaplaceTransform[f, t, s, opt]
  88.  
  89. LaplaceTransform[UnitStep[a_. t_ + b_., r___Rule], t_Symbol, s_, opt___] :=
  90.     Exp[s b/a]/s /; positive[a] 
  91.  
  92. LaplaceTransform[f_. UnitStep[a_?negative t_ + b_?negative, r___Rule],
  93.     t_Symbol, s_, opt___] := 0
  94.  
  95. LaplaceTransform[f_. UnitStep[a_?negative t_ + b_., r___Rule],
  96.     t_Symbol, s_, opt___] :=
  97.     Module[{result = LaplaceTransform[f, t, s, opt] -
  98.              LaplaceTransform[f UnitStep[t + b/a, r], t, s, opt]},
  99.            result /; FreeQ[result, LaplaceTransform]
  100.         ] /; positive[b]
  101.  
  102. (* ============================= Using Apart =============================== *)
  103.  
  104. LaplaceTransform[f:Power[x_, n_?Negative], t_Symbol, s_, opt___] :=
  105.   Module[{ff = Chop[Apart[Factor[f], t]]},
  106.     LaplaceTransform[ff, t, s, opt] /; ((SameQ[Head[ff],Plus] ||
  107.         (SameQ[Head[ff],Power] && ff[[2]] != n)) && 
  108.     FreeQ[LaplaceTransform[ff, t, s, opt], LaplaceTransform])
  109.   ] /;  !FreeQ[x, t] && FreeQ[s,t]
  110.  
  111. LaplaceTransform[f:Times[c__, Power[x_, n_?Negative]], t_Symbol, s_, opt___] :=
  112.   Module[{ff = Chop[Apart[Factor[f], t]]},
  113.     LaplaceTransform[ff, t, s, opt] /; ((SameQ[Head[ff],Plus] ||
  114.     (SameQ[Head[Denominator[ff]],Power] && Denominator[ff][[2]] != -n)) &&
  115.     FreeQ[LaplaceTransform[ff, t, s, opt], LaplaceTransform])
  116.   ] /;  !FreeQ[{c}, t] && !FreeQ[x, t] && FreeQ[s,t]
  117.  
  118.  
  119. (* ============================== Linearity ================================ *)
  120.  
  121. LaplaceTransform[c_, t_Symbol, s_, opt___] := c/s /; FreeQ[{c, s}, t]
  122.  
  123. LaplaceTransform[c_ f_, t_Symbol, s_, opt___] :=
  124.     c LaplaceTransform[f, t, s, opt] /; FreeQ[{c, s}, t]
  125.  
  126. LaplaceTransform[x_Plus, t_Symbol, s_, opt___] :=
  127.       (LaplaceTransform[#, t, s, opt]& /@ x) /; FreeQ[s,t]
  128.  
  129. LaplaceTransform[x_Plus f_, t_Symbol, s_, opt___] :=
  130.     LaplaceTransform[Expand[x f], t, s, opt] /; FreeQ[s,t]
  131.  
  132. LaplaceTransform[Sum[f_, {i_, i1_, i2_}], t_Symbol, s_, opt___] :=
  133.     Sum[LaplaceTransform[f,t,s,opt],{i,i1,i2}] /; FreeQ[{i,i1,i2,s},t] &&
  134.                         FreeQ[i,s]
  135.  
  136. LaplaceTransform[f_Equal, t_Symbol, s_, opt___] :=
  137.     LaplaceTransform[#, t, s, opt]& /@ f    /; FreeQ[s,t]
  138.  
  139. LaplaceTransform[f:Power[x_Plus, _Integer?Positive], t_Symbol, s_, opt___] :=
  140.   Module[{ff = Expand[f]},
  141.     LaplaceTransform[ff, t, s, opt]
  142.   ] /; !FreeQ[x, t] && FreeQ[s,t]
  143.  
  144.  
  145. (* ========================= Other Rational Functions ====================== *)
  146.  
  147. LaplaceTransform[(c_ + b_.)^n_, t_Symbol, s_, ___] :=
  148.   Module[{a},
  149.     ( (Exp[b s/a]/a ( Gamma[n+1] (s/a)^(-n-1) -
  150.         b^(1+n) Hypergeometric1F1[1+n,2+n,-b s/a]/(1+n) )
  151.         // PowerExpand // Factor)
  152.     ) /; FreeQ[a = Factor[c]/t, t] && positive[a]
  153.   ] /; FreeQ[{b,n,s},t] && !FreeQ[c,t] && -1<n<0
  154.  
  155. LaplaceTransform[(c_ + b_)^n_Integer?Negative, t_Symbol, s_, ___] :=
  156.   Module[{k, a},
  157.     (   s^(-n-1) Exp[b s/a]ExpIntegralEi[-b s/a] / ((-n-1)! (-a)^(-n)) +
  158.        Sum[ (-1)^(k+n) (a^(k+n+1)/b^(k+1)) (k!/(-n-1)!) s^(-n-2-k), {k,0,-n-2}]
  159.     ) /; FreeQ[a = Factor[c]/t, t] && positive[a]
  160.   ] /; FreeQ[{b,s},t] && !FreeQ[c,t]
  161.  
  162. LaplaceTransform[1 /(d1_ + c1_), t_Symbol, s_, ___] :=
  163.   Module[{d, c},
  164.      ( c = Sqrt[If[SameQ[Head[c1], Plus], Map[-#&,c1], -c1] / d];
  165.        ExpIntegralEi[-c s]Exp[c s]/(2c d) - ExpIntegralEi[c s]Exp[-c s]/(2c d)
  166.      ) /; FreeQ[d = Factor[d1]/t^2, t] && positive[d]
  167.   ] /; FreeQ[{c1,s},t] && !FreeQ[d1,t] &&
  168.         (MatchQ[c1, a_?Negative b_. /; FreeQ[{a, b}, t]] ||
  169.             (SameQ[Head[c1], Plus] &&
  170.         Apply[And, Map[MatchQ[#, a_?Negative b_. /; FreeQ[{a, b}, t]]&,
  171.             Apply[List, c1]]]))
  172.  
  173. LaplaceTransform[(a_. t_+b_.)/(f_. t_^2+c_?Negative d_.), t_Symbol, s_, ___] :=
  174.   With[{e = Sqrt[-c d/f]}, 
  175.     -ExpIntegralEi[-e s]Exp[e s](a-b/e)/(2f) -
  176.       ExpIntegralEi[e s]Exp[-e s](a+b/e)/(2f) 
  177.   ] /; FreeQ[{a,b,c,d,f,s},t] && positive[f]
  178.  
  179. LaplaceTransform[1/(d_ + c_), t_Symbol, s_, ___] :=
  180.   Module[{a},
  181.     ( CosIntegral[Sqrt[c/a] s] Sin[Sqrt[c/a]s]/(Sqrt[a c]) +
  182.     (Pi/2-SinIntegral[Sqrt[c/a] s]) Cos[Sqrt[c/a]s]/(Sqrt[a c])
  183.     ) /; FreeQ[a = Factor[d]/t^2, t] && positive[a]
  184.   ] /; FreeQ[{c,s},t] && !FreeQ[d,t]
  185.  
  186. LaplaceTransform[(a_. t_+b_.)/(d_. t_^2+c_), t_Symbol, s_, ___] :=
  187.   -CosIntegral[Sqrt[c/d] s]((a/d) Cos[Sqrt[c/d]s] -
  188.     (b/Sqrt[c d])Sin[Sqrt[c/d]s]) +
  189.     (Pi/2-SinIntegral[Sqrt[c/d] s]) *
  190.     ((a/d) Sin[Sqrt[c/d]s]+(b/Sqrt[c d])Cos[Sqrt[c/d]s]) /;
  191.   FreeQ[{a, b, c, d, s}, t] && positive[d]
  192.  
  193.  
  194. (* ============================= Exponentials ============================== *)
  195.  
  196. LaplaceTransform[a_. Power[E, (b_.+ c_)], t_Symbol, s_, opt___] :=
  197.   Module[{d},
  198.      LaplaceTransform[a Exp[b], t, s-d, opt]
  199.      /; FreeQ[d = Factor[c]/t, t]
  200.   ] /; !FreeQ[c,t] && FreeQ[{b, s}, t]
  201.  
  202. LaplaceTransform[Exp[d_], t_Symbol, s_, ___] :=
  203.   Module[{c, c1},
  204.    ( c1 = Expand[-c]; 
  205.      2Sqrt[c1/s] BesselK[1, 2Sqrt[c1 s]]
  206.    ) /; FreeQ[c = Expand[d t], t] &&
  207.     (MatchQ[c, a_?Negative b_. /; FreeQ[{a, b}, t]] ||
  208.         (SameQ[Head[c], Plus] &&
  209.      Apply[And, Map[MatchQ[#, a_?Negative b_. /; FreeQ[{a, b}, t]]&, 
  210.         Apply[List, c]]]))
  211.   ] /; FreeQ[s, t] && !FreeQ[d, t]
  212.  
  213. LaplaceTransform[t_^n_. Exp[a_?Negative b_. / t_], t_Symbol, s_, ___] :=
  214.   With[{c = -a b},
  215.     2(c/s)^((n+1)/2) BesselK[n+1, 2 Sqrt[c s]] 
  216.   ] /; FreeQ[{a,b,n,s},t]
  217.  
  218. LaplaceTransform[Exp[d_], t_Symbol, s_, ___] :=
  219.   Module[{c, c1},
  220.     ( c1 = Expand[-c];   
  221.       Collect[
  222.     s^(-1)Exp[c1^2/(8s)]ParabolicCylinderD[-2, c1/Sqrt[2s]] // PowerExpand,
  223.         {Gamma[-1/2, 0, c1^2/(4 s^2)], Exp[c1^2/(8s)], Sqrt[Pi]} ]
  224.     )  /; (MatchQ[c = Factor[d]/Sqrt[t], a_?Negative b_. /; FreeQ[{a,b},t]] ||
  225.             (SameQ[Head[c], Plus] &&
  226.            Apply[And, Map[MatchQ[#, a_?Negative b_. /; FreeQ[{a, b}, t]]&,
  227.             Apply[List, c]]]))
  228.   ] /; !FreeQ[d,t] && FreeQ[s,t]
  229.  
  230. LaplaceTransform[t_^n_. Exp[a_?Negative b_. Sqrt[t_]], t_Symbol, s_, ___] :=
  231.   With[{c = -a b},
  232.     Collect[
  233.        2(2s)^(-n-1)Gamma[2(n+1)] Exp[c^2/(8s)] *
  234.          ParabolicCylinderD[-2(n+1), c/Sqrt[2s]] // PowerExpand,
  235.              {Exp[c^2/(8s)], Sqrt[Pi]}
  236.     ]
  237.   ] /; FreeQ[{a,b,n,s},t]
  238.  
  239. LaplaceTransform[Exp[a_?Negative b_. t_^2], t_Symbol, s_, ___] :=
  240.   With[{c = -a b},
  241.     (2 c)^(-1/2)Exp[s^2/(8c)] * ParabolicCylinderD[-1, s/Sqrt[2c]]
  242.   ] /; FreeQ[{a,b,s},t]
  243.  
  244. LaplaceTransform[t_^n_. Exp[a_?Negative b_. t_^2], t_Symbol, s_, ___] :=
  245.   Module[{c = -a b},
  246.     Collect[
  247.       (2 c)^(-(n+1)/2)Gamma[n+1] Exp[s^2/(8c)] *
  248.         ParabolicCylinderD[-(n+1), s/Sqrt[2c]] // PowerExpand // Expand,
  249.         {Exp[s^2/(8c)], Gamma[1/2,0,s^2/(4 c)], Sqrt[Pi]}
  250.     ]
  251.   ] /; FreeQ[{a,b,n,s},t]
  252.  
  253. LaplaceTransform[Exp[d_], t_Symbol, s_, ___] :=
  254.   Module[{c, c1},
  255.     ( c1 = Expand[-c];   
  256.       (c1)^s Gamma[-s, c1]
  257.     ) /; (MatchQ[c = Factor[d]/Exp[t], a_?Negative b_. /; FreeQ[{a,b},t]] ||
  258.             (SameQ[Head[c], Plus] &&
  259.         Apply[And, Map[MatchQ[#, a_?Negative b_. /; FreeQ[{a, b}, t]]&,
  260.             Apply[List, c]]]))
  261.   ] /; !FreeQ[d,t] && FreeQ[s,t]
  262.  
  263.  
  264. (* ========================= Logarithmic Functions ========================= *)
  265.  
  266. LaplaceTransform[Log[t_], t_Symbol, s_, ___] :=
  267.     -(EulerGamma+Log[s])/s /; FreeQ[s,t]
  268.                         
  269. LaplaceTransform[Log[a_+c_], t_Symbol, s_, ___] :=
  270.    Module[{b},
  271.     (Log[a]-Exp[a s/b]ExpIntegralEi[-a s/b])/s
  272.     /; FreeQ[b = Factor[c]/t, t]
  273.    ] /; !FreeQ[c,t] && FreeQ[{a,s},t]
  274.  
  275. LaplaceTransform[Log[t_]^2, t_Symbol, s_, ___] :=
  276.   (Pi^2/6+(EulerGamma+Log[s])^2)/s    /; FreeQ[s,t]
  277.  
  278. LaplaceTransform[Log[a_+t_^2], t_Symbol, s_, ___] :=
  279.   With[{aa = Sqrt[a]},
  280.     (2/s)(Log[aa]-CosIntegral[aa s]Cos[aa s]-
  281.       (SinIntegral[aa s]-Pi/2)Sin[aa s]) 
  282.   ] /; FreeQ[{a,s},t]
  283.  
  284. LaplaceTransform[t_^n_. Log[t_], t_Symbol, s_, ___] :=
  285.   Gamma[n+1]s^(-n-1)(PolyGamma[n+1]-Log[s]) /; FreeQ[{n,s},t]
  286.  
  287. LaplaceTransform[t_^n_. Log[t_]^2, t_Symbol, s_, ___] :=
  288.   Gamma[n+1]s^(-n-1)((PolyGamma[n+1]-Log[s])^2+PolyGamma[1,n+1]) /;
  289.     FreeQ[{n,s},t]
  290.  
  291.  
  292.  
  293. (* ====================== Products Involving Powers ======================= *)
  294.  
  295.  
  296. LaplaceTransform[a_ t_^n_., t_Symbol, s_, opt___] :=
  297.   Module[{ss},
  298.     ((-1)^n D[LaplaceTransform[a, t, ss, opt], {ss, n}] /. ss->s) 
  299.   ] /; IntegerQ[n] && n > 0 && FreeQ[s,t]
  300.  
  301. LaplaceTransform[a_ t_^(n_Integer?Negative), t_Symbol, s_, opt___] :=
  302.   Module[{ss},
  303.       DI[LaplaceTransform[a,t,ss,opt], s, ss, Infinity, -n] /. ss->s
  304.   ] /; FreeQ[s,t]
  305.  
  306.  
  307. (* ======================= Trigonometric Functions ======================= *)
  308.  
  309. LaplaceTransform[Sin[c_ + b_.], t_Symbol, s_, ___] :=
  310.   Module[{a},
  311.     (Cos[b] a + Sin[b] s)/(a^2+s^2) /; FreeQ[a = Factor[c]/t, t]
  312.   ] /; FreeQ[{b,s},t] && !FreeQ[c,t]
  313.  
  314. LaplaceTransform[Cos[c_ + b_.], t_Symbol, s_, ___] :=
  315.   Module[{a},
  316.     (Cos[b] s - Sin[b] a)/(a^2+s^2) /; FreeQ[a = Factor[c]/t, t]
  317.   ] /; FreeQ[{b,s},t] && !FreeQ[c,t]
  318.  
  319. (* ==================== Inverse Trigonometric Functions ==================== *)
  320.  
  321. LaplaceTransform[ArcTan[c_], t_Symbol, s_, ___] :=
  322.   Module[{a},
  323.     (CosIntegral[s/a]Sin[s/a]- (SinIntegral[s/a]-Pi/2)Cos[s/a])/s
  324.     /; FreeQ[a = Factor[c]/t, t]
  325.   ] /; FreeQ[s,t] && !FreeQ[c,t]
  326.  
  327. LaplaceTransform[ArcCot[c_], t_Symbol, s_, ___] :=
  328.   Module[{a},
  329.     ((Pi/2-CosIntegral[s/a])Sin[s/a] - (SinIntegral[s/a]-Pi/2)Cos[s/a])/s
  330.     /; FreeQ[a = Factor[c]/t, t] 
  331.   ] /; FreeQ[s,t] && !FreeQ[c,t]
  332.  
  333. (* ======================== Hyperbolic Functions =========================== *)
  334.  
  335. LaplaceTransform[Sinh[c_ + b_.], t_Symbol, s_, ___] :=
  336.   Module[{a},
  337.     (Cosh[b] a + Sinh[b] s)/(s^2 - a^2) /; FreeQ[a = Factor[c]/t, t]
  338.   ] /; FreeQ[{b,s},t] && !FreeQ[c,t]
  339.  
  340. LaplaceTransform[Cosh[c_ + b_.], t_Symbol, s_, ___] :=
  341.   Module[{a},
  342.     (Cosh[b] s + Sin[b] a)/(s^2 - a^2) /; FreeQ[a = Factor[c]/t, t]
  343.   ] /; FreeQ[{b,s},t] && !FreeQ[c,t]
  344.  
  345. LaplaceTransform[Tanh[c_], t_Symbol, s_, ___] :=
  346.   Module[{a},
  347.     (PolyGamma[1/2+s/(4a)]-PolyGamma[s/(4a)])/(2a) - 1/s
  348.     /; FreeQ[a = Factor[c]/t, t]
  349.   ] /; FreeQ[s,t] && !FreeQ[c,t]
  350.  
  351.  
  352. (* ====================== Derivatives and Integrals ======================== *)
  353.  
  354. LaplaceTransform[Derivative[n_Integer?Positive][f_][t_],
  355.   t_Symbol, s_, opt___] :=
  356.     Module[{zerolimit = ZeroLimit /. {opt} /. Options[LaplaceTransform], init},
  357.       (init = Limit[ Sum[s^i D[f[t], {t, n-1-i}], {i, 0, n-1}], t->0,
  358.         Direction->1];
  359.       If[zerolimit===Automatic && !FreeQ[init,Limit],
  360.         init = Sum[s^i (D[f[t], {t, n-1-i}] /. t->0), {i, 0, n-1}]
  361.       ];
  362.       s^n LaplaceTransform[f[t], t, s, opt] - init
  363.       ) /;  (zerolimit===Automatic || zerolimit===All)
  364.     ]  /; FreeQ[s,t]
  365.  
  366. LaplaceTransform[
  367.   Derivative[0, 0, n_Integer?Positive, ___]
  368.     [InverseLaplaceTransform][f_,s1_Symbol,t_Symbol,opt1___],
  369.     t_Symbol,s2_,opt2___] :=
  370.   Module[{zerolimit = ZeroLimit /. {opt2} /. Options[LaplaceTransform], init},
  371.     (init = Limit[ Sum[ (s1^i /. s1->s2) *
  372.         D[InverseLaplaceTransform[f,s1,t,opt1], {t, n-1-i}],
  373.         {i, 0, n-1}], t->0, Direction->1];
  374.     If[zerolimit===Automatic && !FreeQ[init,Limit],
  375.       init = Sum[ (s1^i /. s1->s2) *
  376.         (D[InverseLaplaceTransform[f,s1,t,opt1], {t, n-1-i}] /. t->0),
  377.         {i, 0, n-1}]
  378.     ];
  379.     ((s1^n f) /. s1->s2) - init
  380.     ) /; (zerolimit===Automatic || zerolimit===All)
  381.   ] /; FreeQ[{f,s1,s2},t] 
  382.  
  383. LaplaceTransform[Integrate[f_, {tt_Symbol, 0, t_}], t_Symbol, s_, opt___] :=
  384.   LaplaceTransform[f /. tt->t, t, s, opt] / s /; FreeQ[s,t]
  385.  
  386.  
  387. (* =============== LaplaceTransform of InverseLaplaceTransform ============= *)
  388.  
  389. LaplaceTransform[InverseLaplaceTransform[f_, s_Symbol, t_, ___],
  390.   t_Symbol, s1_, ___] :=
  391.     (f /. s->s1) /; FreeQ[s1,t]
  392.  
  393. (* ======================== Composed Function Case ========================= *)
  394.  
  395. LaplaceTransform[f_, t_Symbol, s_, opt___] :=
  396.   Module[{g = ComposedFunctionQ[f, t]},
  397.       With[{a = g[[1]]/t},
  398.     LaplaceTransform[f /. g[[1]]->t, t, s/a, opt] / a
  399.       ] /; (SameQ @@ g && MatchQ[g[[1]], _Times]) 
  400.   ] /; FreeQ[s,t] &&
  401.        !Apply[Or, Map[(MatchQ[#[[1]], c1_. + c2_. t /; negative[c2]])&,
  402.               Cases[f, UnitStep[_, ___Rule], Infinity] ]] 
  403.  
  404. LaplaceTransform[f_ UnitStep[t_ + b_, r___Rule], t_Symbol, s_, opt___] :=
  405.   Module[{g1 = ComposedFunctionQ[f, t], g, f1, tau},
  406.       With[{a = g[[1]] - t},
  407.     LaplaceTransform[(f1 /. tau -> t), t, s, opt] Exp[b s] 
  408.       ] /; g1 =!= False &&
  409.        (g1 = Union[g1, {t+b}];
  410.         g = Select[g1, Head[#] === Plus&];
  411.         g =!= {} && SameQ @@ g) &&
  412.       FreeQ[f1 = (f /. {t+b :> tau, -(t+b) :> -tau}), t]
  413.   ] /; FreeQ[{b, s}, t] && FreeQ[f, UnitStep]
  414.  
  415. LaplaceTransform[f_, t_Symbol, s_, opt___] :=
  416.   Module[{g1 = ComposedFunctionQ[f, t],
  417.       g, f1, tau, integrand, term, z, cases, k},
  418.     With[{a = g[[1]] - t},
  419.       f1 = f1 //. tau -> t;
  420.       integrand = (f1 Exp[-s t]) (* //. {Exp[x_] :> Exp[Collect[x, t]] /;
  421.                      PolynomialQ[x, t]} *);
  422.       term = LaplaceTransform[f1, t, s, opt] +
  423.          (Integrate[integrand, {t, a, 0}] //. {Power[y_, n_?EvenQ] :> z
  424.         /; !FreeQ[y^n, Complex] && FreeQ[z = Factor[y^n], Complex]});
  425.       term  = term //.
  426.     {(d_ + c1_?ComplexQ)^n_. (d_ + c2_?ComplexQ)^n_. :>
  427.         ((d + Re[c1])^2 + Im[c1]^2)^n /;
  428.         c1 == Conjugate[c2] && FreeQ[d, Complex],
  429.      (d_ + c1_?ComplexQ)^n_. (-d_ + c2_?ComplexQ)^n_. :>    
  430.         -((d + Re[c1])^2 + Im[c1]^2)^n /;
  431.         c1 == Conjugate[-c2] && FreeQ[d, Complex]};
  432.  
  433.       term = term //.
  434.     {e1_. (c_. + d1_)^n_Integer?Negative +
  435.      e2_. (c_. + d2_)^n_Integer?Negative :> 0 /;
  436.      Together[e1(c+d1)^n + e2(c+d2)^n] == 0};
  437.  
  438.       If[Length[cases = Cases[term, Exp[_], Infinity]] > 1 && SameQ @@ cases,
  439.     term = Collect[term, cases[[1]]]];
  440.       If[Length[cases = Cases[term, Power[_, _?Negative], Infinity]] > 1 &&
  441.     SameQ @@ cases,
  442.       term = Factor[term //. {cases[[1]] :> k}] //. {k :> cases[[1]]}];
  443.       ( Exp[a s] term ) //. {Exp[x_] :> Exp[Simplify[x]]}
  444.       ] /; g1 =!= False &&
  445.        (g = Select[g1, Head[#] === Plus&]; g =!= {} && SameQ @@ g) &&
  446.        FreeQ[f1 = (f /. {g[[1]] -> tau}), t]
  447.   ] /; FreeQ[s,t] && FreeQ[f, UnitStep] && FreeQ[f, DiracDelta]
  448.  
  449.  
  450. (* ======================== Using the Definition ========================== *)
  451.  
  452. LaplaceTransform[f_, t_Symbol, s_, opt___] :=
  453.   Module[{transform =
  454.        (If[!SameQ[Head[s], DirectedInfinity],
  455.            If[!FreeQ[f, DiracDelta],
  456.           Module[{indefint = Integrate[Exp[-s t] f, t], defint},
  457.             If[!FreeQ[indefint, Integrate],
  458.                $Failed,
  459.                If[!FreeQ[(defint = Limit[indefint, t->Infinity] -
  460.                   Limit[indefint, t->0, Direction->1]), Limit],
  461.               $Failed,
  462.               defint]
  463.             ]
  464.           ],
  465.               Integrate[Exp[-s t] f, {t,0,Infinity}]
  466.            ],
  467.            Indeterminate])},
  468.     transform /; Apply[And, Map[FreeQ[transform,#]&,
  469.         {$Failed,Integrate,Infinity,Indeterminate}]]
  470.   ] /; FreeQ[s,t] && FreeQ[Map[Context,
  471.                    Select[Variables[s], MatchQ[Head[#], Symbol]&]],
  472.                "Integrate`"]
  473.  
  474.  
  475. (* ================== Derivative of LaplaceTransform ======================= *)
  476.  
  477. Unprotect[D, Derivative]
  478.  
  479.     (*** Derivative of LaplaceTransform, Linearity ***)
  480.  
  481. Literal[D[x_Plus,y_Symbol]] := Map[D[#,y]&,x] /; !FreeQ[x,LaplaceTransform]
  482.  
  483. Literal[D[x_Plus,{y_Symbol,n_Integer?Positive}]] := Map[D[#,{y,n}]&,x] /;
  484.                         !FreeQ[x,LaplaceTransform]
  485.  
  486. Literal[D[x_Times,y_Symbol]] :=
  487.     Module[{e = Expand[x]},
  488.         D[e,y] /; !SameQ[x,e]
  489.     ]    /;    !FreeQ[x,LaplaceTransform]
  490.  
  491. Literal[D[x_Times,{y_Symbol,n_Integer?Positive}]] :=
  492.     Module[{e = Expand[x]},
  493.         D[e,{y,n}] /; !SameQ[x,e]
  494.     ]    /; !FreeQ[x,LaplaceTransform]
  495.  
  496. Derivative[0,0,m_Integer?Positive][LaplaceTransform][f_, t_Symbol, s_] :=
  497.     Module[{laplace, s1},
  498.        (D[laplace, {s1, m}] /. s1->s)
  499.        /; FreeQ[laplace = LaplaceTransform[f, t, s1], LaplaceTransform]
  500.     ] /; FreeQ[s, t]
  501.  
  502. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, 
  503.     t_Symbol,s_,opt__] :=
  504.     Module[{laplace, s1},
  505.        (D[laplace, {s1, m}] /. s1->s)
  506.        /; FreeQ[laplace = LaplaceTransform[f, t, s1], LaplaceTransform]
  507.     ] /; ((Length[{z}] == Length[{opt}]) && FreeQ[s,t])
  508.  
  509.  
  510.     (*** Derivative of LaplaceTransform wrt s ***)
  511.  
  512. Literal[D[LaplaceTransform[f_,t_Symbol,s_,opt__],s_Symbol]] :=
  513.   Apply[Derivative,Join[{0,0,1},
  514.     Table[0,{Length[{opt}]}]]][LaplaceTransform][f,t,s,opt] /; FreeQ[s,t]
  515.  
  516. Literal[D[LaplaceTransform[f_,t_Symbol,s_,opt__],
  517.   {s_Symbol,n_Integer?Positive}]] :=
  518.     Apply[Derivative,Join[{0,0,n},
  519.      Table[0,{Length[{opt}]}]]][LaplaceTransform][f,t,s,opt] /; FreeQ[s,t]
  520.  
  521.  
  522.     (*** Derivative of LaplaceTransform wrt t ***)
  523.  
  524. Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___],t_]] :=
  525.     D[u,t] LaplaceTransform[f,t,s,opt] /; FreeQ[u,LaplaceTransform] &&
  526.                                 FreeQ[s,t]
  527.  
  528. Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___],
  529.     {t_,n_Integer?Positive}]] :=
  530.     D[u,{t,n}] LaplaceTransform[f,t,s,opt] /; FreeQ[u,LaplaceTransform] &&
  531.                                 FreeQ[s,t]
  532.  
  533.     (*** Derivative of LaplaceTransform wrt x (!=t, !=s) ***)
  534.  
  535. Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___],x_Symbol]] :=
  536.    u LaplaceTransform[D[f,x] - f D[s,x] t,t,s,opt] + 
  537.     D[u,x] LaplaceTransform[f,t,s,opt]  /;  FreeQ[u,LaplaceTransform] &&
  538.                 !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t]
  539.  
  540. Literal[D[u_. LaplaceTransform[f_,t_Symbol,s_,opt___],
  541.   {x_Symbol,n_Integer?Positive}]] :=
  542.     Nest[D[#,x]&, u LaplaceTransform[f,t,s,opt], n] /;
  543.                 !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t]
  544.  
  545.     (*** Derivative of Derivative of Laplace wrt s (with options) ***)
  546.  
  547. Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_,
  548.             t_Symbol,s_Symbol,opt__],
  549.       s_]] := 
  550.     u Derivative[0,0,m+1,z][LaplaceTransform][f,t,s,opt] +
  551.     D[u,s] Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt] /;
  552.      (Length[{z}] == Length[{opt}]) && FreeQ[u,LaplaceTransform] && FreeQ[s,t]
  553.  
  554. Literal[D[Derivative[0,0,m1_Integer?Positive,z1:(0)..][LaplaceTransform][f1_, 
  555.             t1_Symbol,s_Symbol,opt1__] *
  556.           Derivative[0,0,m2_Integer?Positive,z2:(0)..][LaplaceTransform][f2_,
  557.                 t2_Symbol,s_Symbol,opt2__],
  558.           s_]] :=
  559.     Derivative[0,0,m1,z1][LaplaceTransform][f1,t1,s,opt] *
  560.         Derivative[0,0,m2+1,z2][LaplaceTransform][f2,t2,s,opt] +
  561.     Derivative[0,0,m1+1,z1][LaplaceTransform][f1,t1,s,opt] *
  562.         Derivative[0,0,m2,z2][LaplaceTransform][f2,t2,s,opt] /;
  563.     (Length[{z1}] == Length[{opt1}]) && (Length[{z2}] == Length[{opt2}]) &&
  564.                         FreeQ[s,t1] && FreeQ[s,t2]
  565.  
  566. Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_,
  567.             t_Symbol,s_Symbol,opt__],
  568.       {s_,n_Integer?Positive}]] :=
  569.     Nest[D[#,s]&, u Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt], n] /;
  570.         (Length[{z}] == Length[{opt}]) && FreeQ[s,t]
  571.  
  572.     (*** Derivative of Derivative of Laplace wrt t ***)
  573.  
  574. Literal[D[u_. Derivative[0,0,m_Integer?Positive][LaplaceTransform][f_,
  575.             t_Symbol,s_],
  576.     t_]] :=  D[u,t] Derivative[0,0,m][LaplaceTransform][f,t,s] /;
  577.                 FreeQ[u,LaplaceTransform] && FreeQ[s,t]
  578.  
  579. Literal[D[u_. Derivative[0,0,m_Integer?Positive][LaplaceTransform][f_,
  580.             t_Symbol,s_],
  581.     {t_,n_Integer?Positive}]] :=
  582.     Nest[D[#,t]&, u Derivative[0,0,m][LaplaceTransform][f,t,s], n]  /;
  583.                                 FreeQ[s,t]
  584.  
  585. Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_,
  586.             t_Symbol,s_,opt__],
  587.     t_]] :=  D[u,t] Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt] /;
  588.       (Length[{z}] == Length[{opt}]) && FreeQ[u,LaplaceTransform] && FreeQ[s,t]
  589.  
  590. Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_,
  591.             t_Symbol,s_,opt__],
  592.     {t_,n_Integer?Positive}]] :=
  593.     Nest[D[#,t]&, u Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt], n] /;
  594.         (Length[{z}] == Length[{opt}]) && FreeQ[s,t]
  595.  
  596.     (*** Derivative of Derivative of Laplace wrt x (!=t, !=s) ***)
  597.  
  598. Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_,
  599.             t_Symbol,s_,opt__],
  600.     x_Symbol]] :=  D[u,x] Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt] +
  601.         u (Derivative[0,0,m,z][LaplaceTransform][D[f,x],t,s,opt] +
  602.         D[s,x] Derivative[0,0,m+1,z][LaplaceTransform][f,t,s,opt]) /;
  603.     (Length[{z}] == Length[{opt}]) && FreeQ[u,LaplaceTransform] &&
  604.                 !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t]
  605.  
  606. Literal[D[Derivative[0,0,m1_Integer?Positive,z1:(0)..][LaplaceTransform][f1_, 
  607.             t1_Symbol,s1_,opt1__] *
  608.           Derivative[0,0,m2_Integer?Positive,z2:(0)..][LaplaceTransform][f2_,
  609.                 t2_Symbol,s2_,opt2__],
  610.           x_Symbol]] :=
  611.     (Derivative[0,0,m1,z1][LaplaceTransform][D[f1,x],t1,s1,opt] +
  612.      D[s1,x] * Derivative[0,0,m1+1,z1][LaplaceTransform][f1,t1,s1,opt])*
  613.         Derivative[0,0,m2,z2][LaplaceTransform][f2,t2,s2,opt] +
  614.     (Derivative[0,0,m2,z2][LaplaceTransform][D[f2,x],t2,s2,opt] +
  615.      D[s2,x] * Derivative[0,0,m1+1,z2][LaplaceTransform][f2,t2,s2,opt])*
  616.         Derivative[0,0,m1,z1][LaplaceTransform][f1,t1,s1,opt] /;
  617.     (Length[{z1}] == Length[{opt1}]) && (Length[{z2}] == Length[{opt2}]) &&
  618.         !(SameQ[x,t1] || SameQ[x,t2] || SameQ[x,s1] || SameQ[x,s2]) &&
  619.                     FreeQ[s1,t1] && FreeQ[s2,t2]
  620.  
  621. Literal[D[u_. Derivative[0,0,m_Integer?Positive,z:(0)..][LaplaceTransform][f_, 
  622.             t_Symbol,s_,opt__],
  623.     {x_Symbol,n_Integer?Positive}]] :=   
  624.     Nest[D[#,x]&, u Derivative[0,0,m,z][LaplaceTransform][f,t,s,opt], n] /;
  625.     (Length[{z}] == Length[{opt}]) && !(SameQ[x,t] || SameQ[x,s]) && FreeQ[s,t]
  626.  
  627. Protect[D, Derivative]
  628.  
  629.  
  630. (************************************************************************)
  631. (*                      Inverse Laplace Transform                       *) 
  632. (************************************************************************)
  633.  
  634. (* =========================== Using Apart =============================== *)
  635.  
  636. InverseLaplaceTransform[f:Power[x_, n_?Negative], s_Symbol, t_, opt___] :=
  637.   Module[{ff = Chop[Apart[Factor[f], s]]},
  638.     InverseLaplaceTransform[ff, s, t, opt] /; SameQ[Head[ff],Plus] ||
  639.         (SameQ[Head[ff],Power] && ff[[2]] != n)
  640.   ] /; !FreeQ[x, s] && FreeQ[t,s]
  641.  
  642. InverseLaplaceTransform[f:Times[c__, Power[x_, n_?Negative]],
  643.   s_Symbol, t_, opt___] :=
  644.   Module[{ff = Chop[Apart[Factor[f], s]]},
  645.     InverseLaplaceTransform[ff, s, t, opt] /; SameQ[Head[ff],Plus] ||
  646.       (SameQ[Head[Denominator[ff]],Power] && Denominator[ff][[2]] != -n)
  647.   ] /; !FreeQ[{c},s] && !FreeQ[x, s] && FreeQ[t,s]
  648.  
  649. InverseLaplaceTransform[f_, s_Symbol, t_, opt___] :=
  650.   Module[{num = Numerator[f], den = Denominator[f],
  651.       ff = Chop[Apart[Factor[f, GaussianIntegers->True],s]]},
  652.     ((InverseLaplaceTransform[ff,s,t,opt] // Expand) //. ExpRules2) /;
  653.            (!FreeQ[den,s] && PolynomialQ[num,s] && PolynomialQ[den,s] &&
  654.         Exponent[den,s]>0 && !(Exponent[num,s]<Exponent[den,s]<3) &&
  655.         (SameQ[Head[ff],Plus] || (SameQ[Head[Denominator[ff]],Power] &&
  656.             Denominator[ff][[2]] != den[[2]])) )
  657.   ] /; !FreeQ[f,s] &&
  658.         (SameQ[Head[f],Times] || SameQ[Head[f],Power]) && FreeQ[t,s]
  659.  
  660. (* ============================ Linearity ================================ *)
  661.  
  662. InverseLaplaceTransform[c_, s_Symbol, t_, opt___] := c DiracDelta[t] /;
  663.                             FreeQ[{c,t}, s]
  664.  
  665. InverseLaplaceTransform[c_ f_, s_Symbol, t_, opt___] :=
  666.     c InverseLaplaceTransform[f, s, t, opt] /; FreeQ[{c,t}, s]
  667.  
  668. InverseLaplaceTransform[x_Plus, s_Symbol, t_, opt___] :=
  669.     InverseLaplaceTransform[#, s, t, opt]& /@ x /; FreeQ[t,s]
  670.  
  671. InverseLaplaceTransform[a_Plus b_, s_Symbol, t_, opt___] :=
  672.       InverseLaplaceTransform[Expand[a b], s, t, opt] /; FreeQ[t,s]
  673.  
  674. InverseLaplaceTransform[Sum[f_,{i_,i1_,i2_}], s_Symbol, t_, opt___] :=
  675.     Sum[InverseLaplaceTransform[f,s,t,opt],
  676.         {i,i1,i2}] /; FreeQ[{i,i1,i2,t},s] && FreeQ[i,t]
  677.  
  678. InverseLaplaceTransform[f_Equal,s_Symbol,t_,opt___] :=
  679.     InverseLaplaceTransform[#, s, t, opt]& /@ f /; FreeQ[t,s]
  680.  
  681. InverseLaplaceTransform[f:Power[x_Plus, _Integer?Positive],
  682.   s_Symbol, t_, opt___] :=
  683.     Module[{ff = Expand[f]},
  684.     InverseLaplaceTransform[ff, s, t, opt]
  685.     ] /; !FreeQ[x, s] && FreeQ[t,s]
  686.  
  687. (* ======================= Other Rational Functions ======================= *)
  688.  
  689. InverseLaplaceTransform[s_^n_., s_Symbol, t_, opt___] :=
  690.   Module[{tt},
  691.       D[DiracDelta[tt],{tt,n}] /. tt->t
  692.   ]  /; IntegerQ[n] && Positive[n] && FreeQ[t,s]
  693.  
  694. InverseLaplaceTransform[s_^c1_, s_Symbol, t_, opt___] :=
  695.   With[{p = If[SameQ[Head[c1],Plus], Map[-#&,c1], -c1]},
  696.     (t^(p-1) / Gamma[p])
  697.   ] /; FreeQ[{c1, t}, s]  &&
  698.         (MatchQ[c1, n1_?Negative n2_. /; FreeQ[{n1,n2},s]] ||
  699.         (SameQ[Head[c1],Plus] &&
  700.        Apply[And, Map[MatchQ[#, n1_?Negative n2_. /; FreeQ[{n1,n2},s]]&,
  701.         Apply[List,c1]]]))
  702.  
  703. SqrtRule = {
  704.              Sqrt[x_?Negative] :> I Sqrt[-x],
  705.              1/Sqrt[x_?Negative] :> -I / Sqrt[-x]
  706.            }
  707.  
  708. ExpRules1 = {
  709.            Exp[x_. + Complex[r_, i_] y_.] :>
  710.                Expand[Exp[x + r y](Cos[i y] + I Sin[i y])],
  711.            Exp[x_] :>
  712.            Exp[Expand[x]] /; !SameQ[x,Expand[x]]
  713.            }
  714.  
  715. ExpRules2 = {
  716.        a1_. Exp[Complex[r_,i1_] t_.] + a2_. Exp[Complex[r_,i2_] t_.] :>
  717.            2 a1 I Sin[i1 t] Exp[r t] /; a1+a2==0 && i1+i2==0 && i1>0,
  718.        a_. Exp[Complex[r_,i1_] t_.] + a_. Exp[Complex[r_,i2_] t_.] :>
  719.            2 a Cos[i1 t] Exp[r t] /; i1+i2==0,
  720.        a1_. Exp[(-1)^b1_Rational t_.] + a2_. Exp[(-1)^b2_Rational t_.] :>
  721.            2 a1 I Sin[Sin[b1 Pi] t] Exp[Cos[b1 Pi] t] /;
  722.            a1+a2==0 && Mod[b1+b2,2]==0 && Mod[b1,2]<1,
  723.        a_. Exp[(-1)^b1_Rational t_.] + a_. Exp[(-1)^b2_Rational t_.] :>
  724.            2 a Cos[Sin[b1 Pi] t] Exp[Cos[b1 Pi] t] /; Mod[b1+b2,2]==0,
  725.        a1_. Exp[b1_. t_.] + a2_. Exp[b2_. t_.] :>
  726.         2 a1 Sinh[b1 t] /;
  727.             NumberQ[b1] && NumberQ[b2] && a1+a2==0 && b1+b2==0 &&
  728.             FreeQ[{b1,b2},Complex] && b1>0,
  729.        a_. Exp[b1_] + a_. Exp[b2_] :>
  730.         2 a Cosh[b1] /; b1+b2==0 && FreeQ[{b1,b2},Complex],
  731.        a_. Complex[re1_,im1_] Exp[(-1)^b1_Rational t_.] +
  732.         a_. Complex[re2_,im2_] Exp[(-1)^b2_Rational t_.] :>
  733.             a(re1 Exp[(-1)^b1 t] + re2 Exp[(-1)^b2 t]) +
  734.             a I(im1 Exp[(-1)^b1 t] + im2 Exp[(-1)^b2 t]) /;
  735.             ((Abs[re1] == Abs[re2] == Abs[im1] == Abs[im2]) &&
  736.             Mod[b1+b2,2]==0)
  737.         }
  738.  
  739. InverseLaplaceTransform[1/(a1_ + b1_ + c_.), s_Symbol, t_, opt___] :=
  740.   Module[{x, a, b, re, im},
  741.     ( v = ((x /. Solve[a x^2+b x+c==0, x]) /. SqrtRule);
  742.       ExpandAll[
  743.         If[SameQ @@ v,
  744.             t Exp[v[[1]] t],
  745.             If[SameQ[Head[v[[1]]],Complex],
  746.                {re,im} = {Re[v[[1]]],Im[v[[1]]]};
  747.                Exp[re t] Sin[im t]/im,
  748.                (Exp[v[[1]] t]-Exp[v[[2]] t])/(a (v[[1]]-v[[2]]))
  749.             ]
  750.         ] /. Exp[xx:Times[_Plus, __]] :> Exp[Expand[xx]] //. ExpRules1
  751.      ]
  752.    ) /; FreeQ[a = Factor[a1]/s^2, s] && FreeQ[b = Factor[b1]/s, s]
  753.   ] /; FreeQ[{c,t},s] && !FreeQ[a1,s] && !FreeQ[b1,s] 
  754.  
  755. InverseLaplaceTransform[1/(s_^2+c_?Negative b_.), s_Symbol, t_, opt___] :=
  756.   With[{a = Sqrt[-b c]},
  757.     Sinh[a t]/a 
  758.   ] /; FreeQ[{b,c,t},s]
  759.  
  760. InverseLaplaceTransform[1/(s_^2+b_), s_Symbol, t_, opt___] :=
  761.   Module[{a = Sqrt[b]},
  762.     Sin[a t]/a 
  763.   ] /; FreeQ[{b,t},s]
  764.  
  765. InverseLaplaceTransform[1/(d_ + b_), s_Symbol, t_, opt___] :=
  766.     Module[{k, a, c, temp, n = Exponent[d,s]},
  767.         a = Coefficient[d, s, n];
  768.         c = b/a;
  769.         temp = Expand[
  770.             (-1/(b n)) Sum[
  771.             Module[{z = If[TrueQ[c<0],
  772.                            (-c)^(1/n) Exp[I Pi 2k/n],
  773.                        (c)^(1/n) Exp[I Pi (2k+1)/n]]},
  774.                 z Exp[z t]
  775.             ], {k,0,n-1}] //. ExpRules1
  776.           ];
  777.         temp //. ExpRules2
  778.     ] /; FreeQ[{b,t},s] && !FreeQ[d,s] &&
  779.         MatchQ[Factor[d], a_. s^n_Integer?Positive /; FreeQ[a,s]]
  780.  
  781. InverseLaplaceTransform[Sqrt[s_+b_.]/(s_+a_.), s_Symbol, t_, opt___] :=
  782.   Exp[-b t]/Sqrt[Pi t] + Sqrt[b-a] Exp[-a t] Erf[Sqrt[(b-a)t]] /;
  783.     FreeQ[{a, b, t}, s]
  784.  
  785. InverseLaplaceTransform[1/Sqrt[s_+a_.]/Sqrt[s_+b_.], s_Symbol, t_, opt___] :=
  786.   Exp[-(a+b)t/2] BesselI[0, (a-b)t/2] /; FreeQ[{a,b,t},s]
  787.  
  788. InverseLaplaceTransform[(s_+a_.)^(-1/2)(s_+b_.)^(-3/2),
  789.   s_Symbol, t_, opt___] :=
  790.     t Exp[-(a+b)t/2] (BesselI[0, (a-b)t/2] +
  791.             BesselI[1, (a-b)t/2]) /; FreeQ[{a,b,t},s]
  792.  
  793. InverseLaplaceTransform[Sqrt[s_+a_.]/(s_+b_.)^(3/2), s_Symbol, t_, opt___] :=
  794.   Exp[-(a+b)t/2]((1+(a-b)t)BesselI[0, (a-b)t/2] +
  795.          (a-b)t BesselI[1, (a-b)t/2]) /; FreeQ[{a,b,t},s]
  796.  
  797. InverseLaplaceTransform[(a1_+b1_+c_.)^Rational[k_Integer?Negative, 2],
  798.     s_Symbol,t_,opt___] :=
  799.   Module[{a, b},
  800.     ( InverseLaplaceTransform[
  801.         ((s + b / (2 a))^2 + (4 a c - b^2) / (4 a))^(k/2),
  802.         s, t, opt] / a
  803.     ) /; FreeQ[a = Factor[a1]/s^2, s] && FreeQ[b = Factor[b1]/s, s]
  804.   ] /; FreeQ[{c,t},s] && !FreeQ[a1,s] && !FreeQ[b1,s] 
  805.  
  806. InverseLaplaceTransform[(d1_ + b1_)^Rational[k_Integer?Negative, 2],
  807.        s_Symbol,t_,opt___] :=
  808.   Module[{n = -k/2-1/2, d, a},
  809.     ( a = Sqrt[-b1/d];
  810.       t^n BesselI[n, a t]/(If[n==0, 1, (2n-1)!!] a^n d) 
  811.     ) /; FreeQ[d = Factor[d1]/s^2, s] 
  812.   ] /; FreeQ[{b1, t}, s] && !FreeQ[d1, s] &&
  813.     (MatchQ[b1, b_?Negative c_. /; FreeQ[{b,c}, s]] ||
  814.         (SameQ[Head[b1], Plus] &&
  815.          Apply[And, Map[MatchQ[#, b_?Negative c_. /; FreeQ[{b,c}, s]]&,
  816.         Apply[List, b1]]]))
  817.  
  818. InverseLaplaceTransform[(d1_ + c_)^Rational[k_Integer?Negative, 2],
  819.   s_Symbol, t_, opt___] :=
  820.     Module[{n = -k/2-1/2, d, a},
  821.      ( a = Sqrt[c/d];
  822.        t^n BesselJ[n, a t]/(If[n==0, 1, (2n-1)!!] a^n d)
  823.      ) /; FreeQ[d = Factor[d1]/s^2, s]  
  824.     ] /; FreeQ[{c, t}, s] && !FreeQ[d1, s]
  825.  
  826. InverseLaplaceTransform[
  827.     (a1_ + b1_)^n_., s_Symbol, t_, opt___] :=
  828.   Module[{a, c, b, d},
  829.      (a^n) InverseLaplaceTransform[(s + (b Sqrt[c] / a) Sqrt[s^2 + d/c])^n,
  830.     s, t, opt]
  831.     /; (FreeQ[a = Factor[a1]/s, s] && 
  832.          MatchQ[Factor[b1], b2_. Sqrt[c1_ + d2_] /; (FreeQ[b = b2, s] &&
  833.        FreeQ[d = d2, s] && FreeQ[c = Factor[c1]/s^2, s] &&
  834.        (a =!= 1 || c =!= 1))] )
  835.   ] /; FreeQ[{n, t}, s]
  836.  
  837. InverseLaplaceTransform[
  838.     (s_ - Sqrt[s_^2 + c1_?Negative c2_.])^n_., s_Symbol, t_, opt___] :=
  839.   (n/t) Sqrt[-c1 c2]^n BesselI[n, Sqrt[-c1 c2] t] /; FreeQ[{c1, c2, n, t}, s]
  840.  
  841. InverseLaplaceTransform[(s_ - Sqrt[s_^2 + c_])^n_., s_Symbol, t_, opt___] :=
  842.   (-1)^n (n/t) Sqrt[c]^n BesselJ[n, Sqrt[c] t] /; FreeQ[{c, n, t}, s]
  843.  
  844. InverseLaplaceTransform[(c1_ + b3_)^(n3_), s_Symbol, t_, opt___] :=
  845.   Module[{c, a, n = -n3},
  846.     ( a = PowerExpand[Sqrt[Expand[-b3]/c]];
  847.       Collect[
  848.            (Sqrt[Pi] (2a)^(1/2-n) / Gamma[n] t^(n-1/2) BesselI[n-1/2, a t] / c^n)
  849.     // PowerExpand // Expand,
  850.         {Cosh[a t], Sinh[a t]}
  851.       ] ) /; FreeQ[c = Factor[c1]/s^2, s] && positive[c]
  852.   ] /; FreeQ[{b3, n3, t}, s] && !FreeQ[c1, s] &&
  853.     (MatchQ[b3, b1_?Negative b2_.] || (SameQ[Head[b3], Plus] &&
  854.      Apply[And, Map[MatchQ[#, b1_?Negative b2_.]&, Apply[List, b3]]])) &&
  855.         (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  856.      Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  857.  
  858. InverseLaplaceTransform[(c1_ + b_)^(n3_), s_Symbol, t_, opt___] :=
  859.    Module[{c, a, n = -n3},
  860.      ( a = PowerExpand[Sqrt[b/c]];
  861.        Collect[
  862.         (Sqrt[Pi] (2a)^(1/2-n) / Gamma[n] t^(n-1/2) BesselJ[n-1/2, a t] / c^n)
  863.        // PowerExpand // Expand,
  864.         {Cos[a t], Sin[a t]}
  865.        ]
  866.      ) /; FreeQ[c = Factor[c1]/s^2, s] 
  867.    ] /; FreeQ[{b, n3, t}, s] && !FreeQ[c1, s] &&
  868.      (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  869.       Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  870.  
  871.  
  872. (* ============================== Exponentials ============================== *)
  873.  
  874. InverseLaplaceTransform[f_. Exp[c_ + b_.], s_Symbol, t_, opt___] :=
  875.   Module[{a},
  876.     Exp[b] (InverseLaplaceTransform[f, s, t, opt] /. t -> t+a) UnitStep[t+a]
  877.         /; FreeQ[a = Factor[c]/s, s]
  878.   ] /; FreeQ[{b,t}, s] && !FreeQ[c,s] 
  879.  
  880. InverseLaplaceTransform[Exp[a3_ + b_.], s_Symbol, t_, opt___] :=
  881.     Module[{a, a4},
  882.       ( a = -a4;
  883.         Expand[Exp[b] (DiracDelta[t] - Sqrt[a/t] BesselJ[1, 2 Sqrt[a t]])]
  884.       ) /; FreeQ[a4 = Factor[a3] s, s] &&
  885.        (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] &&
  886.         Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, a4]]]))
  887.     ] /;  FreeQ[{b, t}, s] && !FreeQ[a3, s]
  888.  
  889. InverseLaplaceTransform[Exp[a1_ + b_.], s_Symbol, t_, opt___] :=
  890.   Module[{a},
  891.       Exp[b] (Sqrt[a/t] BesselI[1, 2 Sqrt[a t]] + DiracDelta[t])
  892.      /; FreeQ[a = Factor[a1] s, s]
  893.   ] /; FreeQ[{b, t}, s]
  894.  
  895. InverseLaplaceTransform[s_^(n3_) Exp[a3_ + b_.], s_Symbol, t_, opt___] :=
  896.   Module[{n = -n3 - 1, a, a4},
  897.     ( a = -a4;
  898.           Exp[b] (t/a)^(n/2) BesselJ[n, 2Sqrt[a t]]
  899.     ) /; FreeQ[a4 = Factor[a3] s, s] &&
  900.      (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] &&
  901.       Apply[And, Map[MatchQ[#, a1_?Negative a2_.]&, Apply[List, a4]]]))
  902.   ] /; FreeQ[{n3, b, t}, s] && !FreeQ[a3, s]
  903.     (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  904.      Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  905.  
  906. InverseLaplaceTransform[s_^(n3_) Exp[a3_ + b_], s_Symbol, t_, opt___] :=
  907.   Module[{a, n = -n3 - 1},
  908.       Exp[b] (t/a)^(n/2) BesselI[n, 2Sqrt[a t]]
  909.      /; FreeQ[a = Factor[a3] s, s]
  910.   ] /; FreeQ[{n3, b, t}, s] && !FreeQ[a3, s]
  911.     (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  912.      Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  913.  
  914. InverseLaplaceTransform[Exp[a3_ + b_.], s_Symbol, t_, opt___] :=
  915.   Module[{a, a4},
  916.     ( a = -a4;
  917.       Exp[b - a^2/(4t)] a/(2 Sqrt[Pi t^3])
  918.     ) /; FreeQ[a4 = Factor[a3]/Sqrt[s], s] &&
  919.      (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] &&
  920.       Apply[And, Map[MatchQ[#, a1_?Negative a2_.]&, Apply[List, a4]]]))
  921.   ] /; FreeQ[{b, t}, s] && !FreeQ[a3, s]
  922.  
  923. InverseLaplaceTransform[s_^n_. Exp[a3_ + b_.], s_Symbol, t_, opt___] :=
  924.   Module[{a, a4},
  925.     ( a = -a4;
  926.       Exp[b] 2^(-n-1/2) Pi^(-1/2) t^(-n-1) Exp[-a^2/(8t)] *
  927.               ParabolicCylinderD[2n+1, a/Sqrt[2t]]
  928.     ) /; FreeQ[a4 = Factor[a3]/Sqrt[s], s] &&
  929.      (MatchQ[a4, a1_?Negative a2_.] || (SameQ[Head[a4], Plus] &&
  930.       Apply[And, Map[MatchQ[#, a1_?Negative a2_.]&, Apply[List, a4]]]))
  931.   ] /; FreeQ[{b, n, t}, s] && !FreeQ[a3, s]
  932.  
  933.  
  934. (* ======================== Logarithmic Functions ========================== *)
  935.  
  936. InverseLaplaceTransform[Log[s_] s_^(n3_), s_Symbol, t_, opt___] :=
  937.       t^(-n3-1)(PolyGamma[-n3]-Log[t])/Gamma[-n3]  /;
  938.       FreeQ[{n3, t}, s] &&
  939.      (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  940.       Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  941.  
  942. InverseLaplaceTransform[Log[a1_ + b_] s_^(n_Integer?Negative),
  943.     s_Symbol, t_, opt___] := 
  944.     Module[{a, tt},
  945.         (DI[Log[b] - ExpIntegralEi[-b tt/a], t, 0, tt, -1-n] /. tt->t)
  946.        /; FreeQ[a = Factor[a1]/s, s]
  947.     ] /; FreeQ[{b, t}, s] && !FreeQ[a1, s] 
  948.  
  949. InverseLaplaceTransform[Log[e_. + f_], s_Symbol, t_, opt___] :=
  950.   Module[{a, b, c, d, f1},
  951.       Log[e + a/c] DiracDelta[t] + (-Exp[(d e + b) t/(c e + a)] + Exp[d t/c])/t 
  952.      /; (f1 = Together[f];
  953.       MatchQ[Collect[Numerator[f1], s]/Collect[Denominator[f1], s],
  954.          (a1_. s + b1_.)/(c1_. s + d1_.) /;
  955.          FreeQ[{a, b, c, d} = {a1, b1, c1, d1}, s]])
  956.   ] /; FreeQ[{e, t}, s] &&
  957.        If[Head[f]===Plus, Apply[And, Map[!FreeQ[#, s]&, Apply[List, f]]],
  958.               !FreeQ[f, s]] 
  959.        
  960. InverseLaplaceTransform[Log[e_. + f_], s_Symbol, t_, opt___] :=
  961.   Module[{b, c, d, f1},
  962.      Log[e] DiracDelta[t] + (-Exp[(d e + b) t/(c e)] + Exp[d t/c])/t
  963.     /; (f1 = Together[f];
  964.      MatchQ[Numerator[f1]/Collect[Denominator[f1], s],
  965.         b1_. / (c1_. s + d1_.) /; FreeQ[{b, c, d} = {b1, c1, d1}, s]]) 
  966.   ] /; FreeQ[{e, t}, s] &&
  967.        If[Head[f]===Plus, Apply[And, Map[!FreeQ[#, s]&, Apply[List, f]]],
  968.               !FreeQ[f, s]]
  969.  
  970. InverseLaplaceTransform[s_^(n3_) Log[s_]^2, s_Symbol, t_, opt___] :=
  971.     With[{n = -n3},
  972.       t^(n-1)((PolyGamma[n]-Log[t])^2 - PolyGamma[1, n]) / Gamma[n] 
  973.     ] /; FreeQ[{n3, t}, s] && 
  974.      (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  975.       Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  976.  
  977. ilLog[a_, b_, c_, d_, t_] :=
  978.   (2/t)(Cos[Sqrt[-c^2/4+d]t]Exp[-c t/2]-Cos[Sqrt[-a^2/4+b]t]Exp[-a t/2]) //.
  979.     {
  980.       Cos[Complex[aa_, bb_] cc_.] :>
  981.         Cos[aa cc]Cosh[bb cc] - I Sin[aa cc]Sinh[bb cc],
  982.       Cos[Sqrt[a1_?Negative] a2_.] :> Cosh[Sqrt[Expand[-a1]] a2]
  983.     }
  984.  
  985. InverseLaplaceTransform[Log[d_. (a1_+c_.)/s_^2], s_Symbol, t_, opt___] :=
  986.   Module[{a},
  987.     Log[a d]DiracDelta[t] + ilLog[0, c/a, 0, 0, t] 
  988.     /; FreeQ[a = Factor[a1]/s^2, s]
  989.   ] /; FreeQ[{c,d,t},s] && !FreeQ[a1,s]
  990.  
  991. InverseLaplaceTransform[Log[(a_. s_^2+c_.)/(d_. s_^2+f_.)],
  992.   s_Symbol, t_, opt___] :=
  993.     Log[a/d]DiracDelta[t] + ilLog[0, c/a, 0, f/d, t] /; FreeQ[{a,c,d,f,t},s]
  994.  
  995. InverseLaplaceTransform[
  996.   Log[(a_. s_^2+c_.)/(d_. s_^2+e_. s_+f_.)], s_Symbol, t_, opt___] :=
  997.     Log[a/d]DiracDelta[t] + ilLog[0, c/a, e/d, f/d, t] /; FreeQ[{a,c,d,e,f,t},s]
  998.  
  999. InverseLaplaceTransform[
  1000.   Log[(a_. s_^2+b_. s_+c_.)/(d_. s_^2+f_.)], s_Symbol, t_, opt___] :=
  1001.     Log[a/d]DiracDelta[t] + ilLog[b/a, c/a, 0, f/d, t] /; FreeQ[{a,b,c,d,f,t},s]
  1002.  
  1003. InverseLaplaceTransform[
  1004.   Log[(a_. s_^2+b_. s_+c_.)/(d_. s_^2+e_. s_+f_.)], s_Symbol, t_, opt___] :=
  1005.     Log[a/d]DiracDelta[t] + ilLog[b/a, c/a, e/d, f/d, t] /;
  1006.     FreeQ[{a,b,c,d,e,f,t},s]
  1007.  
  1008. InverseLaplaceTransform[
  1009.   Log[expr:Plus[a_.,Times[b_.,Power[_,_?Negative]]]], s_Symbol, t_, opt___] :=
  1010.     Module[{expr1 = MapAt[Collect[#, s]&,
  1011.                           ExpandNumerator[ExpandDenominator[Together[expr]]],
  1012.                           {{2, 1}, {1}}]},
  1013.       InverseLaplaceTransform[Log[expr1], s, t, opt] /; expr1 =!= expr
  1014.     ] /; FreeQ[t,s]
  1015.  
  1016.  
  1017. (* ====================== Trigonometric Functions ========================== *)
  1018.  
  1019. InverseLaplaceTransform[s_^(n3_) Sin[a1_], s_Symbol, t_, opt___] :=
  1020.     Module[{a, n = -n3},
  1021.          (t/a)^((n-1)/2) (Sin[3Pi n/4 + Pi/4] ThomsonBer[n-1, 2Sqrt[a t]] -
  1022.             Cos[3Pi n/4+Pi/4] ThomsonBei[n-1, 2Sqrt[a t]])
  1023.        /; FreeQ[a = Factor[a1] s, s]
  1024.     ] /; FreeQ[{n3, t}, s] && 
  1025.      (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  1026.       Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  1027.  
  1028. InverseLaplaceTransform[s_^(n3_) Cos[a1_], s_Symbol, t_, opt___] :=
  1029.     Module[{a, n = -n3},
  1030.         -(t/a)^((n-1)/2) (Cos[3Pi n/4 + Pi/4] ThomsonBer[n-1, 2Sqrt[a t]] -
  1031.             Sin[3Pi n/4+Pi/4] ThomsonBei[n-1, 2Sqrt[a t]])
  1032.        /; FreeQ[a = Factor[a1] s, s]
  1033.     ] /; FreeQ[{n3, t}, s] &&
  1034.      (MatchQ[n3, n1_?Negative n2_.] || (SameQ[Head[n3], Plus] &&
  1035.       Apply[And, Map[MatchQ[#, n1_?Negative n2_.]&, Apply[List, n3]]]))
  1036.  
  1037. InverseLaplaceTransform[ArcTan[a1_], s_Symbol, t_, opt___] :=
  1038.   Module[{a},
  1039.     Sin[a t] / t /; FreeQ[a = Factor[a1] s, s]
  1040.   ] /; FreeQ[t, s] && !FreeQ[a1, s]
  1041.  
  1042.  
  1043. (* ====================== Derivatives and Integrals ======================== *)
  1044.  
  1045. InverseLaplaceTransform[
  1046.   Derivative[n_Integer?Positive][f_][s_], s_Symbol, t_, opt___] :=
  1047.    (-1)^n t^n InverseLaplaceTransform[f[s], s, t, opt] /; FreeQ[t,s]
  1048.  
  1049. InverseLaplaceTransform[
  1050.   Derivative[0,0,n_Integer?Positive,___]
  1051.     [LaplaceTransform][f_,t1_Symbol,s_Symbol,opt1___],
  1052.     s_Symbol,t2_,opt2___] :=
  1053.     ((-1)^n (t1^n f) /. t1->t2)  /; FreeQ[{f,t},s]
  1054.  
  1055. InverseLaplaceTransform[Integrate[f_, {ss_Symbol, s_, Infinity}],
  1056.   s_Symbol, t_, opt___] :=
  1057.     InverseLaplaceTransform[f /. ss->s, s, t, opt] / t /; FreeQ[t,s]
  1058.  
  1059. (* ===================== Products Involving Powers ======================== *)
  1060.  
  1061.  
  1062. InverseLaplaceTransform[a_ s_^n_., s_Symbol, t_, opt___] :=
  1063.    Module[{tt, v, f, init, k,
  1064.        zerolimit = ZeroLimit /. {opt} /. Options[LaplaceTransform]},
  1065.      (f = InverseLaplaceTransform[a, s, tt, opt];
  1066.       init = Limit[ Sum[ s^(n-k-1) D[f, {tt, k}], {k, 0, n-1}], tt->0,
  1067.         Direction->1];
  1068.       If[!FreeQ[init,Limit],
  1069.        If[zerolimit===Automatic,
  1070.      init = Sum[ s^(n-k-1) (D[f, {tt, k}] /. tt->0), {k, 0, n-1}],
  1071.      v = If[SameQ[Head[t], Symbol], t, Unique[]];
  1072.      init = init /. tt->v
  1073.        ]
  1074.       ];
  1075.       ((D[f, {tt, n}]) /. tt->t)  + InverseLaplaceTransform[init, s, t, opt]
  1076.      ) /;  (zerolimit===Automatic || zerolimit===All)
  1077.    ]  /; IntegerQ[n] && n > 0 && FreeQ[t,s]
  1078.  
  1079. InverseLaplaceTransform[a_ s_^(n_Integer?Negative), s_Symbol, t_, opt___] :=
  1080.    Module[{tt},
  1081.      DI[InverseLaplaceTransform[a, s, tt, opt], t, 0, tt, -n] /. tt->t
  1082.    ] /; FreeQ[t,s]
  1083.  
  1084.  
  1085. (* ============== InverseLaplaceTransform of LaplaceTransform ============ *)
  1086.  
  1087. Literal[InverseLaplaceTransform[LaplaceTransform[f_, t_Symbol, s_, ___],
  1088.     s_Symbol, t1_, ___]] :=
  1089.     (f /. t->t1) /; FreeQ[t1,s]
  1090.  
  1091.  
  1092. (* ======================= Composed Functions ============================= *)
  1093.  
  1094. InverseLaplaceTransform[g1_ g2_, s_Symbol, t_, opt___] :=
  1095.    Module[{v = If[SameQ[Head[t], Symbol], Unique[ToString[t]], Unique[]]},
  1096.      Integrate[
  1097.         Collect[
  1098.           (InverseLaplaceTransform[g1, s, t, opt] /. t->v) *
  1099.           (InverseLaplaceTransform[g2, s, t, opt] /. t->t-v),
  1100.           DiracDelta],
  1101.       {v, 0, t}]    
  1102.    ] /;
  1103.    FreeQ[{InverseLaplaceTransform[g1, s, t, opt],
  1104.       InverseLaplaceTransform[g2, s, t, opt]},
  1105.       InverseLaplaceTransform]             && FreeQ[t,s]
  1106.  
  1107. InverseLaplaceTransform[f_, s_Symbol, t_, opt___] :=
  1108.   Module[
  1109.     {gg =
  1110.       Module[
  1111.     {g = ComposedFunctionQ[f, s]},
  1112.         If[( (SameQ @@ g) &&
  1113.          (MatchQ[g[[1]], _Times] || MatchQ[g[[1]], _Plus]) ) ||
  1114.            (And @@
  1115.          (MatchQ[#, Power[s, Rational[_Integer?Negative, 2]]]& /@ g)),
  1116.           Switch[
  1117.             g[[1]],
  1118.             _Times,
  1119.             Module[
  1120.               {a = g[[1]]/s},
  1121.               InverseLaplaceTransform[f /. g[[1]]->s, s, t/a, opt] / a
  1122.             ],
  1123.             _Plus,
  1124.             Module[
  1125.               {a = g[[1]]-s},
  1126.               InverseLaplaceTransform[f /. g[[1]]->s, s, t, opt] Exp[-a t]
  1127.             ],
  1128.             _,
  1129.             Module[
  1130.            {ff = InverseLaplaceTransform[
  1131.             PowerExpand[f /. s->s^2], s, t, opt]},
  1132.           If[
  1133.         FreeQ[ff,InverseLaplaceTransform],
  1134.                 Expand[
  1135.           Module[
  1136.                 {v = If[SameQ[Head[t],Symbol],
  1137.                 Unique[ToString[t]],
  1138.                 Unique[]]},
  1139.                       Integrate[
  1140.                             Collect[v Exp[-v^2/(4 t)](ff /. t->v),  DiracDelta],
  1141.                             {v, 0, Infinity}] 
  1142.                   ] / (2 Sqrt[Pi t^3]) 
  1143.                 ],
  1144.                 $Failed
  1145.               ] 
  1146.             ] 
  1147.           ], 
  1148.           $Failed
  1149.         ] 
  1150.       ]
  1151.     },
  1152.     gg /;
  1153.     !SameQ[Head[gg],InverseLaplaceTransform] && !SameQ[gg, $Failed]
  1154.   ]  /; FreeQ[t,s]
  1155.  
  1156.  
  1157.   
  1158. (* ================== Derivative of InverseLaplaceTransform ================ *)
  1159.  
  1160. Unprotect[D, Derivative]
  1161.  
  1162.     (*** Derivative of InverseLaplaceTransform, Linearity ***)
  1163.  
  1164. Literal[D[x_Plus,y_Symbol]] := Map[D[#,y]&,x] /;
  1165.                     !FreeQ[x,InverseLaplaceTransform]
  1166.  
  1167. Literal[D[x_Plus,{y_Symbol,n_Integer?Positive}]] := Map[D[#,{y,n}]&,x] /;
  1168.                     !FreeQ[x,InverseLaplaceTransform]
  1169.  
  1170. Literal[D[x_Times,y_Symbol]] :=
  1171.     Module[{e = Expand[x]},
  1172.         D[e,y] /; !SameQ[x,e]
  1173.     ]    /;    !FreeQ[x,InverseLaplaceTransform]
  1174.  
  1175. Literal[D[x_Times,{y_Symbol,n_Integer?Positive}]] :=
  1176.     Module[{e = Expand[x]},
  1177.         D[e,{y,n}] /; !SameQ[x,e]
  1178.     ]    /; !FreeQ[x,InverseLaplaceTransform]
  1179.  
  1180. Derivative[0,0,m_Integer?Positive][InverseLaplaceTransform][f_, s_Symbol, t_] :=
  1181.     Module[{inverse, t1},
  1182.        (D[inverse, {t1, m}] /. t1->t)
  1183.        /; FreeQ[inverse = InverseLaplaceTransform[f, s, t1],
  1184.             InverseLaplaceTransform]
  1185.     ] /; FreeQ[t, s]
  1186.  
  1187. Derivative[0,0,m_Integer?Positive,z:(0)..][InverseLaplaceTransform][f_, 
  1188.     s_Symbol,t_,opt__] :=
  1189.     Module[{inverse, t1},
  1190.        (D[inverse, {t1, m}] /. t1->t)
  1191.        /; FreeQ[inverse = InverseLaplaceTransform[f, s, t1],
  1192.             InverseLaplaceTransform]
  1193.     ] /; ((Length[{z}] == Length[{opt}]) && FreeQ[t,s])
  1194.  
  1195.     (*** Derivative of InverseLaplaceTransform wrt t ***)
  1196.  
  1197. Literal[D[InverseLaplaceTransform[f_,s_Symbol,t_,opt__],t_Symbol]] :=
  1198.    Apply[Derivative,Join[{0,0,1},
  1199.      Table[0,{Length[{opt}]}]]][InverseLaplaceTransform][f,s,t,opt]  /;
  1200.                                 FreeQ[t,s]
  1201.  
  1202. Literal[D[InverseLaplaceTransform[f_,s_Symbol,t_,opt__],
  1203.    {t_Symbol,n_Integer?Positive}]] :=
  1204.      Apply[Derivative,Join[{0,0,n},
  1205.        Table[0,{Length[{opt}]}]]][InverseLaplaceTransform][f,s,t,opt] /;
  1206.                                 FreeQ[t,s]
  1207.  
  1208.         (*** Derivative of InverseLaplaceTransform wrt s ***)
  1209.  
  1210. Literal[D[u_. InverseLaplaceTransform[f_,s_Symbol,t_,opt___],s_]] :=
  1211.     D[u,s] InverseLaplaceTransform[f,s,t,opt] /;
  1212.                 FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s]
  1213.  
  1214. Literal[D[u_. InverseLaplaceTransform[f_,s_Symbol,t_,opt___],
  1215.     {s_,n_Integer?Positive}]] :=
  1216.     D[u,{s,n}] InverseLaplaceTransform[f,s,t,opt] /;
  1217.                 FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s]
  1218.  
  1219.       (*** Derivative of Derivative of InverseLaplace wrt t (with options) ***)
  1220.  
  1221. Literal[D[u_. Derivative[0,0,m_Integer?Positive,
  1222.     z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_Symbol,opt__],
  1223.       t_]] :=
  1224.     u Derivative[0,0,m+1,z][InverseLaplaceTransform][f,s,t,opt] +
  1225.     D[u,t] Derivative[0,0,m,z][InverseLaplaceTransform][f,s,t,opt] /;
  1226.     (Length[{z}] == Length[{opt}]) && FreeQ[u,InverseLaplaceTransform] &&
  1227.                                 FreeQ[t,s]
  1228.  
  1229. Literal[D[Derivative[0,0,m1_Integer?Positive,
  1230.     z1:(0)..][InverseLaplaceTransform][f1_,s1_Symbol,t_Symbol,opt1__] *
  1231.       Derivative[0,0,m2_Integer?Positive,
  1232.     z2:(0)..][InverseLaplaceTransform][f2_,s2_Symbol,t_Symbol,opt2__],
  1233.       t_]] :=
  1234.     Derivative[0,0,m1,z1][InverseLaplaceTransform][f1,s1,t,opt] *
  1235.         Derivative[0,0,m2+1,z2][InverseLaplaceTransform][f2,s2,t,opt] +
  1236.     Derivative[0,0,m1+1,z1][InverseLaplaceTransform][f1,s1,t,opt] *
  1237.         Derivative[0,0,m2,z2][InverseLaplaceTransform][f2,s2,t,opt] /;
  1238.     (Length[{z1}] == Length[{opt1}]) && (Length[{z2}] == Length[{opt2}]) &&
  1239.                         FreeQ[t,s1] && FreeQ[t,s2]
  1240.  
  1241. Literal[D[u_. Derivative[0,0,m_Integer?Positive,
  1242.     z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_Symbol,opt__],
  1243.     {t_,n_Integer?Positive}]] :=
  1244.     Nest[D[#,t]&, u Derivative[0,0,m,z][InverseLaplaceTransform][f,
  1245.             s,t,opt], n] /; (Length[{z}] == Length[{opt}]) &&
  1246.                                 FreeQ[t,s]
  1247.  
  1248.     (*** Derivative of Derivative of InverseLaplace wrt s ***)
  1249.  
  1250. Literal[D[u_. Derivative[0,0,m_Integer?Positive][InverseLaplaceTransform][f_,
  1251.         s_Symbol,t_],
  1252.     s_]] :=  D[u,s] Derivative[0,0,m][InverseLaplaceTransform][f,s,t] /;
  1253.                 FreeQ[u,InverseLaplaceTransform] && FreeQ[t,s]
  1254.  
  1255. Literal[D[u_. Derivative[0,0,m_Integer?Positive][InverseLaplaceTransform][f_,
  1256.          s_Symbol,t_],
  1257.     {s_,n_Integer?Positive}]] :=
  1258.       Nest[D[#,s]&, u Derivative[0,0,m][InverseLaplaceTransform][f,s,t], n] /;
  1259.                                 FreeQ[t,s]
  1260.  
  1261. Literal[D[u_. Derivative[0,0,m_Integer?Positive,
  1262.     z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_,opt__],
  1263.     s_]] :=  D[u,s] Derivative[0,0,m,z][InverseLaplaceTransform][f,
  1264.         s,t,opt] /;
  1265.     (Length[{z}] == Length[{opt}]) && FreeQ[u,InverseLaplaceTransform] &&
  1266.                                 FreeQ[t,s]
  1267.  
  1268. Literal[D[u_. Derivative[0,0,m_Integer?Positive,
  1269.     z:(0)..][InverseLaplaceTransform][f_,s_Symbol,t_,opt__],
  1270.     {s_,n_Integer?Positive}]] :=
  1271.     Nest[D[#,s]&, u Derivative[0,0,m,z][InverseLaplaceTransform][f,
  1272.         s,t,opt], n] /;       (Length[{z}] == Length[{opt}]) && FreeQ[t,s]
  1273.  
  1274.  
  1275. Protect[D, Derivative]
  1276.  
  1277. positive[a_] := Positive[a] /; NumberQ[N[a]]
  1278. positive[a_Times] := Apply[And, Map[positive, a]]
  1279. positive[a_] := True
  1280.  
  1281. negative[a_] := Negative[a] /; NumberQ[N[a]]
  1282. negative[a_Times] := Apply[Or, Map[negative, a]]
  1283. negative[a_] := False
  1284.  
  1285. ComplexQ[a_] := Head[a] === Complex
  1286.  
  1287. (*****************************************************************************)
  1288. End[]             (* end `Private` Context                                   *)
  1289. (*****************************************************************************)
  1290.  
  1291.  
  1292.  
  1293. (*****************************************************************************)
  1294. EndPackage[]      (* end package Context                                     *)
  1295. (*****************************************************************************)
  1296.  
  1297. (*:Limitations:
  1298.  
  1299. As in the case of integration, there are additional special cases that appear
  1300. in the reference book, yet are not covered here.
  1301.  
  1302. LaplaceTransform can be evaluated numerically by performing the integral in
  1303. the definition using NIntegrate.  Although that is possible in principle for
  1304. InverseLaplaceTransform, the convergence of the typical integrals one
  1305. encounters is much poorer (goes like Sin[t]/t). If, at some point, NIntegrate
  1306. will be more successful in evaluating these, a numeric rule for
  1307. InverseLaplaceTransform could be added.
  1308.  
  1309. *)
  1310.  
  1311.  
  1312.