4
$\begingroup$

Here's the output that I wish to have:

sinusoid

I have tried to use this code, to finish almost 75% of the work. How to get the final result?

f[\[Alpha]_, a_] := 5*(Sin[\[Alpha]*a]/(\[Alpha]*a)) + Cos[\[Alpha]*a]

Block[{a = 1}, Plot[Sin[\[Alpha]*a]/(\[Alpha]*a), {\[Alpha], -12, 12}, Ticks -> {Range[-4*Pi, 4*Pi, Pi], Automatic}]]

Block[{a = 1}, Plot[Cos[\[Alpha]*a], {\[Alpha], -12, 12}, Ticks -> {Range[-4*Pi, 4*Pi, Pi], Automatic}, AspectRatio -> 1/2]]

test = Plot[f[\[Alpha], 1], {\[Alpha], -13, 13}, Ticks -> {Range[-4*Pi, 4*Pi, Pi], Automatic}]

Show[test, Graphics[{Dashed, Line[{{-13, 1}, {13, 1}}]}], Graphics[{Dashed, Line[{{-13, -1}, {13, -1}}]}]]

I also wish to animate the plot. Any help in this regard would be beneficial!

$\endgroup$
2
  • $\begingroup$ Hi codebpr, what is k in your last image, and what parameter do you want to animate? $\endgroup$
    – alex
    Apr 6, 2023 at 8:29
  • $\begingroup$ I wished to show the wave in motion. k is akin to \[Alpha] $\endgroup$
    – codebpr
    Apr 6, 2023 at 12:09

2 Answers 2

4
$\begingroup$

I hope the following code will work for you. You can find many resources on how to animate from a Manipulate, but using the Plotter function you can either generate a table of 'frames' and then Rasterize and animate, or some other method you prefer.

In the following code you can manipulate both the lower and upper solutions as well as the coefficient for your function.

Clear[f, Plotter]
f[\[Alpha]_, a_] := 5*(Sin[\[Alpha]*a]/(\[Alpha]*a)) + Cos[\[Alpha]*a];

Plotter[val_ : 1, roots_ : {-1, 1}] := 
 Block[{x, solsRange, sols, pos, intervals, diffs},
  solsRange = {-5 \[Pi], 5 \[Pi]}; (*
  region to look for solutions of the function *)
  sols = Sort[Flatten[{
      {x, roots[[1]]} /. 
       NSolve[f[x, val] == roots[[1]] &&  
         solsRange[[1]] <= x <= solsRange[[2]], x],
      {x, roots[[2]]} /. 
       NSolve[f[x, val] == roots[[2]] &&  
         solsRange[[1]] <= x <= solsRange[[2]], x]}, 1]](*
  assumes that two solutions are needed, 
  but you can expand it or generalise with MapThread *);
  diffs = Abs@Differences[sols[[;; , 2]], 1];
  pos = Flatten[
    Position[diffs, Select[Union[diffs], # != 0 &][[1]]]]; (* 
  finds the points where there is discontinuity between solutions*)
  intervals = MapThread[sols[[{#, # + 1}]] &, {pos}]; (* 
  generates the intervals for the rectangles *)
  
  Plot[f[\[Alpha], val], {\[Alpha], -13, 13}, 
   Ticks -> {Range[-4*Pi, 4*Pi, Pi], Automatic}, PlotStyle -> Orange,
   Prolog -> {LightBlue, EdgeForm[Thin], 
     Apply[Rectangle, #] & /@ intervals}, 
   Epilog -> {Gray, Dashed, 
     Line[{{solsRange[[1]], roots[[1]]}, {solsRange[[2]], 
        roots[[1]]}}], 
     Line[{{solsRange[[1]], roots[[2]]}, {solsRange[[2]], 
        roots[[2]]}}]}] (* plots *)]

enter image description here

If you want to also show the other two plots you can also wrap them all under a Grid.

Manipulate[
 Grid@{{Plot[Sin[\[Alpha]*val]/(\[Alpha]*val), {\[Alpha], -12, 12}, 
     Ticks -> {Range[-4*Pi, 4*Pi, Pi], Automatic}]}, {Plot[
     Cos[\[Alpha]*val], {\[Alpha], -12, 12}, 
     Ticks -> {Range[-4*Pi, 4*Pi, Pi], Automatic}, 
     AspectRatio -> 1/2]}, {Plotter[val, {root1, root2}]}}, {val, 1, 
  3}, {{root1, -1}, -2, 0}, {{root2, 1}, 0, 2}]

enter image description here

Let me know if this answered your question. If you want to Export it, then you can find many good resources on SE. Good luck! :)

$\endgroup$
4
$\begingroup$
Clear["Global`*"];
f[α_, a_] := 5*(Sin[α*a]/(α*a)) + Cos[α*a];
{lower, upper} = {-1, 1};
intervals = 
  Reduce[{lower <= f[α, 1] <= upper, -13 <= α <= 
     13}, α];
filling = 
  Plot[{f[α, 1], f[α, 1]}, α ∈ 
    ImplicitRegion[intervals, {α}], 
   Filling -> {1 -> Top, 2 -> Bottom}, FillingStyle -> Cyan, 
   PlotStyle -> None];
Plot[f[α, 1], {α, -13, 13}, 
 Ticks -> {Range[-4*Pi, 4*Pi, Pi], Automatic}, PlotStyle -> Blue, 
 Prolog -> {First@filling, Dashed, InfiniteLine[{0, lower}, {1, 0}], 
   InfiniteLine[{0, upper}, {1, 0}]}]

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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