# obtain a list of values

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 • See also here and here. – corey979 Oct 18 '16 at 17:06

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.

• Sorry to hear that. I added left out the function definitions before because I was in kind of a hurry, but I now added them for convenience. For me this code now definitely works in a fresh kernel. – Sjoerd Smit Oct 19 '16 at 13:53

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: • This works, but the plot-based approach seems much more efficient. – anderstood Nov 2 '16 at 20:04

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