obtain a list of values

Question

I used the method to find solutions on the graph t1 and t2

Clear[q, r]
q[t1_, t2_] := 
 0.25*(2*(Cos[t1] - Cos[t2])/(t2 - t1) - 2*Sin[t1])^4 + 
  0.25 (-Cos[t1] + (Sin[t2] - Sin[t1])/(t2 - t1))^4
r[t1_, t2_, En_] := 
 0.25` ((2 (Cos[t1] - Cos[t2]))/(-t1 + t2) - 2 Sin[t2])^4 + 
  0.25` (-Cos[t2] + (-Sin[t1] + Sin[t2])/(-t1 + t2))^4 - En
Show[{ContourPlot[{q[t1, t2] == 1, r[t1, t2, 0.4] == 0}, {t1, -\[Pi], 
    2*\[Pi]}, {t2, 0, 10 \[Pi]}, 
   ContourStyle -> {Lighter[Brown, .7], GrayLevel[.7]}], 
  ContourPlot[
   q[t1, t2] == 1, {t1, -\[Pi], 2*\[Pi]}, {t2, 0, 10 \[Pi]}, 
   ContourStyle -> None, 
   MeshFunctions -> Function[{t1, t2}, r[t1, t2, 0.4]], Mesh -> {{0}},
    MeshStyle -> Directive[Red, AbsolutePointSize[4.5]]]}]

Please, Could you tell me, Can I get the node values (red dots) in the form of values of t1 and t2 or how I can make a plot E(t2)?

Ee[t1_, t2_] := 0.25 ((2 (Cos[t1] - Cos[t2]))/(-t1 + t2) - 2 Sin[t2])^4 + 
  0.25 (-Cos[t2] + (-Sin[t1] + Sin[t2])/(-t1 + t2))^4

Answer 1

If you literally want the points that show up in the plot, try and rip them out of the GraphicsComplex that pops up in the FullForm of your plot. Here's an example:

Clear[q, r];
q[t1_, t2_] := 
 0.25*(2*(Cos[t1] - Cos[t2])/(t2 - t1) - 2*Sin[t1])^4 + 
  0.25 (-Cos[t1] + (Sin[t2] - Sin[t1])/(t2 - t1))^4;
r[t1_, t2_, En_] := 
 0.25` ((2 (Cos[t1] - Cos[t2]))/(-t1 + t2) - 2 Sin[t2])^4 + 
  0.25` (-Cos[t2] + (-Sin[t1] + Sin[t2])/(-t1 + t2))^4 - En;
Module[{plot = 
 Show[{ContourPlot[{q[t1, t2] == 1, 
   r[t1, t2, 0.4] == 0}, {t1, -\[Pi], 2*\[Pi]}, {t2, 0, 10 \[Pi]},
   ContourStyle -> {Lighter[Brown, .7], GrayLevel[.7]}], 
 ContourPlot[
  q[t1, t2] == 1, {t1, -\[Pi], 2*\[Pi]}, {t2, 0, 10 \[Pi]}, 
  ContourStyle -> None, 
  MeshFunctions -> Function[{t1, t2}, r[t1, t2, 0.4]], 
  Mesh -> {{0}}, 
  MeshStyle -> Directive[Red, AbsolutePointSize[4.5]]]}],
points , index
},
points = plot[[1, 2, 1]];
index = Flatten@
  Cases[
    plot[[1, 2, 2]], 
    Point[{x___?NumberQ}] :> {x}, {0, \[Infinity]}];
    points[[index]]
]

I did some manual inspection to find out where the points you're interested in are hiding in the plot, but with some smart pattern matching you can probably generalise this example.

Answer 2

Here is what I did, I think it does what you want but I am not sure I get the same number of points, a smaller step might get more (reduce .02 to something smaller for a much greater delay):

sols1 = DeleteDuplicates@{t1, t2} /.Table[
FindRoot[{q[t1, t2] == 1, 
     r[t1, t2, 0.4] == 0}, {{t1, z1}, {t2, z2}}],
   {z1, -\[Pi], 2*\[Pi], .02}, {z2, 0, 10 \[Pi], .02}];

After that long calculation, I show the points:

    Show@Graphics[
      Point@sols1,
      Axes -> True,
      PlotRange -> {{-\[Pi], 2 \[Pi]}, {0, 10 \[Pi]}},
      AspectRatio->1]

and I get:

Answer 3

Simply save the graph as plot (plot = Show[...) and extract the points with:

pts = Cases[Normal@plot, Point[a_] :> a, Infinity]
ListPlot[pts]

You can then refine the points using FindRoot and the initial conditions given by the plot, with

Table[{t1, t2} /. FindRoot[{q[t1, t2] - 1, r[t1, t2, 0.4]},
  {{t1, pts[[i, 1]]}, {t2, pts[[i, 2]]}}, AccuracyGoal -> Infinity], 
  {i, Length@pts}]