1
$\begingroup$

I have a code here:

expr = Sqrt[2]\[Sqrt](\[Sqrt](1/x^2+20 Sqrt[3118] (1/x)^(3/2) 
Sqrt[1/50]+3118020 Sqrt[3118] Sqrt[1/x] (1/50)^(3/2)+24304810001/50^2+ 
623602/(x 50))-10 Sqrt[3118] Sqrt[1/x] Sqrt[1/50]-155900 /50)

(*I use this method here to calculate the midpoint (x,y coordinates) and range of the graph*)
nMax = NMaxValue[expr, {x, 5, 500}];
nMin = NMinValue[expr, {x, 5, 500}];
nR = nMax - nMin;
nRan = nR/4
nRanC = nRan/2
n1 = nMin + nRanC
Solve[expr == n1, x]
n2 = n1 + nRan
Solve[expr == n2, x]
n3 = n2 + nRan
Solve[expr == n3, x]
n4 = n3 + nRan
Solve[expr == n1, x]
(*Then I plot to divide into 4 different section of graph*)
n1x=nMin+nRan
n2x=n1x+nRan
n3x=n2x+nRan
n4x=n3x+nRan
Row[Plot[expr,{x,5,500},MeshFunctions->{#2&},MeshShading->{None,Blue},Mesh->{#},MeshStyle->Opacity[0],PlotRange->{{0,500},{0,1}},AxesLabel->{x,SuperStar[E]},ImageSize->300]&/@{{n3x,n4x},{n2x,n3x},{n1x,n2x},{nMin,n1x}}]

The above code is to divide the graph into 4 different section. Meaning that I have to set/calculate the 4 section manually into the code.

Let's say that if I wanted to do mx=Input["how many graph to show?"], then to calculate the midpoint and range of each graph shown, and to plot the graph altogether automatically based on the mx value given (by using some kind of loop?).

How exactly do I do that? I'm kind of new to mathematica and still learning about its use. Thank you.

$\endgroup$
4
$\begingroup$

No looping isn necessary (You seldom need looping in Mathematica.) Here is how to break your plot into an arbitrary number of vertical sections.

expr = 
  (1/5)*Sqrt[
          -155900 - 100*Sqrt[1559]*Sqrt[1/x] + 
           Sqrt[24304810001 + 
             200*Sqrt[1559]*(1/x)^(3/2)*(50 + 155901*x) + 
             (2500 + 31180100 x)/x^2]];

mx = 4; (* number of sections *)
nMin = NMinValue[{expr, 5 <= x <= 500}, x]; (* corrected *)
nMax = NMaxValue[{expr, 5 <= x <= 500}, x]; (* corrected *)

subRanges = Partition[Subdivide[nMin, nMax, mx], 2, 1]
{{0.0636035, 0.205906}, {0.205906, 0.348208}, 
 {0.348208, 0.49051}, {0.49051, 0.632812}}
Column[
   Plot[expr, {x, 5, 500},
     PlotRange -> {{0, 500}, #},
     AxesLabel -> {x, SuperStar[E]},
     ImageSize -> 300] & 
   /@ Reverse @ subRanges]

plots

Update

I'm not sure which midpoints you are asking about, but guessing it is the midpoints of the sub-ranges, the code would go like this:

midY = Mean /@ subRanges;
midX = (NSolve[expr == #, x] & /@ midY)[[All, 1, 1, 2]]
midPts = {Red, AbsolutePointSize[6], Point[#]} & /@ Transpose[{midX, midY}]

Column[
  MapThread[
    Plot[expr, {x, 5, 500},
      Epilog -> #1,
      PlotRange -> {{0, 500}, #2},
      AxesLabel -> {x, SuperStar[E]},
      ImageSize -> 300] &, 
    Reverse /@ {midPts, subRanges}]]

plots

Update 2

Another reading of question is that you want everything to be drawn on one plot. This is easy, too.

This is to show where the segment boundaries are.

dividers = {Dashed, HalfLine[{{0, #}, {500, #}}] & /@ subRanges[[2 ;;, 1]]};

Plot[expr, {x, 5, 500},
  Epilog -> {midPts, dividers},
  PlotRange -> {{0, 500}, {nMin, nMax}},
  AxesLabel -> {x, SuperStar[E]},
  ImageSize -> 300]

plot

Update 3

To do what you ask for in your comment to this answer, you need to compute sub-domains as well as sub-ranges.

subDomains = 
  Partition[
    Reverse[(Solve[expr == #, x] & /@ Subdivide[nMin, nMax, mx])[[All, 1, 1, 2]]], 
    2, 1];

and then make the plot with

Column[
  MapThread[
    Plot[expr, Prepend[#2, x],
      Epilog -> #1,
      PlotRange -> {0, 1},
      AxesLabel -> {x, SuperStar[E]},
      ImageSize -> 300] &, 
    {Reverse[midPts], subDomains}]]

which gives

plot4

I find this a rather strange way to present the segmentation of the curve, but if it suits you, then fine.

| improve this answer | |
$\endgroup$
  • $\begingroup$ Wow! I can't thank you enough for the answer. I have a question about this section here where midY = Mean /@ subRanges; midX = (NSolve[expr == #, x] & /@ midY)[[All, 1, 1, 2]] midPts = {Red, AbsolutePointSize[6], Point[#]} & /@ Transpose[{midX, midY}] Column[ MapThread[ Plot[expr, {x, 5, 500}, Epilog -> #1, PlotRange -> {{0, 500}, #2}, AxesLabel -> {x, SuperStar[E]}, ImageSize -> 300] &, Reverse /@ {midPts, subRanges}]] How do I set the PlotRange for the y-axis to be constant {0,1} for all the plot generated? $\endgroup$ – Zen 禅 Jun 21 '17 at 18:36
  • $\begingroup$ @AhmadRuzaini禅. I have updated the answer once again to answer the issue you bring up in your comment. $\endgroup$ – m_goldberg Jun 22 '17 at 1:20
2
$\begingroup$

Using the same pre-amble as @m_goldberg, to illustrate use of Mesh and GridLines:

s[x1_, x2_, n_] := 
 With[{r = Range[x1, x2, (x2 - x1)/n]}, {r, MovingAverage[r, 2]}]
Plot[expr, {x, 0, 500}, MeshFunctions -> (#2 &), Mesh -> {#2}, 
   MeshStyle -> {Red, PointSize[0.02]}, GridLines -> {None, #1}, 
   PlotRange -> {#1[[1]], #1[[-1]]}] & @@ s[nMin, nMax, mx]

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.