0
$\begingroup$

I have defined a function that produces a single negative impulse spanning -b to -a and a positive impulse spanning a to b, and gives 0 for all other values of x (for real x). I then adjust the function so that the area under each single impulse is always equal to -1 or 1. So:

f[x_] := If[x < -b, 0, If[-b <= x <= -a, 
 -((Cos[Pi*((x + (a + b)/2)/((b - a)/2))] + 1)/(b - a)), 
 If[-a < x < a, 0, If[a <= x <= b, (Cos[Pi*((x + (a + b)/2)/((b - a)/2))] + 1)/
    (b - a), 0]]]]

Here's a plot to show what I'm after:

Plot[{f[x] /. a -> 1 /. b -> 2}, {x, -3, 3}, PlotLegends -> "Expressions"]

enter image description here

This pattern should hold true for all values of a<b, no? However, it seems to fail for some values of a and b, and for positive x (but only for positive x, despite the function being so obviously odd). For example

Plot[{f[x] /. a -> 0 /. b -> 1, f[x] /. a -> 1 /. b -> 3, 
f[x] /. a -> 2 /. b -> 5, f[x] /. a -> 3 /. b -> 7, 
f[x] /. a -> 4 /. b -> 9}, {x, -10, 10}, PlotRange -> Full, 
PlotLegends -> "Expressions"]

produces

enter image description here

What am I doing wrong?

$\endgroup$
  • $\begingroup$ Thanks to JM for the answer below. I'll mark it as answered shortly. But first, would you mid explaining why it didn't work the way I had it? Is the function itself in error, or is this a MMA issue? $\endgroup$ – Richard Burke-Ward Sep 28 '18 at 12:14
  • $\begingroup$ Debugging is a bit more work; if you don't mind waiting a bit, I'll write an extension much later. $\endgroup$ – J. M. will be back soon Sep 28 '18 at 12:29
  • $\begingroup$ I don't mind waiting at all. Would prefer to get to the bottom of it if poss. Thanks so much. $\endgroup$ – Richard Burke-Ward Sep 28 '18 at 13:04
2
$\begingroup$

One can judiciously combine Haversine[], Rescale[], and Clip[]:

twinpulse[x_, {a_, b_}] /; 0 <= a < b := 
    2 Sign[x] Haversine[Clip[Rescale[Abs[x], {a, b}, {0, 2 π}], {0, 2 π}]]/(b - a)

Plot[Table[twinpulse[x, sp], {sp, {{0, 1}, {1, 3}, {2, 5}, {3, 7}, {4, 9}}}] // Evaluate,
     {x, -10, 10}, PlotRange -> Full]

pulses


How to invent a function

I'll go over through the thought process I had in coming up with this solution, and along the way point out what was the problem with the OP's solution.

Some prerequisites: recall that the haversine can be expressed as

$$\operatorname{hav}(x)=\frac{1-\cos x}{2}=\sin^2\frac{x}{2}$$

It is a $2\pi$-periodic function, so one can restrict attention to the interval $[0,2\pi]$:

Plot[Haversine[x], {x, 0, 2 π}]

haversine

which is in the right shape for a pulse.

The OP gave two additional stipulations for the pulse: it should range over $[a,b]$, and it should have unit area. However, the haversine ranges over $[0,2\pi]$ naturally, so a change of variables is needed.

Mathematica has a built-in function, Rescale[], which can remap one interval to another. For this situation, we want a function that remaps the given interval $[a,b]$ to the haversine's natural interval $[0,2\pi]$:

Rescale[x, {a, b}, {0, 2 π}] // Together // Factor
   2 π (a - x)/(a - b)

which can now be composed with the haversine:

Haversine[Rescale[x, {a, b}, {0, 2 π}] // Factor] // FunctionExpand
   (1 - Cos[(2 π (a - x))/(a - b)])/2

At once, we spot a difference between this and the OP's expression: the OP's expression uses $1+\cos(\cdot)$, and a different shift $(a+b)/2$.

From here, we also need to impose the unit area constraint. That means we have to divide by the function by its integral over $[a,b]$:

Assuming[a < b, Integrate[(1 - Cos[(2 π (a - x))/(a - b)])/2, {x, a, b}]]
   (-a + b)/2

We're almost there! Now, the OP only wanted a single pulse, while haversine is actually a periodic function. Conveniently, haversine is zero at both ends of the interval, so we just need to add a Clip[] to restrict the result of Rescale[] before it gets passed to the haversine:

2 Haversine[Clip[Rescale[x, {a, b}, {0, 2 π}], {0, 2 π}]]/(b - a)

This shows only one pulse, so we need one last transformation. We replace x with Abs[x] and multiply by Sign[x], which enforces the odd function condition. We finally have

2 Sign[x] Haversine[Clip[Rescale[Abs[x], {a, b}, {0, 2 π}], {0, 2 π}]]/(b - a)

which was the expression I used above.

Expressed more conventionally,

Assuming[x ∈ Reals && 0 <= a < b, 
         FullSimplify[FunctionExpand[PiecewiseExpand[
         2 Sign[x] Haversine[Clip[Rescale[Abs[x], {a, b}, {0, 2 π}], {0, 2 π}]]/(b - a)]]]]

$$\begin{cases} -\frac{2 \sin ^2\left(\frac{\pi (a-x)}{a-b}\right)}{a-b} & x>0\land 0\leq \frac{\pi (a-x)}{a-b}\leq \pi \\ \frac{2 \sin ^2\left(\frac{\pi (a+x)}{a-b}\right)}{a-b} & x<0\land 0\leq \frac{\pi (a+x)}{a-b}\leq \pi \end{cases}$$

$\endgroup$
  • $\begingroup$ This is totally awesome, and now marked as answered. But can I ask: what did I do wrong in the first place? You have totally reconstructed the function for me, and I'm hugely grateful; but I'm still not clear why my version didn't work... $\endgroup$ – Richard Burke-Ward Sep 28 '18 at 15:03
  • $\begingroup$ As I said: you has used $1+\cos(\cdot)$ instead of haversine's $1-\cos(\cdot)$, and you had used the wrong shift of variable x + (a + b)/2. $\endgroup$ – J. M. will be back soon Sep 28 '18 at 15:05
  • $\begingroup$ Hmmm... OK, will have to think about that. Not clear to me why haversine is the way to go. But your solution works, and I'm very grateful. $\endgroup$ – Richard Burke-Ward Sep 28 '18 at 15:17
  • $\begingroup$ If you really want to use $1+\cos$, then you need to rescale $[a,b]$ to $[-\pi,\pi]$: spot the difference between the result of Rescale[x, {a, b}, {-π, π}] and what you used in your formula. $\endgroup$ – J. M. will be back soon Sep 28 '18 at 15:24
  • $\begingroup$ OK, getting there now. Much appreciated. $\endgroup$ – Richard Burke-Ward Sep 28 '18 at 15:25

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.