
(*                DiracDeltaExtensions

           Techno-Sciences, Inc.
           10001 Derekwood Lane, Suite 204
           Lanham, MD 20706
           (301) 577-6000
           
*)

(* Adds certain simplification functions related to DiracDelta and UnitStep
   available previously (before V4.0) in the standard Mathematica package
   Calculus`DiracDelta
*)


BeginPackage["ProPac`DiracDeltaExtensions`"]

(*
If[Head[UnitStep::usage] === MessageName,
 UnitStep::usage =
 "UnitStep[x] is a function that is 1 for x > 0 and 0 for x < 0.
 UnitStep[x1, x2, ...] is 1 for (x1 > 0) && (x2 > 0) && ... and 0 for
 (x1 < 0) || (x2 < 0) || ... ."
]

DiracDelta::usage =
"DiracDelta[x] is a distribution that is 0 for x != 0 and satisfies
Integrate[DiracDelta[x], {x, -Infinity, Infinity}] = 1.
DiracDelta[x1, x2, ...] is a distribution that is 0 for x1 != 0 ||
x2 != 0 || ... and satisfies Integrate[DiracDelta[x1, x2, ...],
{x1, -Infinity, Infinity}, {x2, -Infinity, Infinity}, ...] = 1."

ZeroValue::usage =
"ZeroValue is an option used to specify the value of UnitStep when one or more
of the arguments are zero.  In particular, UnitStep[x1, x2, ..., ZeroValue -> 1]
is 1 for (x1 >= 0) && (x2 >= 0) && ... and UnitStep[x1, x2, ..., ZeroValue -> 0]
is 0 for (x1 <= 0) || (x2 <= 0) || ... ."
*)

SimplifyUnitStep::usage =
"SimplifyUnitStep[expr] returns a form of expr with fewer instances of UnitStep."

SimplifyDiracDelta::usage =
"SimplifyDiracDelta[expr] simplifies a zero distribution in expr to 0."

Begin["`Private`"]

Unprotect[DiracDelta]
Unprotect[UnitStep]

Attributes[UnitStep] = Attributes[DiracDelta] = Orderless


(********************************* DiracDelta *********************************)

DiracDelta[x__] := 0 /; !Apply[And, Map[(#==0)&, {x}]]

Derivative[n__Integer?NonNegative][DiracDelta][x__] :=
	0 /; !Apply[And, Map[(#==0)&, {x}]]

(********************************* UnitStep ***********************************)

Options[UnitStep] = {ZeroValue -> 1}
ZeroValue::zerov =
"Warning: `` must be None or a number between 0 and 1.  ZeroValue default
assumed."

UnitStep[x__, ___Rule] := 0 /; Apply[Or, Negative[{x}]]

(* Handling an illegal ZeroValue. *)

UnitStep[x__?((Head[#] =!= Rule)&), ZeroValue -> k_] :=
	(Message[ZeroValue::zerov, k];
	 UnitStep[x]) /; !(k === None ||
		(NumberQ[N[k]] && FreeQ[N[k], Complex] && 0 <= N[k] <= 1) )

(* Some zero arguments. *)

UnitStep[x__?RuleFreeQ, r___Rule] :=
  Module[{k = ZeroValue /. {r} /. Options[UnitStep], nk, select, comp},
    (
     comp = Complement[{x}, select];
     k^Length[select] If[comp === {}, 1, Apply[UnitStep, Join[comp, {r}]]]
    ) /;
	NumberQ[nk = N[k]] && 0 <= nk <= 1 &&
	Length[select = Select[{x}, N[#]==0&]] > 0
  ]

(* Some positive arguments. *)

UnitStep[x__?RuleFreeQ, r___Rule] :=
  Module[{select, comp},
    (
     comp = Complement[{x}, select];
     If[comp === {}, 1, Apply[UnitStep, Join[comp, {r}]]]
    ) /; FreeQ[{x}, Complex] && Length[select = Select[{x}, Positive]] > 0
  ]

(* Products of UnitSteps. *)

UnitStep /: UnitStep[x_ + aa_., ra___Rule]*UnitStep[-x_ + bb_., rb___Rule] :=
  Module[{},
	0
  ] /; FreeQ[{aa, bb}, x] && -aa > bb


(****************************** limits, linearity ***************************)

Unprotect[Limit]

  (* collect subexpressions before taking limit *)
Limit[f_, x_ -> c_, dir___] :=
   Module[{result},
     Limit[result, x -> c, dir] /;
	   (
	    result = collect[f, {UnitStep[__], DiracDelta[__],
					Derivative[__][DiracDelta][__]}];
	    !SameQ[f, result])
   ] /; !USDDFreeQ[f]

  (* Derivative[n][DiracDelta] term plus another term *)
Limit[a_. Derivative[n__Integer?NonNegative][DiracDelta][f__] + b_.,
		x_ -> c_, dir___] :=
   Module[{lima, limb, limdeltader},
     If[limdeltader == 0 && !FreeQ[N[lima], DirectedInfinity],
	limb,
	lima limdeltader + limb]  /;
	  ( LimitFreeQ[{lima, limb, limdeltader} =
	   	Limit[{a, b, Derivative[n][DiracDelta][f]}, x->c, dir]] &&
	    !(limdeltader != 0 &&
	      !FreeQ[N[lima], DirectedInfinity] &&
	      !FreeQ[N[limb], DirectedInfinity]) )
   ] /; !(TrueQ[a==1] && TrueQ[b==0])

  (* DiracDelta term plus another term *)
Limit[a_. DiracDelta[f__] + b_., x_ -> c_, dir___] :=
	Module[{lima, limb, limdelta},
	  If[limdelta == 0 && !FreeQ[N[lima], DirectedInfinity],
		limb,
	        lima limdelta + limb]  /;
	   (LimitFreeQ[{lima, limb, limdelta} =
	               Limit[{a, b, DiracDelta[f]}, x->c, dir]] &&
	    !(limdelta != 0 &&
	      !FreeQ[N[lima], DirectedInfinity] &&
	      !FreeQ[N[limb], DirectedInfinity]) )
	] /; !(TrueQ[a==1] && TrueQ[b==0])

  (* UnitStep term plus another term *)
Limit[a_. UnitStep[f__?RuleFreeQ, zero___Rule] + b_., x_ -> c_, dir___] :=
	Module[{lima, limb, limunit},
	    If[limunit == 0 && LimitFreeQ[lima] &&
			!FreeQ[N[lima], DirectedInfinity],
		limb,
	        lima limunit + limb]  /;
	      ( {lima, limb} = Limit[{a, b}, x->c, dir];
	        LimitFreeQ[limunit = Limit[UnitStep[f, zero], x->c, dir]] &&
	        !( limunit != 0 && LimitFreeQ[{lima, limb}] &&
	           !FreeQ[N[lima], DirectedInfinity] &&
	           !FreeQ[N[limb], DirectedInfinity] ) )
	] /; !(TrueQ[a==1] && TrueQ[b==0]) && USFreeQ[b]
		(* NOTE: In the case that b includes UnitStep,
			the limits of the UnitSteps should be computed
			first before applying a linearity rule. *)


itform = (Head[Sum::itform] === $Off);
Off[Sum::itform];
Limit[Sum[a_. Derivative[n__Integer?NonNegative][DiracDelta][f__] + b_., i__],
	x_ -> c_, dir___] := 
	Module[{lima, limb, limdeltader},
	 (
	  If[limdeltader == 0 && !FreeQ[N[lima], DirectedInfinity],
		Sum[Evaluate[limb], Evaluate[i]],
		Sum[Evaluate[lima limdeltader + limb], Evaluate[i]]
          ]
	 ) /;
	   ( LimitFreeQ[{lima, limb, limdeltader} =
	            Limit[{a, b, Derivative[n][DiracDelta][f]}, x->c, dir]] &&
	     !(limdeltader != 0 &&
	       !FreeQ[N[lima], DirectedInfinity] &&
	       !FreeQ[N[limb], DirectedInfinity]) )
        ] /; FreeQ[{i}, x]

Limit[Sum[a_. DiracDelta[f__] + b_., i__], x_ -> c_, dir___] := 
	Module[{lima, limb, limdelta},
	 (
	  If[limdelta == 0 && !FreeQ[N[lima], DirectedInfinity],
		Sum[Evaluate[limb], Evaluate[i]],
		Sum[Evaluate[lima limdelta + limb], Evaluate[i]]
	  ]
	 ) /;
	   ( LimitFreeQ[{lima, limb, limdelta} =
	    	Limit[{a, b, DiracDelta[f]}, x->c, dir]] &&
	     !(limdelta != 0 &&
	       !FreeQ[N[lima], DirectedInfinity] &&
	       !FreeQ[N[limb], DirectedInfinity]) )
	] /; FreeQ[{i}, x]

Limit[Sum[a_. UnitStep[f__?RuleFreeQ, zero___Rule] + b_., i__],
	x_ -> c_, dir___] :=
	Module[{lima, limb, limunit, result},
  	 (
	  result = If[limunit == 0 && LimitFreeQ[lima] &&
	     		!FreeQ[N[lima], DirectedInfinity],
	     Sum[Evaluate[limb], Evaluate[i]],
	     Sum[Evaluate[lima limunit + limb], Evaluate[i]]]
	 ) /;
	   ( {lima, limb} = Limit[{a, b}, x->c, dir];
	     LimitFreeQ[limunit = Limit[UnitStep[f, zero], x->c, dir]] &&
	     !(limunit != 0 && FreeQ[{lima, limb}, Limit] &&
	       !FreeQ[N[lima], DirectedInfinity] &&
	       !FreeQ[N[limb], DirectedInfinity]) )
	] /; FreeQ[{i}, x] && USFreeQ[b]
		(* NOTE: In the case that b includes UnitStep,
			the limits of the UnitSteps should be computed
			first before applying a linearity rule. *)

Limit[a_. sum_?((Head[#] === Sum)&) + b_, x_ -> c_, dir___] :=
	Module[{lima, limb, limsum}, 
         (
	  If[limsum == 0 && LimitFreeQ[lima] &&
			!FreeQ[N[lima], DirectedInfinity],
		limb,
		lima limsum + limb]
	 ) /;
	( {lima, limb} = Limit[{a, b}, x->c, dir];
	  LimitFreeQ[limsum = Limit[sum,  x->c, dir]] &&
	  !(limsum != 0 && LimitFreeQ[{lima, limb}] &&
	    !FreeQ[N[lima], DirectedInfinity] &&
	    !FreeQ[N[limb], DirectedInfinity]) )
	] /; !USDDFreeQ[sum] && USFreeQ[b]
		(* NOTE: In the case that b includes UnitStep,
			the limits of the UnitSteps should be computed
			first before applying a linearity rule. *)
If[!itform, On[Sum::itform]];


(********************** limits, UnitStep' and DiracDelta **********************)

Limit[Derivative[n__Integer?NonNegative][DiracDelta][f__],
	x_ -> c_, dir___Rule] :=
   Module[{limit},
     If[Apply[And, Map[NumberQ[N[#]]&, limit]],
	   0, Apply[Derivative[n][DiracDelta], limit]
     ]  /; LimitFreeQ[limit = Limit[{f}, x->c, dir]]
   ]

DiracDelta /: Limit[DiracDelta[f__], x_ -> c_, dir___Rule] :=
   Module[{limit},
     If[Apply[And, Map[NumberQ[N[#]]&, limit]], 
	   0, Apply[DiracDelta, limit]
     ]  /; LimitFreeQ[limit = Limit[{f}, x->c, dir]]
   ]

(****************************** limits, UnitStep ******************************)

(* General expressions containing UnitStep.
   Must fire before linearity rules so that
   Limit[-x UnitStep[x - 2] + x UnitStep[x], x -> Infinity] -> 0 .
*)

Limit[f_?RuleFreeQ, x_ -> c_, dir___Rule] :=
     Module[{result =
       Module[{newf = f, scan, infy, finalLimit},
	infy = (Head[Power::infy] === $Off);
	Off[Power::infy];
	scan = Scan[Module[{pos = #, tempf, sum},
		      If[Head[limit = Limit[ Apply[Part, Prepend[pos, f]],
					 x->c, dir ]] ===
				Limit,
				Return[$Failed]
		      ];
		      If[limit =!= Indeterminate &&
			 FreeQ[limit, DirectedInfinity],
			 newf = newf //. Sum:>sum;
			 newf = ReplacePart[newf, identity[limit, pos], pos];
			 newf = newf //. sum:>Sum;
			 tempf = (newf /. identity[y_, z_] -> Identity[y]);
			 If[tempf === Indeterminate ||
			    !FreeQ[tempf, DirectedInfinity],
			    Return[$Failed]
			 ],
			 Return[$Failed]
		      ]
		    ]&,	
		    Position[f, UnitStep[__?((!FreeQ[#, x])&)]]
	       ];
	If[scan === $Failed,
		If[!infy, On[Power::infy]];
		$Failed,
		finalLimit = Limit[newf /. identity[y_, z_] -> Identity[y],
			x->c, dir];
		If[!infy, On[Power::infy]];
		If[Head[finalLimit] === Limit ||
		   (finalLimit =!= Indeterminate &&
	            FreeQ[finalLimit, DirectedInfinity]),
			finalLimit,
			$Failed
	        ]
	]
       ]},
	(
	 result
	)   /; result =!= $Failed
     ] /; !USFreeQ[f] && !FreeQ[f, x] &&
		With[{posList = Position[f, UnitStep[__?((!FreeQ[#, x])&)]]},
			posList =!= {{}} && posList =!= {}
		]

Protect[Limit]

(* Default Limit Direction is Automatic. *)

UnitStep /: Limit[UnitStep[f__?RuleFreeQ, zero___Rule], x_ -> c_] :=
     Module[{limit},
	(
	 limit
	)   /; LimitFreeQ[limit = Limit[UnitStep[f, zero], x -> c,
				Direction -> Automatic]]
     ]
 

(* For each of UnitStep's arguments that approach an expression not equal to
	zero, take the Limit inside of the UnitStep. *)

UnitStep /: Limit[UnitStep[f__?RuleFreeQ, zero___Rule],
	x_ -> c_, dir___Rule] :=
   Module[{limit = Limit[{f}, x -> c, dir], newf},
     (
	Limit[ UnitStep @@ Join[newf, {zero}], x -> c, dir] 
     )  /;  (newf = Map[If[!LimitFreeQ[#[[2]]] || TrueQ[#[[2]]==0],
		           #[[1]], #[[2]]]&,
      		        Transpose[{{f}, limit}]];
	     !SameQ[{f}, newf])
   ] 


(* If even one of UnitStep's arguments approaches a negative number, then 
	 UnitStep is zero. *)

UnitStep /: Limit[UnitStep[f__?RuleFreeQ, ___Rule],
	x_ -> c_, dir___Rule] :=
   Module[{limit = Limit[{f}, x -> c, dir]},
	 0 /; Apply[Or, Negative[limit]]
   ]


(* In cases where one or more of UnitStep's arguments approach zero, check
	the derivative of those arguments before deciding what the limit
	should be.  There are four cases where one or more of UnitStep's
	arguments approach zero... *)

UnitStep /: Limit[UnitStep[f__?RuleFreeQ, ___Rule],
	x_ -> c_, Direction -> dir_] :=
  Module[{limit = Limit[{f}, x -> c, Direction -> dir]},
      1 /; Apply[And, MapIndexed[(Positive[#1] ||
	    (#1==0 && IncreasingQ[{f}[[#2[[1]]]], x, c, dir]))&,
	    limit]]
  ] /; (dir === Automatic || Negative[dir])

UnitStep /: Limit[UnitStep[f__?RuleFreeQ, ___Rule],
	x_ -> c_, Direction -> dir_] :=
   Module[{limit = Limit[{f}, x -> c, Direction -> dir]},
       0 /; Apply[Or, MapIndexed[(Negative[#1] ||
	     (#1==0 && DecreasingQ[{f}[[#2[[1]]]], x, c, dir]))&,
	     limit]]
   ] /; (dir === Automatic || Negative[dir])

UnitStep /: Limit[UnitStep[f__?RuleFreeQ, ___Rule], x_ -> c_,
	Direction -> dir_?Positive] :=
   Module[{limit = Limit[{f}, x -> c, Direction -> dir]},
       1 /; Apply[And, MapIndexed[(Positive[#1] ||
	     (#1==0 && DecreasingQ[{f}[[#2[[1]]]], x, c, dir]))&,
	     limit]]
  ] 

UnitStep /: Limit[UnitStep[f__?RuleFreeQ, ___Rule], x_ -> c_,
	Direction -> dir_?Positive] :=
   Module[{limit = Limit[{f}, x -> c, Direction -> dir]},
       0 /; Apply[Or, MapIndexed[(Negative[#1] ||
	     (#1==0 && IncreasingQ[{f}[[#2[[1]]]], x, c, dir]))&,
	     limit]]
   ]

(* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *)

IncreasingQ[f_, x_, c_, dir_] :=  Module[{g = D[f, x]},
	If[!FreeQ[g, Derivative] || g == 0, Return[False]];
	While[ TrueQ[Limit[g, x->c, Direction -> dir] == 0],
		g = D[g, x];
		If[!FreeQ[g, Derivative] || g == 0, Return[False]]
	];
	TrueQ[Positive[Limit[g, x->c, Direction -> dir]]] ]

DecreasingQ[f_, x_, c_, dir_] :=  Module[{g = D[f, x]},
	If[!FreeQ[g, Derivative] || g == 0, Return[False]];
	While[ TrueQ[Limit[g, x->c, Direction -> dir] == 0],
		g = D[g, x];
		If[!FreeQ[g, Derivative] || g == 0, Return[False]]
	];
	TrueQ[Negative[Limit[g, x->c, Direction -> dir]]] ]


(************************** derivatives, UnitStep *****************************)


HoldPattern[Derivative[n__?NonNegative][UnitStep][x__?RuleFreeQ]] :=
  Module[{l = Transpose[{{n}, {x}}], nonzero, zero, u, d},
    nonzero = Select[l, #[[1]] != 0&]; zero = Complement[l, nonzero];
    u = If[zero === {}, 1, UnitStep @@ Map[#[[2]]&, zero]];
    d = If[nonzero === {}, 1,
	((Derivative @@ (Map[#[[1]]&, nonzero]-1)) [DiracDelta]) @@
	Map[#[[2]]&, nonzero]];
    u * d
  ] /; Length[{n}] == Length[{x}]

HoldPattern[Derivative[n__][UnitStep][x__?RuleFreeQ, r_Rule]] :=
  Module[{l = Transpose[{Drop[{n}, -1], {x}}], nonzero, zero, u, d},
    nonzero = Select[l, #[[1]] != 0&]; zero = Complement[l, nonzero];
    u = If[zero === {}, 1, UnitStep @@ Join[Map[#[[2]]&, zero], {r}]];
    d = If[nonzero === {}, 1,
	((Derivative @@ (Map[#[[1]]&, nonzero]-1)) [DiracDelta]) @@
	Map[#[[2]]&, nonzero]];
    u * d
  ] /; Length[{n}]-1 == Length[{x}] && Apply[And, NonNegative[Drop[{n}, -1]]] &&
		Last[{n}] == 0

Unprotect[D]

 (* D rules for UnitStep with ZeroValue option *)

HoldPattern[D[(c_.)(a_. UnitStep[f__?RuleFreeQ, r_Rule] + b_.) + d_.,
	x__?((Head[#] === Symbol || MatchQ[#, {_Symbol, _Integer}])&)]] :=
   Module[{cprime = D[c, x]},
    Collect[  (D[c a UnitStep[f], x] //. ZeroValueRules[r]) + D[c b + d, x],
	 Complement[{c, cprime}, {0}] ]  
   ]

 (* D rules for Derivative[n__][UnitStep] with ZeroValue option *)

HoldPattern[D[(c_.)(a_. Derivative[m__Integer?NonNegative][UnitStep][f__?RuleFreeQ,
	r_Rule] + b_.) + d_.,
	x__?((Head[#] === Symbol || MatchQ[#, {_Symbol, _Integer}])&)]] :=
   Module[{cprime = D[c, x]},
    Collect[  (D[c a Apply[Derivative, Drop[{m}, -1]][UnitStep][f], x] //. 
		ZeroValueRules[r]) + D[c b + d, x],
	Complement[{c, cprime}, {0}] ]
   ]

Protect[D]

ZeroValueRules[r_] := {Derivative[n__][UnitStep][g__?RuleFreeQ] :>
					Derivative[n, 0][UnitStep][g, r],
			UnitStep[g__?RuleFreeQ] :> UnitStep[g, r]}

(********************* integrals, simplifying integrand **********************)

(* Note that Integrate[g[x] v[x] + h[x] v[x], x] ->
	     Integrate[(g[x] + h[x]) v[x], x] is built-in to Mathematica. *)	

Unprotect[Integrate]

  (* collect subexpressions before integrating *)
Integrate[f_, x_?((!OptionQ[#])&), opts___?OptionQ] :=
   Module[{result},
     (
     Integrate[result, x, opts]
     ) /; (result = collect[f, {UnitStep[__], DiracDelta[__],
					Derivative[__][DiracDelta][__]}];
	   !SameQ[f, result])
   ] /; !USDDFreeQ[f]

(**************************** integrals, linearity ****************************)

Integrate[sum_Plus, x__?((!OptionQ[#])&), opts___?OptionQ] :=
   Module[{inlist, successlist = {}, parsuccesslist = {}, failedlist = {},
	   scan, i1, integrate},
     (
     SimplifyUnitStep[ Apply[Plus, successlist] ] +
     (Apply[Plus, parsuccesslist] /. {integrate :> Integrate}) +
     Integrate[ Apply[Plus, failedlist], x, opts]
     ) /; (inlist = Apply[List, sum];
	   scan = Scan[(If[FreeQ[i1 = (Integrate[#, x, opts] /.
				 Integrate:>integrate), integrate],
			   (* Integrate evaluated completely *)
			   If[(i1===Indeterminate) ||
				 !FreeQ[i1,DirectedInfinity],
			      Return[$Failed] ];
			   (* Integrate converged *)
			   AppendTo[successlist, i1],
			   (* Integrate did not evaluate completely *)
			   If[Head[i1] === integrate &&
			      Rest[Apply[List, i1]] =!= {x},
			      (* Integrate limits were trimmed so Integrate
				 partially succesful *)
			      AppendTo[parsuccesslist, i1],
			      AppendTo[failedlist, #] ]
			])&, inlist];
	   (* evaluate if none of the integrals fail to converge *)
	   scan =!= $Failed)
   ] /; !USDDFreeQ[sum]

  (* constant multiplying UnitStep *)
Integrate[a_ UnitStep[y_, r___Rule], x_Symbol, opts___?OptionQ] :=
	a Integrate[UnitStep[y, r], x, opts]  /; FreeQ[a, x] 	

  (* constant and nonconstant multiplying UnitStep *)
Integrate[a_ f_ UnitStep[y_, r___Rule], x__Symbol, opts___?OptionQ] :=
       a Integrate[f UnitStep[y, r], x, opts]  /;
   Apply[And, Map[FreeQ[a, #]&, {x}]] && Apply[Or, Map[!FreeQ[f, #]&, {x}]]

itform = (Head[Sum::itform] === $Off);
Off[Sum::itform];
  (* sum of DiracDelta or UnitStep terms *)
Integrate[a_. Sum[f_, i__] + b_., x_Symbol, opts___?OptionQ] :=
	Module[{result = Module[{head, fF},
				head = Head[fF = Integrate[a f, x, opts]];
				If[head =!= Integrate,
				    Sum[Evaluate[fF], Evaluate[i]] +
					 Integrate[b, x, opts],
				    $Failed]]},
	  (
		result
	  ) /; result =!= $Failed
	] /; !USDDFreeQ[f] && FreeQ[{i}, x] && !FreeQ[f, x]
If[!itform, On[Sum::itform]];


(***************************** definite integrals *****************************)

	(* Use UnitStep to trim integration limits. *)
Integrate[f_ UnitStep[y__?RuleFreeQ, r___Rule]^(n_.),
	 z__?((VectorQ[#] && !OptionQ[#])&), opts___?OptionQ] :=
  Module[{x, a, b, c, d, t, result},
     (
       result
     ) /;
       Apply[Or, Map[
	( MatchQ[#, {x1_, a1_, b1_} /;
		( {x, a, b} = {x1, a1, b1};
		  (NumberQ[N[a]] || Head[a] === DirectedInfinity) &&
		  (NumberQ[N[b]] || Head[b] === DirectedInfinity)
		)
	  ] &&
	  MemberQ[{y}, p_ /; PolynomialQ[p, x] && Exponent[p, x] == 1 &&
               ( {d, c} = CoefficientList[p, x];
                 NumberQ[N[c]] && NumberQ[N[d]] &&
                 (t = -d/c; If[N[c] > 0, N[t] > N[a], N[t] < N[b]])
               )
          ]
	)&, {z}]] &&
       Module[{newf, newz, x, a, b, na, nb, idiv, head},
	  newf = ( SimplifyUnitStep[f UnitStep[y, r]^n] ) /. ToUniRules;
          newz = 
             Map[({x, a, b} = #; {na, nb} = N[{a, b}];
	          While[MatchQ[newf,
			 f1_ UnitStep[c1_. x + d1_., ___Rule]^(m_.) /;
				(NumberQ[N[c1]] && NumberQ[N[d1]] &&
				 ({nc, t, f2} = {N[c1], -d1/c1, f1};
				  If[nc > 0, N[t] > na, N[t] < nb]))],
	            If[nc > 0,
		      If[nb <= N[t], newf = 0,
			             newf = f2; a = t; na = N[a]],
		        If[na >= N[t], newf = 0,
			               newf = f2; b = t; nb = N[b]]]
                  ];
                  {x, a, b})&,
                 {z}];
          idiv = (Head[Integrate::idiv] === $Off);
          Off[Integrate::idiv];
	  If[newf === 0,
	     result = 0,
	     head = Head[result = Apply[Integrate, Join[{newf}, newz, {opts}]]];
	     If[!( head === Integrate ||
		   (result =!= Indeterminate && FreeQ[result, DirectedInfinity])
		 ),
		 If[!idiv, On[Integrate::idiv]];  Return[False]
	     ]	
	  ]; (* result OK *)
	  If[!idiv, On[Integrate::idiv]];
	  True
       ] (* end Module *)

  ]

	(* Eliminate UnitStep terms that are unity. *)
Integrate[f_ UnitStep[y__?RuleFreeQ, r___Rule]^(n_.), z__List?((!OptionQ[#])&),
	 opts___?OptionQ] :=
  Module[{x, a, b, unit, newunit = UnitStep[y, r]^n},
    (
    Scan[({x, a, b} = #;
	    If[(unit = (newunit //. {x -> a})) === (newunit //. {x -> b}),
	       newunit = unit]
	 )&, {z}];
    Integrate[f newunit, z, opts] 
    ) /;
	Apply[Or, Map[
	 ( MatchQ[#, {x1_Symbol, a1_, b1_} /;
		( {x, a, b} = {x1, a1, b1};
		  (NumberQ[N[a]] || Head[a] === DirectedInfinity) &&
		  (NumberQ[N[b]] || Head[b] === DirectedInfinity)
		)
	   ] &&
           !FreeQ[{y}, x] && FreeQ[D[{y}, x], x] (* linearity! *) &&
           ((UnitStep[y, r]^n) //. {x -> a}) ===
		((UnitStep[y, r]^n) //. {x -> b})
	 )&, {z}]]
  ]

	(* Expand if it appears that the UnitStep will allow the
		integration limits to be trimmed. *)
Integrate[f_ (UnitStep[y__?RuleFreeQ, r___Rule]^(n_.) + h_) + g_.,
	 z__List?((!OptionQ[#])&), opts___?OptionQ] :=
  Module[{x, a, b, c, d, t},
    (
    Integrate[Expand[f (UnitStep[y, r]^n + h), UnitStep[__]] + g, z, opts]
    ) /;
       Apply[Or, Map[
	( MatchQ[#, {x1_Symbol, a1_, b1_} /;
	       ( {x, a, b} = {x1, a1, b1};	
		 (NumberQ[N[a]] || Head[a] === DirectedInfinity) &&
		 (NumberQ[N[b]] || Head[b] === DirectedInfinity)
	       )
	  ] &&	
	  MemberQ[{y}, p_ /; PolynomialQ[p, x] && Exponent[p, x] == 1 &&
	       ( {d, c} = CoefficientList[p, x];
		 NumberQ[N[c]] && NumberQ[N[d]] &&
	         (t = -d/c; If[N[c] > 0, N[t] > N[a], N[t] < N[b]])
	       )
	  ]
	)&,
        {z}]]
  ]

	(* UnitStep with a polynomial argument (degree > 1) *)
Integrate[f_. UnitStep[y__?RuleFreeQ, r___Rule]^(n_.), z__List?((!OptionQ[#])&),
	 opts___?OptionQ] :=
  Module[{scan1, pos, new, newylist, expanded, integrand},
   (
   newylist = Delete[{y}, pos];
   expanded = Expand[new^n, UnitStep[__]];
   If[newylist === {},
	integrand = f expanded,
	integrand = f expanded UnitStep[Apply[Sequence, newylist], r]^n
   ];
   Integrate[integrand, z, opts]
   ) /; IntegerQ[n] && n >= 1 &&
	(scan1 =
          Scan[Module[{x, a, b, scan2},
	        If[MatchQ[#, {x1_Symbol, a1_, b1_} /;
	            ( {x, a, b} = {x1, a1, b1};	
		      (NumberQ[N[a]] || Head[a] === DirectedInfinity) &&
		      (NumberQ[N[b]] || Head[b] === DirectedInfinity)
	            )
	            ],
	               pos = 0;
	               scan2 =
	                Scan[Module[{p=#, solve},
		              pos++;
		              If[PolynomialQ[p, x] && Exponent[p, x] > 1 &&
		                   FreeQ[solve = Solve[p==0, x], Solve],
				 If[!Apply[Or, Map[FreeQ[#, Complex]&,
                                                N[solve] ]],
				    (* no real roots *)
                                       new = If[Limit[p, x->Infinity] > 0,
                                                1, 0],
				    (* at least one real root... filter out
					complex roots *)
				       solve = Select[solve, 
						FreeQ[N[#], Complex]&];
				       new = positiveIntervals[solve, p, x]
				 ];
				 Return[OK]	
		              ] 
		             ]&, (* end Module *)
		             {y}];
	               If[scan2 =!= OK, Return[$Failed]]
		]
	       ]&, (* end Module *)
               {z}];
         ValueQ[pos] && scan1 =!= $Failed
	)
  ] 

	(* In special cases, let definite integral evaluate to Infinity. *)
Integrate[(c_.) (a1_ + a2_. UnitStep[s_. t_, ___Rule]),
	{t_, -Infinity, Infinity}, opts___?OptionQ] :=
  Module[{factored, sign},
    (
    sign Infinity
    ) /; (factored = Factor[c(a1+a2 UnitStep[s t])];
	If[MatchQ[factored, c1_. t^n_. (-1 + 2 UnitStep[s t]) /;
	 IntegerQ[n] && n > 0 && OddQ[n] && FreeQ[sign = Sign[s c1], Sign]],
	     True,
	  If[MatchQ[factored, c1_. t^n_. (1 - 2 UnitStep[s t]) /;
	   IntegerQ[n] && n > 0 && OddQ[n] && FreeQ[sign = -Sign[s c1], Sign]],
	       True,
	       False
	]])
  ] 

(* The following rule applies when the indefinite integral evaluates
	(i.e., the function multiplying DiracDelta[x-x0] is smooth at x0). *)
Integrate[f_, {x_, a_, b_}, opts___?OptionQ] :=		
  Module[{F, lima, limb},
    (
    limb - lima
    )  /;	FreeQ[F = Integrate[f, x, opts], Integrate] &&
   (lima = If[TrueQ[Abs[a] == Infinity],
	      Limit[F, x->a, Direction -> Sign[a]],
	  (Limit[F, x->a, Direction -> -1] + Limit[F, x->a, Direction -> 1])/2];
    limb = If[TrueQ[Abs[b] == Infinity],
              Limit[F, x->b, Direction -> Sign[b]],
          (Limit[F, x->b, Direction -> -1] + Limit[F, x->b, Direction -> 1])/2];
    LimitFreeQ[{lima, limb}]) &&
   (FreeQ[N[lima], DirectedInfinity] || FreeQ[N[limb], DirectedInfinity])
  ] /; !USDDFreeQ[f] && FreeQ[f, Integrate] &&
	Apply[And, Map[((!OptionQ[#])&), {x, a, b} ]]

(* The following rule applies when the indefinite integral is unevaluated
    (i.e., the function multiplying DiracDelta[x-x0] is not smooth at x0). *)
Integrate[c_. + f_ DiracDelta[y_], {x_, a_, b_}] :=
  Module[{d0, d1, X, a1, b1},
    {d0, d1} = CoefficientList[y, x];  X = d0/d1;
    {a1, b1} = If[a < b, {a, b}, {b, a}];
    Which[
        Evaluate[X>-a1 || X<-b1],  0,
        Evaluate[X==-a1],  1/2 Limit[f,x->a1,Direction->-1],
        Evaluate[X==-b1],  1/2 Limit[f,x->b1,Direction-> 1],
        True,  1/2 (Limit[f,x->-X,Direction->-1]+Limit[f,x->-X,Direction->1])
    ]Sign[b-a]/Abs[d1] + Integrate[c, {x, a, b}]
  ] /; !FreeQ[f, x] && PolynomialQ[y, x] && Exponent[y, x] == 1 && a != b


(**************************** multiple integrals ****************************)

	(* Nest multiple integrals. *)
Integrate[f_, iseq__?((!OptionQ[#])&), opts___?OptionQ] :=
  Module[{result},
     (
     result
     )  /;  Module[{integrand = f, scan, head},
             scan = Scan[(head =
				Head[integrand = Integrate[integrand, #, opts]];
                         If[!(head =!= Integrate || integrand[[2]] =!= #),
                                Return[$Failed]])&,
                         Reverse[{iseq}]];
	     result = integrand;
	     scan =!= $Failed]
  ]  /;	 !USDDFreeQ[f] && Length[{iseq}] > 1


(**************************** indefinite integrals ****************************)

(* Integral of a univariate step function with linear argument. *)

Integrate[f_. UnitStep[y_, r___Rule]^(n_.), x_Symbol, opts___?OptionQ] :=
  Module[{F, F0, a, b, infy},  
   (
     SimplifyUnitStep[ (F - F0) UnitStep[a x + b, r] ]
   )  /; PolynomialQ[y, x] && Exponent[y, x] == 1 &&
	 ({b, a} = CoefficientList[y, x];
          DiracDeltaFreeQ[f, {{x -> -b/a}}] &&
	  FreeQ[F = Integrate[f, x, opts], Integrate]) &&
	 (infy = (Head[Power::infy] === $Off);  Off[Power::infy];
	  F0 = Limit[F, x -> -b/a, Analytic -> True];
          If[!infy, On[Power::infy]];
	  FreeQ[N[F0], DirectedInfinity] && F0 =!= Indeterminate)
  ] 


(* Integral of a univariate delta function with arbitrary argument.  Delta's
   located off the real line contribute 0. *)

Integrate[f_. DiracDelta[y_], x_Symbol, opts___?OptionQ] :=
  Module[{ifun, solution, select, derivative, fselect, infy},
   (
     Apply[Plus, Map[(UnitStep[x - (x /. #)])&, select] *
			fselect / Abs[derivative] ]
   )
    /; (ifun = (Head[Solve::ifun] === $Off);  Off[Solve::ifun];
	solution = Solve[y == 0, x];
	If[!ifun, On[Solve::ifun]];  Head[solution] === List) &&
	  solution =!= {{}} && (FreeQ[y, x] || solution =!= {}) &&
   (select = Select[solution, FreeQ[N[#], Complex]&];
	 (select === {} ||
    Apply[And, Map[!TrueQ[# == 0]&, (derivative = D[y, x] /. select)]])) &&
    DiracDeltaFreeQ[f, select] && SmoothQ[f, select] &&
    (* NOTE: need SmoothQ to check that the two directional limits are equal.
	If not equal limits, and the endpoints of the integral
	correspond to the singularity, then computing a definite integral
	from an indefinite integral will not work. *)
    (infy = (Head[Power::infy] === $Off);  Off[Power::infy];
     fselect = Map[Limit[f, #, Analytic->True] &, Flatten[select]];
     If[!infy, On[Power::infy]];
     FreeQ[N[fselect], DirectedInfinity] && FreeQ[fselect, Indeterminate])
  ]


(* Integral of a derivative of a univariate delta function with linear
	argument. *)
Integrate[f_. Derivative[n_Integer?Positive][DiracDelta][y_],
	 x_Symbol, opts___?OptionQ] :=
  Module[{f0, a, b, infy},
      (
	f0 Derivative[n-1][DiracDelta][a x + b] / a -
  	(1/a) Integrate[D[f,x] Derivative[n-1][DiracDelta][a x + b], x, opts]
      ) /; PolynomialQ[y, x] && Exponent[y, x] == 1 &&
	   ({b, a} = CoefficientList[y, x];
	    DiracDeltaFreeQ[f, {{x -> -b/a}}] && SmoothQ[f, {{x->-b/a}}]) &&
	   (infy = (Head[Power::infy] === $Off);  Off[Power::infy];
	    f0 = Limit[f, x-> -b/a, Analytic->True];
	    If[!infy, On[Power::infy]];
	    FreeQ[N[f0], DirectedInfinity] && f0 =!= Indeterminate)
  ]


(* Integral of a multivariate step function with linear arguments. *)

Integrate[f_. UnitStep[yseq__?RuleFreeQ, r___Rule]^(n_.), x_Symbol,
	 opts___?OptionQ] :=
  Module[{ylist, arg},
	(
      Apply[UnitStep, Join[Select[ylist, FreeQ[#, x]&], {r}]] *
		Integrate[f Apply[UnitStep, Join[arg, {r}]], x, opts]
	)
       /;  Length[ylist = {yseq}] > 1 &&
	   Length[arg = Select[ylist, (!FreeQ[#, x])&]] == 1 &&
	   PolynomialQ[arg[[1]], x] && Exponent[arg[[1]], x] == 1
  ] /; FreeQ[f, Integrate]
	

(* Integral of a multivariate delta function with arbitrary arguments. *)

Integrate[f_. DiracDelta[yseq__], x_Symbol, opts___?OptionQ] :=
  Module[{ylist, arg},
      (
      Apply[DiracDelta, Select[ylist, FreeQ[#, x]&]] *
		Integrate[f Apply[DiracDelta, arg], x, opts]
      ) /;  Length[ylist = {yseq}] > 1 &&
	   Length[arg = Select[ylist, (!FreeQ[#, x])&]] == 1
  ] /; FreeQ[f, Integrate] 
	

(* Integral of a multivariate delta function derivative with arbitrary
   arguments. *)

Integrate[f_. Derivative[n__Integer][DiracDelta][yseq__],
	 x_Symbol, opts___?OptionQ] :=
  Module[{ylist, pos},
      (
      Apply[Apply[Derivative, Drop[{n}, pos]] [DiracDelta], Drop[ylist, pos]] *
      Integrate[f Apply[Apply[Derivative, {n}[[pos]]] [DiracDelta],
		ylist[[pos]]], x, opts]	
       )  /; Length[ylist = {yseq}] > 1 &&
	  Length[pos = Flatten[Position[ylist, z_ /; !FreeQ[z, x], 1]]] == 1
  ] /; FreeQ[f, Integrate] 

Protect[Integrate]

DiracDeltaFreeQ[f_, solution_List] :=
  !Apply[Or, Map[TrueQ[# == 0]&, Flatten[
   Join[Cases[{f}, DiracDelta[__], Infinity] /. DiracDelta -> List,
	Cases[{f}, Derivative[__][DiracDelta][__], Infinity] /. 
			Derivative[__][DiracDelta] -> List] /. solution
					] ]]

SmoothQ[f_, solution_List] := 
     !Apply[Or, Map[Module[{limleft = Limit[f, #, Direction -> 1],
	                    limright = Limit[f, #, Direction -> -1]},
                   (LimitFreeQ[limleft] || LimitFreeQ[limright]) &&
	           limleft =!= limright]&,
	 solution]] 

(********************************** Simplify ********************************)

SimplifyDiracDelta[expr_] :=
  Module[{k0, expand, list, nodd, dd, ddcases, infy, xx, simplified = False},
     If[Head[expr] =!= Plus,
	k0 = 0; expand = Expand[expr],
	(* avoid expanding terms FreeQ of DiracDelta *)
	list = Apply[List, expr];
	nodd = Cases[list, z_ /; DDFreeQ[z]];
	dd = Cases[list, z_ /; !DDFreeQ[z]];
	k0 = Apply[Plus, nodd]; expand = Expand[Apply[Plus, dd]]
     ];
     ddcases = Cases[expand, DiracDelta[___], 2];
     expand = Collect[expand, ddcases];
     ddcases = Cases[expand, Derivative[n_][DiracDelta][___], 2];
     expand = Collect[expand, ddcases];
     While[MatchQ[expand, x_. + (a_.) (y_)^n_. DiracDelta[___, y_] /;
	(xx = x; FreeQ[a, y] && IntegerQ[n] && n > 0)],
	simplified = True; expand = xx];
     While[MatchQ[expand, x_. + (a_.) (y_)^m_Integer?Positive *
	Derivative[n__Integer?NonNegative][DiracDelta][x1___, y_, x2___] /;
	(xx = x; FreeQ[a, y] && Length[{n}] == Length[{x1, y, x2}] &&
	 m > {n}[[ Length[{x1}] + 1 ]])],
        simplified = True; expand = xx];	
     infy = (Head[Power::infy] === $Off);
     Off[Power::infy];
     While[MatchQ[expand, x_. + a_ DiracDelta[c1_. y_ + c0_.] /;
               (xx = x;
		Head[y]===Symbol && !NumericQ[y] && FreeQ[{c0, c1}, y] &&
		!FreeQ[a, y] && USDDFreeQ[a] &&
	        (0 === Simplify[a /. y :> -c0/c1]) &&
		Integrate[a DiracDelta[c1 y + c0], y] === 0)],
        simplified = True; expand = xx];
     While[MatchQ[expand, x_. +
	       a_ Derivative[n_Integer?Positive][DiracDelta][c1_. y_ + c0_.] /;
	       (xx = x;  FreeQ[{c0, c1}, y] &&
		!FreeQ[a, y] && USDDFreeQ[a] &&
		(0 === Simplify[a /. y :> -c0/c1]) &&
		Integrate[a Derivative[n][DiracDelta][c1 y + c0], y] === 0)],
        simplified = True; expand = xx];
     If[!infy, On[Power::infy]];
     While[MatchQ[expand, x_. + a0_. DiracDelta[c1_. y_ + c0_.] +
	      a1_. Derivative[n_Integer?Positive][DiracDelta][c1_. y_ + c0_.] /;
	       (xx = x;  FreeQ[{c0, c1}, y] &&
		(!FreeQ[a0, y] || !FreeQ[a1, y]) &&
		 USDDFreeQ[{a0, a1}] &&
		Integrate[a0 DiracDelta[c1 y + c0] + a1 *
		 Derivative[n][DiracDelta][c1 y + c0], y] === 0)],
        simplified = True; expand = xx];
     If[simplified,
	 expand + k0,
	 expr]
  ] /; (Position[expr, DiracDelta[___, a_. y_Symbol + b_.] /;
	         FreeQ[{a, b}, y]] =!= {}) ||
       (Position[expr,
	 Derivative[n__Integer?NonNegative][DiracDelta][___,
	    a_. y_Symbol + b_.] /; FreeQ[{a, b}, y]] =!= {})

SimplifyDiracDelta[expr_] := expr

SimplifyUnitStep[expr_] :=
   Module[{new = expr //. ToUniRules, originalLength = Length[cases[expr]],
	    convertTomulti, sum, newLength},
	convertTomulti = originalLength < Length[cases[new]];
	new = simplifyExpandedUS[ collect[new, {UnitStep[__]}] ];
        new = new //. Sum :> sum;
	new = new //.
	  {(c0_. + c1_. UnitStep[p__]^m_.)(d0_. + d1_. UnitStep[q__]^n_.) :>
	   c0 d0 + c0 d1 UnitStep[q]^n + c1 d0 UnitStep[p]^m +
		c1 d1 UnitStep[p]^m UnitStep[q]^n};
	new = new //. sum :> Sum;
	new = new //. UnitStepRules;
	new = simplifyExpandedUS[new];
	new = Collect[new, Union[cases[new]]];
	If[convertTomulti, new = new //. ToMultiRules];
	newLength = Length[cases[new]];
	Which[newLength < originalLength, new,
	      newLength == originalLength,
		If[LeafCount[new] < LeafCount[expr], new, expr],
	      True, expr]	
   ]   /; !USFreeQ[expr] && Head[expr] =!= Integrate

SimplifyUnitStep[expr_] := expr


simplifyExpandedUS[a_?(USFreeQ[#]&) +
	(b:(_?(USFreeQ[#1]&) UnitStep[__] | UnitStep[__])..)] :=
	Simplify[a] + Plus[b]

simplifyExpandedUS[expr_] := expr

cases[expr_] := Join[Cases[{expr}, UnitStep[__], Infinity],
		Cases[{expr}, DiracDelta[__], Infinity],
		Cases[{expr}, Derivative[__][DiracDelta][__], Infinity]]


UnitStepRules = {
		 (* reduce a product of UnitSteps to a single UnitStep *)
		 UnitStep[c1_. x_Symbol + d1_., r1___Rule] * 
		 UnitStep[c2_. x_ + d2_., r2___Rule] :>
		    Module[{t1 = N[d1/c1], t2 = N[d2/c2]},
		      If[N[c1] > 0 ,
			    If[t1 > t2, UnitStep[c2 x + d2, r2],
				        UnitStep[c1 x + d1, r1]],
		            If[t1 > t2, UnitStep[c1 x + d1, r1],
				        UnitStep[c2 x + d2, r2]]
		      ]] /; Apply[And, Map[NumberQ, N[{c1, c2, d1, d2}]]] &&
			    N[d2/c2] != N[d1/c1] && Sign[c1] == Sign[c2],
		 (* reduce a product of UnitSteps to 0 *)
                 UnitStep[c1_. x_Symbol + d1_., r1___Rule] * 
		 UnitStep[c2_. x_ + d2_., r2___Rule] :> 0 /;
		       Apply[And, Map[NumberQ, N[{c1, c2, d1, d2}]]] &&
		       N[d2/c2] != N[d1/c1] && Sign[c1] != Sign[c2] &&
		       ((N[c1] > 0 && N[d1/c1] < N[d2/c2]) ||
			(N[c2] > 0 && N[d2/c2] < N[d1/c1])),
		 (* reduce a product of UnitStep & a shifted DiracDelta
		    to DiracDelta or zero *)
                 UnitStep[c1_. x_Symbol + d1_., r___Rule] *
		 DiracDelta[c2_. x_ + d2_.] :>
		    ((
		    If[(N[c1] > 0 && N[d2/c2] < N[d1/c1]) ||
		       (N[c1] < 0 && N[d2/c2] > N[d1/c1]),
		       DiracDelta[c2 x + d2], 0]) /;
		       Apply[And, Map[NumberQ, N[{c1, c2, d1, d2}]]] &&
		       N[d2/c2] != N[d1/c1]   ),
		 (* reduce a product of UnitStep & a shifted DiracDelta'
		    to DiracDelta' or zero *)
                 UnitStep[c1_. x_Symbol + d1_., r___Rule] *
		 Derivative[n_Integer?Positive][DiracDelta][c2_. x_ + d2_.] :>
  		    ((
		    If[(N[c1] > 0 && N[d2/c2] < N[d1/c1]) ||
		       (N[c1] < 0 && N[d2/c2] > N[d1/c1]),
		       Derivative[n][DiracDelta][c2 x + d2], 0]) /;
		       Apply[And, Map[NumberQ, N[{c1, c2, d1, d2}]]] &&
		       N[d2/c2] != N[d1/c1]   ),
		(* reduce a sum of UnitSteps to a single UnitStep *)
		c_. UnitStep[a_. x_ + b_., r1___Rule] +
		d_. UnitStep[a_. x_ + b_., r2_Rule] :>
		 (
		  (* NOTE: added the r2 here... probably should keep that
				info around *)
		  (c+d) UnitStep[a x + b, r2]
	         ) /; USFreeQ[{c,d}] &&
				!SameQ[{r1}, {r2}] &&
				SameQ[ZeroValue /. {r1} /. Options[UnitStep],
				      ZeroValue /. r2],
		(* reduce a sum of UnitSteps to a single UnitStep *)
		(* 921104: ecm: added rules for case where ZeroValue = 1/2 *)
		x_. + a_. UnitStep[k1_. - y_, r___Rule] +
			b_. UnitStep[k2_. + y_Symbol, r___Rule] :>
		     (
			(x + a + Simplify[b-a]*UnitStep[k2 + y, r])
		     ) /; ((ZeroValue //. {r} //. Options[UnitStep]) == 1/2) &&
			USFreeQ[{a,b,k1,k2}] && k1+k2 === 0,
		(* change the sign of a UnitStep[, ZeroValue->1/2] if the
			result is simpler *)
		c_. + x_. + a_. UnitStep[k2_. y_Symbol, r___Rule] :>
		   Module[{result},
		     (
			x + result
		     ) /; (result = Simplify[c + a - a UnitStep[- k2 y, r]];
			   LeafCount[result] <
			   	LeafCount[c + a UnitStep[k2 y, r]])   
		   ] /; ((ZeroValue //. {r} //. Options[UnitStep]) == 1/2) &&
			USFreeQ[c] && FreeQ[x, UnitStep[-k2 y, r]],
		(* reduce a product of UnitStep & DiracDelta to DiracDelta *)
		(* j.a.:  added rule  *)
		UnitStep[x_, r1___Rule] * DiracDelta[x_] :>
		  Module[{r},
		    r = ZeroValue /. {r1} /. Options[UnitStep];
		    r DiracDelta[x]
		  ],    
		(* reduce a product of UnitStep & DiracDelta' to DiracDelta' *)
		UnitStep[x_, r1___Rule] * Derivative[n_][DiracDelta][x_] :>
		  Module[{r},
		    r = ZeroValue /. {r1} /. Options[UnitStep];
		    r Derivative[n][DiracDelta][x]
		  ]
		}

ToUniRules = {UnitStep[x__?RuleFreeQ, r___Rule] :>
	        Apply[Times, Map[UnitStep[#, r]&, {x}]] /; Length[{x}] > 1,
	      DiracDelta[x__] :>
	        Apply[Times, Map[DiracDelta, {x}]] /; Length[{x}] > 1,
	      Derivative[n__][DiracDelta][x__] :>
		Apply[Times, Map[Derivative[#[[1]]][DiracDelta][#[[2]]]&,
			Transpose[{{n}, {x}}] ]] /; Length[{x}] > 1}

ToMultiRules = {UnitStep[x__?RuleFreeQ, r___Rule] *
		UnitStep[y__?RuleFreeQ, r___Rule] :>
			Apply[UnitStep, Join[{x}, {y}, {r}]],
		DiracDelta[x__] * DiracDelta[y__] :>
			Apply[DiracDelta, Join[{x}, {y}]],
		Derivative[m__][DiracDelta][x__] *
		Derivative[n__][DiracDelta][y__] :>
			Apply[Apply[Derivative, Join[{m}, {n}]][DiracDelta],
			      Join[{x}, {y}]],
		UnitStep[x_?RuleFreeQ, r___Rule]^n_Integer?Positive :>
			Apply[UnitStep[#, r]&, Table[x, {n}]],
		DiracDelta[x_]^n_Integer?Positive :>
			Apply[DiracDelta, Table[x, {n}]],
		(Derivative[m_][DiracDelta][x_])^n_Integer?Positive :>
			Apply[Apply[Derivative, Table[m, {n}]][DiracDelta],
				Table[x, {n}]]}

(***************************** specialized FreeQ ****************************)

RuleFreeQ[expr_] := FreeQ[expr, Rule]
USFreeQ[expr_] := FreeQ[expr, UnitStep]
DDFreeQ[expr_] := FreeQ[expr, DiracDelta]
USDDFreeQ[expr_] := USFreeQ[expr] && DDFreeQ[expr]
LimitFreeQ[expr_] := FreeQ[expr, Limit]

(****************************** collect utility ****************************)

(* check for a pattern that doesn't need collecting *)
collect[c0_. + c1_. x_, pattern_List] :=
   (
    c0 + c1 x 
   ) /; USDDFreeQ[{c0, c1}] &&
	(MemberQ[pattern, UnitStep[__]] ||
         MemberQ[pattern, DiracDelta[__]] ||
         MemberQ[pattern, Derivative[__][DiracDelta][__]]) &&
	(MatchQ[x, UnitStep[__] | UnitStep[__]^_Integer?Positive |
		  DiracDelta[__] | Derivative[__][DiracDelta][__]] ||
	 MatchQ[x, HoldPattern[Times[
	  (UnitStep[__] | UnitStep[__]^_Integer?Positive |
	   DiracDelta[__] | Derivative[__][DiracDelta][__]).. ]]])

(* only Expand terms involving patterns in the specified list *)
collect[(expr_)^n_Integer?Positive, pattern_List] :=
  Module[{cases, varlist, output},
	cases = Apply[Union, Map[Cases[{expr}, #, Infinity]&, pattern]];
	varlist = Flatten[Map[If[PolynomialQ[expr, #], #, {}]&, cases]];
	output = Expand[(Collect[expr, varlist])^n, First[pattern] ];
	Scan[(output = Expand[output, #])&, Rest[pattern]];
	output
  ]

collect[expr_, pattern_List] :=
  Module[{cases, varlist, output},
	cases = Apply[Union, Map[Cases[{expr}, #, Infinity]&, pattern]];
        varlist = Flatten[Map[If[PolynomialQ[expr, #], #, {}]&, cases]];
	output = Expand[Collect[expr, varlist], First[pattern]];
	Scan[(output = Expand[output, #])&, Rest[pattern]];
        output
  ]


(****************************** positiveIntervals ****************************)

positiveIntervals[solve_, p_, x_] :=
  Module[{usolve = Union[solve], pts, intervals, signs, l, index},
    pts = Map[#[[2]]&, Flatten[usolve]];
    intervals =  Transpose[{Drop[pts, -1], Drop[pts, 1]}];
    signs = Map[Sign[p /. x -> #]&, Map[Apply[Plus, #]/2 &, intervals] ];
    l = Length[intervals];
    intervals = {{-Infinity, intervals[[1, 1]]}} ~Join~
	        intervals ~Join~
		{{intervals[[l, 2]], Infinity}};	
    signs = {Sign[Limit[p, x->-Infinity]]} ~Join~
		signs ~Join~
	    {Sign[Limit[p, x->Infinity]]};	
    index = 1;
    While[index < Length[signs],
	If[signs[[index]] == signs[[index+1]],
	   signs = Delete[signs, index + 1];
	   intervals = Take[intervals, index-1] ~Join~
		{{intervals[[index, 1]], intervals[[index+1, 2]]}} ~Join~
		       Drop[intervals, index+1]
	];
	index++
    ];
    intervals = Map[intervals[[#]]&, Flatten[Position[signs, 1]]]; 
    Apply[Plus, Map[
	Switch[#,
	  {DirectedInfinity[-1], bb_}, UnitStep[#[[2]] - x],
	  {aa_, DirectedInfinity[1]}, UnitStep[x - #[[1]]],
	  {aa_, bb_}, UnitStep[x - #[[1]]]*UnitStep[#[[2]] - x]
	]&, intervals]] 
  ]



(*************************** miscellaneous definitions ************************)

(* zero distribution, Abs', and simplifying the sign of the arg of DiracDelta
   or Derivative[_][DiracDelta] *)
 
DiracDelta /: UnitStep[z__?RuleFreeQ, r___Rule] *
  DiracDelta[x___, a_. y_Symbol + b_.] :=
    Module[{},
      (
	(UnitStep[z, r] /. y -> -b/a) * DiracDelta[x, a y + b]
      ) /; !MemberQ[{z} /. y -> -b/a, 0]
    ] /; !FreeQ[{z}, y] && NumberQ[N[a]] && NumberQ[N[b]]

DiracDelta[a_ b_., y___] := DiracDelta[Abs[a] b, y] /; Negative[N[a]]
DiracDelta[x_Plus, y___] :=
	DiracDelta[ Apply[Plus, Map[(-#)&, Apply[List, x] ]] ] /;
	Apply[And, Map[MatchQ[#, a_ b_. /; Negative[N[a]]]&, Apply[List, x] ]]

Derivative /: y_ Derivative[1][Abs][y_] := Abs[y]

Derivative[n_Integer][Abs][y_] := 2 D[DiracDelta[y], {y, n-2}] /; n>=2

Derivative[n__Integer?NonNegative][DiracDelta][y1___, a_ b_., y2___] :=
  (
   (-1)^({n}[[ Length[{y1}] + 1 ]]) *
		Derivative[n][DiracDelta][y1, Abs[a] b, y2]
  ) /; Negative[N[a]] && Length[{n}] == Length[{y1, a b, y2}]

Derivative[n__Integer?NonNegative][DiracDelta][y1___, x_Plus, y2___] :=
  (
   (-1)^({n}[[ Length[{y1}] + 1 ]]) *
        Apply[ Derivative[n][DiracDelta],
               Join[{y1}, {Apply[Plus, Map[(-#)&, Apply[List, x] ]]}, {y2}] ]
  ) /; Apply[And, Map[MatchQ[#, a_ b_. /; Negative[N[a]]]&, Apply[List, x] ]] &&
   	Length[{n}] == Length[{y1, x, y2}]


(*****************************************************************************)

Protect[DiracDelta]
Protect[UnitStep]

End[]

EndPackage[]



