2
$\begingroup$

I have the product of some Heaviside functions or sign functions, a simple example could be:

HeavisideTheta[q^2 - 4]*Sign[q - 3]

Another slightly more complicated example, involving a quartic function could be:

HeavisideTheta[Sqrt[((q - 3)^2 - 10)^2 + 15] - 8]

Clearly the resulting function will be composed of many steps, so I would like to convert it to a piecewise function. For the example before, the result would be:

Piecewise[{{-1, q <= -2}, {0, -2 < q <= 2}, {-1, 2 <= q < 3}}, 1]

Except for (maybe) a zero measure set, for which I don't care. Many times the variable appears quadratically or quartically inside the functions, so solving to find the zero may be non trivial, but it can always be done exactly by Solve[] or Reduce[].

I need to repeat this procedure a lot of times, so I would like to automate the procedure... Is there a way to teach Mathematica how to do it?

$\endgroup$
  • 1
    $\begingroup$ Are all your functions quadratic? $\endgroup$ – Öskå May 14 '14 at 15:39
  • $\begingroup$ No, they are not. Some of them are quartic, however it's possibile to find the zeroes of each one analytically. $\endgroup$ – zakk May 14 '14 at 16:04
  • 1
    $\begingroup$ Please edit your question with a non quadratic one. $\endgroup$ – Öskå May 14 '14 at 16:07
  • $\begingroup$ Done. Actually it's not a quartic strictly speaking, but while solving the equation in order to find the zeroes, you get a quartic and so you get 4 solutions in the end. $\endgroup$ – zakk May 14 '14 at 16:15
4
$\begingroup$

We can use PiecewiseExpand.

ToPiecewise[f_] := PiecewiseExpand[f /. {
  (HeavisideTheta | UnitStep)[x_] :> Piecewise[{{1, x >= 0}, {0, x < 0}}], 
  Sign[x_] :> Piecewise[{{1, x > 0}, {0, x == 0}, {-1, x < 0}}]
}]

On your examples:

ToPiecewise[HeavisideTheta[q^2 - 4]*Sign[q - 3]]
(* Piecewise[{{-1, 2 <= q < 3 || q <= -2}, {1, q > 3}}, 0] *)

ToPiecewise[HeavisideTheta[Sqrt[((q - 3)^2 - 10)^2 + 15] - 8]]
(* Piecewise[{{1, Sqrt[15 + (-10 + (-3 + q)^2)^2] >= 8}}, 0] *)

We can also incorperate Reduce if we supply a variable:

ToPiecewise[f_, z_] := PiecewiseExpand[f /. {
  (HeavisideTheta | UnitStep)[x_] :> Piecewise[{{1, Reduce[x >= 0, z, Reals]}, {0, Reduce[x < 0, z, Reals]}}], 
  Sign[x_] :> Piecewise[{{1, Reduce[x > 0, z, Reals]}, {0, Reduce[x == 0, z, Reals]}, {-1, Reduce[x < 0, z, Reals]}}]
}]

Your example:

ToPiecewise[HeavisideTheta[Sqrt[((q - 3)^2 - 10)^2 + 15] - 8], q]
(* Piecewise[{{1, 3 - Sqrt[3] <= q <=  3 + Sqrt[3] || q >= 3 + Sqrt[17] || q <= 3 - Sqrt[17]}}, 0] *)
$\endgroup$
1
$\begingroup$

You can try solving for the arguments HeavisideTheta and Sign and combine the roots. Since they are in product form root of individual function will also be a root.

Aleternatively you can produce a data set and find the Interpolation like

data = Table[{q, HeavisideTheta[q^2 - 4]*Sign[q - 3]}, {q, -4, 4, .1}];
f = Interpolation[data];
Plot[f[x], {x, -4, 4}]
FindRoot[f[x] == 0, {x, 3}]

You can't use Solve because your function, due to the HeavisideTheta will be 0 over a region which means infinite solution. So only significant solution will come from the argument of Sign which will give the point where your function cut the zero axis (provided HeavisideTheta is not zero there). FindRoot would be more efficient choice but you have to be careful about the initial value, or else you may be lost forever.

$\endgroup$
1
$\begingroup$

I do admit that it's pretty ugly but here is an approach:

expr[q_] := HeavisideTheta[q^2 - 4]*Sign[q - 3]
bounds = Sort@Flatten[expr[q] /. 
  Times[a_, b_] :> {a, b} /. 
  {HeavisideTheta[a_] :> Re /@ N@Solve[a == 0, First@Variables@a][[All, 1, 2]], 
   Sign[Plus[a_, b_]] :> Abs@a, Sign[_] :> 0}];
b = Flatten[{{Prepend[{bounds[[1]]}, x]}, 
  Riffle[bounds[[#]], x] & /@ 
    Partition[Delete[Delete[Flatten[{#, #} & /@ Range@Length@bounds], -1], 1], 2]}, 1];
lb = LessEqual @@@ b;
oob = With[{l = Cases[#, _?NumberQ]}, If[Length@l < 2, Flatten@{2*l, l}, l]] &;
value = With[{q = #}, expr[q]] & /@ (RandomReal[#] & /@ oob /@ b);

Show@{
  Plot[expr@x, {x, -5, 5}, PlotStyle -> {Red, Dotted, Thick}],
  Plot[Piecewise[{#1, #2} & @@@ Thread[{value, lb}], 
    HeavisideTheta@Last@bounds], {x, -5, 5}, PlotStyle -> Dashed]}

Mathematica graphics

With

expr[q_] := HeavisideTheta[Sqrt[((q - 3)^2 - 10)^2 + 15] - 8]*Sign[-3 + q];

Mathematica graphics

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.