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$
4
  • 1
    $\begingroup$ Are all your functions quadratic? $\endgroup$
    – Öskå
    May 14, 2014 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, 2014 at 16:04
  • 1
    $\begingroup$ Please edit your question with a non quadratic one. $\endgroup$
    – Öskå
    May 14, 2014 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, 2014 at 16:15

3 Answers 3

7
$\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$

This site is temporarily in read-only mode and not accepting new answers.

Not the answer you're looking for? Browse other questions tagged .