2
$\begingroup$

I have the following equation 

p = 1.6; α = 0.001; r = 0.6; η = 0.04; ω = 1;
R ω p Sin[ω τ] + R ω p α - 9/4 r p R^3 ω - η p R == 0

I want to plot τ in x axis in increasing and decreasing direction that is from 0 to 20 and then 20 to 0 and R in Y axis. For this I have used the following command

Show[ContourPlot[R ω p Sin[ω τ] + R ω p α - 9/4 r p R^3 ω - η p R == 0, 
   {τ, 0, 20}, {R, 0, 2}, ContourStyle -> {Directive[Blue, Thick]}], 
 ContourPlot[R ω p Sin[ω τ] + R ω p α - 9/4 r p R^3 ω - η p R == 0, 
   {τ, 20, 0}, {R, 0, 2}, ContourStyle -> {Directive[Green, Thick]}]]

But this is not working. Please suggest what modification I need to do.

|improve this question
$\endgroup$
2
$\begingroup$

Maybe this (playing with Overlay and setting enough space in the plots for correct aligment)?:

 pls = ContourPlot[
     R \[Omega] p Sin[\[Omega] \[Tau]] + R \[Omega] p \[Alpha] - 
   9/4 r p R^3 \[Omega] - \[Eta] p R == 0, {\[Tau], 0, 20}, {R, 0,
   2}, ContourStyle -> {Directive[#[[1]], Thick]}, 
   PlotRange -> {Automatic, {0, 2}}, GridLines -> Automatic, 
 Frame -> #[[2]], FrameTicks -> #[[3]], 
 ScalingFunctions -> #[[4]], ImageMargins -> 10, 
 ImagePadding -> 20] & /@ {{Blue, {{True, True}, {True, False}}, {{All, All}, {All, None}}, None},
 {Red, {{True, True}, {False, True}}, {{All, All}, {None, All}}, {"Reverse", None}}};

 Overlay[pls, Alignment -> Center]

enter image description here

|improve this answer
$\endgroup$
  • $\begingroup$ actually I want to plot the same equation with increasing and with decreasing tau $\endgroup$ – Udichi Feb 2 '18 at 11:04
  • $\begingroup$ @Udichi See my last edit $\endgroup$ – José Antonio Díaz Navas Feb 2 '18 at 11:52
  • $\begingroup$ thank you this is what I am looking for however when I am trying to execute this command in my notebook its not working I am not getting any figure $\endgroup$ – Udichi Feb 2 '18 at 14:17
  • $\begingroup$ What MMA version are you using? $\endgroup$ – José Antonio Díaz Navas Feb 2 '18 at 14:18
  • $\begingroup$ I am using 11.0 $\endgroup$ – Udichi Feb 2 '18 at 14:21
2
$\begingroup$ 
 (* init params *)
With[{p = 1.6, α = 0.001, r = 0.6, η = 0.04, ω = 1},

 (* localize vars *)
 Block[{eq, left, right},

  (* expression to plot *)
  eq[R_, τ_, μ_] := R ω p Sin[ω τ] + R ω p α - 9/4 r μ R^3 ω - η p R;

  (* increasing x-coord *)
  left = ContourPlot[
    eq[R, τ, p],
    {τ, 0, 20},
    {R, 0, 2},
    FrameLabel -> {{None, None}, {None, Style["Increasing τ", 22]}},
    ImageSize -> Medium
   ];

  (* decreasing x-coord *)
  right = ContourPlot[
    eq[R, τ, p],
    {τ, 0, 20},
    {R, 0, 2},
    FrameLabel -> {{None, None}, {None, Style["Decreasing τ", 22]}},
    ScalingFunctions -> {"Reverse", Automatic},
    ImageSize -> Medium
   ];

  (* assemble output *)
  Labeled[Row[{left, right}], Row[{
    Style["Contours of", 22, Gray,Italic],
    Style[TraditionalForm@eq[R, τ, p], 22]}]
   ]

 ]
]

enter image description here

|improve this answer
$\endgroup$
0
$\begingroup$

Perhaps:

Show[ContourPlot[R ω p Sin[ω Min[τ, 40 - τ]] + R ω p α - 9/4 r p R^3 ω - η p R == 0,
 {τ, #, #2}, {R, 0, 2},  ContourStyle -> Directive[#3, Thick]]& @@@
  {{0, 20, Blue}, {20, 40, Green}}, 
 FrameTicks->{{Automatic, Automatic}, {{#, Min[#, 40-#]}&/@Range[0, 40, 10], Automatic}}, 
 PlotRange -> {All, {0, 2}}]

enter image description here

|improve this answer
$\endgroup$
  • $\begingroup$ The limit should be from 20 to 0 in reverse direction $\endgroup$ – Udichi Feb 2 '18 at 11:42
  • $\begingroup$ @Udichi, the purpose of the Min[τ, 40 - τ] trick is that Min[τ, 40 - τ] does range from 20 to 0 when τ goes from 20 to 40. $\endgroup$ – kglr Feb 2 '18 at 11:51
0
$\begingroup$ 
p = 1.6;
α = 0.001;
r = 0.6;
η = 0.04;
ω = 1;
eqn = R ω p Sin[ω τ] + R ω p α - 
     9/4 r p R^3 ω - η p R == 0 // Rationalize // Simplify

(* 3*R*(13 + 450*R^2) == 1000*R*Sin[τ] *)

The points of intersection are

pts = {τ, R} /. SortBy[
   Solve[#, {τ, R}][[1]] & /@
    ({Reduce[
          {eqn, eqn /. τ -> 20 - τ, 0 < τ < 20, 
           0 < R < 2}, {τ, R}] // Simplify // ToRules} /. 
      Rule -> Equal),
   #[[1, -1]] &]

enter image description here

Which are approximately

pts // N

(* {{0.575222, 0.611629}, {6.85841, 0.611629}, {13.1416, 0.611629}, {19.4248, 
  0.611629}} *)

Plotting

ContourPlot[
 Evaluate@{eqn, eqn /. τ -> 20 - τ},
 {τ, 0, 20}, {R, 0, 2},
 ContourStyle -> {Blue, Green},
 BaseStyle -> Thick,
 PlotLegends -> Placed["Expressions", {.5, .75}],
 Epilog -> {Red, AbsolutePointSize[5], Point[pts]}]

enter image description here

|improve this answer
$\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.