Divide plot into a number of range segments and show the mid-range point of each segment on the curve

Question

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.

Answer 1

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]

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}]]

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]

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

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

Answer 2

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]