How can I plot a Farey diagram?How to make this beautiful animationPlotting an epicycloidGenerating a topological space diagram for an n-element setMathematica code for Bifurcation DiagramHow to draw a contour diagram in Mathematica?How to draw timing diagram from a list of values?Expressing a series formulaBifurcation diagram for Piecewise functionHow to draw a clock-diagram?How can I plot a space time diagram in mathematica?Plotting classical polymer modelA problem in bifurcation diagram
Is lying to get "gardening leave" fraud?
Why is Thanos so tough at the beginning of "Avengers: Endgame"?
If an enemy is just below a 10-foot-high ceiling, are they in melee range of a creature on the ground?
Python password manager
What happens if I start too many background jobs?
Meaning of "individuandum"
Feels like I am getting dragged into office politics
Any examples of headwear for races with animal ears?
Is Cola "probably the best-known" Latin word in the world? If not, which might it be?
Can fracking help reduce CO2?
How to reply this mail from potential PhD professor?
What are the spoon bit of a spoon and fork bit of a fork called?
Why are notes ordered like they are on a piano?
How to scale a verbatim environment on a minipage?
CRT Oscilloscope - part of the plot is missing
Is it the same airport YUL and YMQ in Canada?
Unidentified items in bicycle tube repair kit
Junior developer struggles: how to communicate with management?
Why is the SNP putting so much emphasis on currency plans?
How can I close a gap between my fence and my neighbor's that's on his side of the property line?
Can I use 1000v rectifier diodes instead of 600v rectifier diodes?
What are the differences between credential stuffing and password spraying?
Is NMDA produced in the body?
Binary Numbers Magic Trick
How can I plot a Farey diagram?
How to make this beautiful animationPlotting an epicycloidGenerating a topological space diagram for an n-element setMathematica code for Bifurcation DiagramHow to draw a contour diagram in Mathematica?How to draw timing diagram from a list of values?Expressing a series formulaBifurcation diagram for Piecewise functionHow to draw a clock-diagram?How can I plot a space time diagram in mathematica?Plotting classical polymer modelA problem in bifurcation diagram
6
$begingroup$
How can I plot the following diagram for a Farey series?
graphics number-theory
edited Apr 9 at 3:01
Michael E2
151k12203484
asked Apr 8 at 21:12
G. R.G. R.
343
$endgroup$
|
show 1 more comment
6
$begingroup$
How can I plot the following diagram for a Farey series?
graphics number-theory
edited Apr 9 at 3:01
Michael E2
151k12203484
asked Apr 8 at 21:12
G. R.G. R.
343
$endgroup$
$begingroup$
From the beautiful book A. Hatcher Topology of numbers
$endgroup$
– G. R.
Apr 8 at 21:16
2
$begingroup$
Could you perhaps expand a bit on how the curves are calculated etc?
$endgroup$
– MarcoB
Apr 8 at 21:40
1
$begingroup$
pi.math.cornell.edu/~hatcher/TN/TNch1.pdf
$endgroup$
– Moo
Apr 8 at 23:17
1
$begingroup$
Technically this is not a Farey series/sequence $F_n$ of order $n$, which is defined to be all fractions (sometimes restricted to the interval between 0 and 1) with denominator at most $n$. For example 3/8 is present but not 1/8. It's a recursive mediant subdivision. It's related in that in any three successive terms of a Farey sequence, the middle one is the mediant of the other two.
$endgroup$
– Michael E2
Apr 9 at 17:44
$begingroup$
If it wasn't for the very good answers you got, I would have voted to close this question as it gives no details, no definitions no code and shows no personal effort. Please, next time try asking good questions.
$endgroup$
– rhermans
Apr 11 at 9:18
|
show 1 more comment
6
6
6
2
$begingroup$
How can I plot the following diagram for a Farey series?
graphics number-theory
edited Apr 9 at 3:01
Michael E2
151k12203484
asked Apr 8 at 21:12
G. R.G. R.
343
$endgroup$
How can I plot the following diagram for a Farey series?
graphics number-theory
graphics number-theory
edited Apr 9 at 3:01
Michael E2
151k12203484
asked Apr 8 at 21:12
G. R.G. R.
343
edited Apr 9 at 3:01
Michael E2
151k12203484
asked Apr 8 at 21:12
G. R.G. R.
343
edited Apr 9 at 3:01
Michael E2
151k12203484
edited Apr 9 at 3:01
Michael E2
151k12203484
edited Apr 9 at 3:01
Michael E2
151k12203484
151k12203484
asked Apr 8 at 21:12
G. R.G. R.
343
asked Apr 8 at 21:12
G. R.G. R.
343
asked Apr 8 at 21:12
G. R.G. R.
343
343
$begingroup$
From the beautiful book A. Hatcher Topology of numbers
$endgroup$
– G. R.
Apr 8 at 21:16
2
$begingroup$
Could you perhaps expand a bit on how the curves are calculated etc?
$endgroup$
– MarcoB
Apr 8 at 21:40
1
$begingroup$
pi.math.cornell.edu/~hatcher/TN/TNch1.pdf
$endgroup$
– Moo
Apr 8 at 23:17
1
$begingroup$
Technically this is not a Farey series/sequence $F_n$ of order $n$, which is defined to be all fractions (sometimes restricted to the interval between 0 and 1) with denominator at most $n$. For example 3/8 is present but not 1/8. It's a recursive mediant subdivision. It's related in that in any three successive terms of a Farey sequence, the middle one is the mediant of the other two.
$endgroup$
– Michael E2
Apr 9 at 17:44
$begingroup$
If it wasn't for the very good answers you got, I would have voted to close this question as it gives no details, no definitions no code and shows no personal effort. Please, next time try asking good questions.
$endgroup$
– rhermans
Apr 11 at 9:18
|
show 1 more comment
$begingroup$
From the beautiful book A. Hatcher Topology of numbers
$endgroup$
– G. R.
Apr 8 at 21:16
2
$begingroup$
Could you perhaps expand a bit on how the curves are calculated etc?
$endgroup$
– MarcoB
Apr 8 at 21:40
1
$begingroup$
pi.math.cornell.edu/~hatcher/TN/TNch1.pdf
$endgroup$
– Moo
Apr 8 at 23:17
1
$begingroup$
Technically this is not a Farey series/sequence $F_n$ of order $n$, which is defined to be all fractions (sometimes restricted to the interval between 0 and 1) with denominator at most $n$. For example 3/8 is present but not 1/8. It's a recursive mediant subdivision. It's related in that in any three successive terms of a Farey sequence, the middle one is the mediant of the other two.
$endgroup$
– Michael E2
Apr 9 at 17:44
$begingroup$
If it wasn't for the very good answers you got, I would have voted to close this question as it gives no details, no definitions no code and shows no personal effort. Please, next time try asking good questions.
$endgroup$
– rhermans
Apr 11 at 9:18
$begingroup$
From the beautiful book A. Hatcher Topology of numbers
$endgroup$
– G. R.
Apr 8 at 21:16
$begingroup$
From the beautiful book A. Hatcher Topology of numbers
$endgroup$
– G. R.
Apr 8 at 21:16
2
2
$begingroup$
Could you perhaps expand a bit on how the curves are calculated etc?
$endgroup$
– MarcoB
Apr 8 at 21:40
$begingroup$
Could you perhaps expand a bit on how the curves are calculated etc?
$endgroup$
– MarcoB
Apr 8 at 21:40
1
1
$begingroup$
pi.math.cornell.edu/~hatcher/TN/TNch1.pdf
$endgroup$
– Moo
Apr 8 at 23:17
$begingroup$
pi.math.cornell.edu/~hatcher/TN/TNch1.pdf
$endgroup$
– Moo
Apr 8 at 23:17
1
1
$begingroup$
Technically this is not a Farey series/sequence $F_n$ of order $n$, which is defined to be all fractions (sometimes restricted to the interval between 0 and 1) with denominator at most $n$. For example 3/8 is present but not 1/8. It's a recursive mediant subdivision. It's related in that in any three successive terms of a Farey sequence, the middle one is the mediant of the other two.
$endgroup$
– Michael E2
Apr 9 at 17:44
$begingroup$
Technically this is not a Farey series/sequence $F_n$ of order $n$, which is defined to be all fractions (sometimes restricted to the interval between 0 and 1) with denominator at most $n$. For example 3/8 is present but not 1/8. It's a recursive mediant subdivision. It's related in that in any three successive terms of a Farey sequence, the middle one is the mediant of the other two.
$endgroup$
– Michael E2
Apr 9 at 17:44
$begingroup$
If it wasn't for the very good answers you got, I would have voted to close this question as it gives no details, no definitions no code and shows no personal effort. Please, next time try asking good questions.
$endgroup$
– rhermans
Apr 11 at 9:18
$begingroup$
If it wasn't for the very good answers you got, I would have voted to close this question as it gives no details, no definitions no code and shows no personal effort. Please, next time try asking good questions.
$endgroup$
– rhermans
Apr 11 at 9:18
|
show 1 more comment
4 Answers
4
active
oldest
votes
12
$begingroup$
The curvilinear triangles which are characteristic for this type of plot are called hypocycloid curves. We can use the parametric equations on Wikipedia to plot these, like so:
x[a_, b_, t_] := (b - a) Cos[t] + a Cos[(b - a)/a t]
y[a_, b_, t_] := (b - a) Sin[t] - a Sin[(b - a)/a t]
hypocycloid[n_] := ParametricPlot[
x[1/n, 1, t], y[1/n, 1, t],
t, 0, 2 Pi,
PlotStyle -> Thickness[0.002], Black
]
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
ImageSize -> 500
]
I've previously written about an application of hypocycloids here, and I showed how to visualize epicycloids here.
How to generate the labels is described here (also linked to by moo in a comment). I will simply provide the code.
mediant[a_, b_, c_, d_] := a + c, b + d
recursive[v1_, v2_, depth_] := If[
depth > 2,
mediant[v1, v2],
recursive[v1, mediant[v1, v2], depth + 1],
mediant[v1, v2],
recursive[mediant[v1, v2], v2, depth + 1]
]
computeLabels[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["``/``"] @@@ numbers
]
computeLabelsNegative[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["-`2`/`1`"] @@@ numbers
]
labels = Reverse@Join[
"1/0",
computeLabels[1, 0, 1, 1],
"1/1",
computeLabels[1, 1, 0, 1],
"0/1",
computeLabelsNegative[1, 0, 1, 1],
"-1,1",
computeLabelsNegative[1, 1, 0, 1]
];
coords = CirclePoints[1.1, 186 Degree, 64];
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
Graphics@MapThread[Text, labels, coords],
ImageSize -> 500
]
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
$endgroup$
add a comment |
5
$begingroup$
Using Graph with a bit of coding:
addPoint[p : h_[a_,b_], q : h_[c_,d_], i_] :=
With[np = h[a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
fLabel[fr_, angle_] :=
With[tangle=ArcTan@@angle, Placed[fLabel[fr], AngleVector[1/2, 1/2, .7, #] & /@tangle, tangle+Pi]]
fLabel[h_[a_, b_]] := ToString[a] ~~ "/" ~~ ToString[b]
fLabel[h_[-1][a_, b_]] := "-" ~~ ToString[a] ~~ "/" ~~ ToString[b]
FareyDiagram[n_Integer, d_Integer: 1, opts___?OptionQ] :=
Block[fr, top, bottom, stedges, toppart, bottompart, vert, edges, coords, labels, labpos, cfunc, i, edgestyle, dstyle, nopts,
cfunc = ColorFunction /. Flatten[opts] /. ColorFunction -> Automatic;
nopts = FilterRules[Flatten[opts], Options[Graph]];
top = fr[0,1], fr[1,1], fr[1,0];
bottom = fr[1,0], fr[-1][1,1], fr[0,1];
stedges = UndirectedEdge@@@Join[Partition[top, 2, 1], Partition[bottom, 2, 1], fr[0, 1],fr[1, 0]];
i = 0;toppart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#, 2, 1],1]][[All,1]])&, top, n]];
i = 0;bottompart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#,2,1],1]][[All,1]])&,bottom, n]];
vert = Join[toppart[[1]], bottompart[[1, 2;;-2]]];
edges = Flatten[stedges, toppart[[2, 1]], bottompart[[2, 1]]];
coords = CirclePoints[1,0,Length[vert]];
labpos = Range[1, Length[vert], 2 ^ (d - 1)];
labels = Thread[vert[[labpos]]->fLabel@@@Transpose[vert,coords][[labpos]]];
edgestyle = Black;
dstyle = Black;
If[cfunc =!= Automatic,
edgestyle = Flatten[Table[0, Length[stedges]], toppart[[2, 2]], bottompart[[2, 2]]];
edgestyle = edgestyle / Max[edgestyle];
edgestyle = Thread[edges -> Flatten[cfunc[1 - #] & /@ edgestyle]];
dstyle = cfunc[1]
];
Graph[vert, edges, nopts, VertexCoordinates->CirclePoints[1,0,Length[vert]], VertexLabels->labels,
EdgeShapeFunction->(BSplineCurve[#1[[1]],0,0,#1[[2]], SplineWeights->2,EuclideanDistance@@#,2]&),
PerformanceGoal->"Speed", Epilog->dstyle, Circle[], VertexShapeFunction -> "Point", EdgeStyle -> edgestyle, VertexStyle -> dstyle]
]
Example:
FareyDiagram[4]
FareyDiagram[6, 4, ColorFunction -> Hue,
VertexLabelStyle -> Darker[Red]]
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
$endgroup$
add a comment |
4
$begingroup$
I looked up the Farey sequence on Wikipedia, out of curiosity, because I had not heard of it before. The Farey sequence of order $n$ is "the sequence of completely reduced fractions between 0 and 1 which, when in lowest terms, have denominators less than or equal to $n$, arranged in order of increasing size".
On that basis, you can generate the sequence as follows, for instance:
ClearAll[farey]
farey[n_Integer] := (Divide @@@ Subsets[Range[n], 2]) ~ Join ~ 0, 1 //DeleteDuplicates //Sort
So for instance:
farey[5]
0, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1
I am not sure how these sequences are connected with the figure you showed though.
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
$endgroup$
$begingroup$
Thanks to C.E., it is a concrete answer
$endgroup$
– G. R.
Apr 9 at 12:58
add a comment |
0
$begingroup$
grupo[n_] := Show[Graphics[Thin, Red,
Circle[0, 0, 1, 0, Pi/2]], Graphics[Thin,
Map[BSplineCurve[#1[[1]], 0, 0, #1[[2]],
SplineWeights -> 2, EuclideanDistance @@
#,2]&,
Partition[ReIm[Exp[Pi/2 I #]] & /@
FareySequence[n], 2, 1]]], Map[Graphics[Blue,
Point[ReIm[Exp[Pi/2 I #]]]] &,
FareySequence[n]], PlotRange -> All]
Show[Table[grupo[n], n, 2, 7]]
answered Apr 16 at 23:48
G. R.G. R.
343
$endgroup$
$begingroup$
the true farey diagram based on the answers given above
$endgroup$
– G. R.
Apr 16 at 23:52
add a comment |
Your Answer
StackExchange.ready(function()
var channelOptions =
tags: "".split(" "),
id: "387"
;
initTagRenderer("".split(" "), "".split(" "), channelOptions);
StackExchange.using("externalEditor", function()
// Have to fire editor after snippets, if snippets enabled
if (StackExchange.settings.snippets.snippetsEnabled)
StackExchange.using("snippets", function()
createEditor();
);
else
createEditor();
);
function createEditor()
StackExchange.prepareEditor(
heartbeatType: 'answer',
autoActivateHeartbeat: false,
convertImagesToLinks: false,
noModals: true,
showLowRepImageUploadWarning: true,
reputationToPostImages: null,
bindNavPrevention: true,
postfix: "",
imageUploader:
brandingHtml: "Powered by u003ca class="icon-imgur-white" href="https://imgur.com/"u003eu003c/au003e",
contentPolicyHtml: "User contributions licensed under u003ca href="https://creativecommons.org/licenses/by-sa/3.0/"u003ecc by-sa 3.0 with attribution requiredu003c/au003e u003ca href="https://stackoverflow.com/legal/content-policy"u003e(content policy)u003c/au003e",
allowUrls: true
,
onDemand: true,
discardSelector: ".discard-answer"
,immediatelyShowMarkdownHelp:true
);
);
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function ()
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f194838%2fhow-can-i-plot-a-farey-diagram%23new-answer', 'question_page');
);
Post as a guest
Required, but never shown
4 Answers
4
active
oldest
votes
4 Answers
4
active
oldest
votes
active
oldest
votes
active
oldest
votes
12
$begingroup$
The curvilinear triangles which are characteristic for this type of plot are called hypocycloid curves. We can use the parametric equations on Wikipedia to plot these, like so:
x[a_, b_, t_] := (b - a) Cos[t] + a Cos[(b - a)/a t]
y[a_, b_, t_] := (b - a) Sin[t] - a Sin[(b - a)/a t]
hypocycloid[n_] := ParametricPlot[
x[1/n, 1, t], y[1/n, 1, t],
t, 0, 2 Pi,
PlotStyle -> Thickness[0.002], Black
]
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
ImageSize -> 500
]
I've previously written about an application of hypocycloids here, and I showed how to visualize epicycloids here.
How to generate the labels is described here (also linked to by moo in a comment). I will simply provide the code.
mediant[a_, b_, c_, d_] := a + c, b + d
recursive[v1_, v2_, depth_] := If[
depth > 2,
mediant[v1, v2],
recursive[v1, mediant[v1, v2], depth + 1],
mediant[v1, v2],
recursive[mediant[v1, v2], v2, depth + 1]
]
computeLabels[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["``/``"] @@@ numbers
]
computeLabelsNegative[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["-`2`/`1`"] @@@ numbers
]
labels = Reverse@Join[
"1/0",
computeLabels[1, 0, 1, 1],
"1/1",
computeLabels[1, 1, 0, 1],
"0/1",
computeLabelsNegative[1, 0, 1, 1],
"-1,1",
computeLabelsNegative[1, 1, 0, 1]
];
coords = CirclePoints[1.1, 186 Degree, 64];
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
Graphics@MapThread[Text, labels, coords],
ImageSize -> 500
]
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
$endgroup$
add a comment |
12
$begingroup$
The curvilinear triangles which are characteristic for this type of plot are called hypocycloid curves. We can use the parametric equations on Wikipedia to plot these, like so:
x[a_, b_, t_] := (b - a) Cos[t] + a Cos[(b - a)/a t]
y[a_, b_, t_] := (b - a) Sin[t] - a Sin[(b - a)/a t]
hypocycloid[n_] := ParametricPlot[
x[1/n, 1, t], y[1/n, 1, t],
t, 0, 2 Pi,
PlotStyle -> Thickness[0.002], Black
]
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
ImageSize -> 500
]
I've previously written about an application of hypocycloids here, and I showed how to visualize epicycloids here.
How to generate the labels is described here (also linked to by moo in a comment). I will simply provide the code.
mediant[a_, b_, c_, d_] := a + c, b + d
recursive[v1_, v2_, depth_] := If[
depth > 2,
mediant[v1, v2],
recursive[v1, mediant[v1, v2], depth + 1],
mediant[v1, v2],
recursive[mediant[v1, v2], v2, depth + 1]
]
computeLabels[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["``/``"] @@@ numbers
]
computeLabelsNegative[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["-`2`/`1`"] @@@ numbers
]
labels = Reverse@Join[
"1/0",
computeLabels[1, 0, 1, 1],
"1/1",
computeLabels[1, 1, 0, 1],
"0/1",
computeLabelsNegative[1, 0, 1, 1],
"-1,1",
computeLabelsNegative[1, 1, 0, 1]
];
coords = CirclePoints[1.1, 186 Degree, 64];
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
Graphics@MapThread[Text, labels, coords],
ImageSize -> 500
]
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
$endgroup$
add a comment |
12
12
12
$begingroup$
The curvilinear triangles which are characteristic for this type of plot are called hypocycloid curves. We can use the parametric equations on Wikipedia to plot these, like so:
x[a_, b_, t_] := (b - a) Cos[t] + a Cos[(b - a)/a t]
y[a_, b_, t_] := (b - a) Sin[t] - a Sin[(b - a)/a t]
hypocycloid[n_] := ParametricPlot[
x[1/n, 1, t], y[1/n, 1, t],
t, 0, 2 Pi,
PlotStyle -> Thickness[0.002], Black
]
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
ImageSize -> 500
]
I've previously written about an application of hypocycloids here, and I showed how to visualize epicycloids here.
How to generate the labels is described here (also linked to by moo in a comment). I will simply provide the code.
mediant[a_, b_, c_, d_] := a + c, b + d
recursive[v1_, v2_, depth_] := If[
depth > 2,
mediant[v1, v2],
recursive[v1, mediant[v1, v2], depth + 1],
mediant[v1, v2],
recursive[mediant[v1, v2], v2, depth + 1]
]
computeLabels[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["``/``"] @@@ numbers
]
computeLabelsNegative[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["-`2`/`1`"] @@@ numbers
]
labels = Reverse@Join[
"1/0",
computeLabels[1, 0, 1, 1],
"1/1",
computeLabels[1, 1, 0, 1],
"0/1",
computeLabelsNegative[1, 0, 1, 1],
"-1,1",
computeLabelsNegative[1, 1, 0, 1]
];
coords = CirclePoints[1.1, 186 Degree, 64];
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
Graphics@MapThread[Text, labels, coords],
ImageSize -> 500
]
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
$endgroup$
The curvilinear triangles which are characteristic for this type of plot are called hypocycloid curves. We can use the parametric equations on Wikipedia to plot these, like so:
x[a_, b_, t_] := (b - a) Cos[t] + a Cos[(b - a)/a t]
y[a_, b_, t_] := (b - a) Sin[t] - a Sin[(b - a)/a t]
hypocycloid[n_] := ParametricPlot[
x[1/n, 1, t], y[1/n, 1, t],
t, 0, 2 Pi,
PlotStyle -> Thickness[0.002], Black
]
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
ImageSize -> 500
]
I've previously written about an application of hypocycloids here, and I showed how to visualize epicycloids here.
How to generate the labels is described here (also linked to by moo in a comment). I will simply provide the code.
mediant[a_, b_, c_, d_] := a + c, b + d
recursive[v1_, v2_, depth_] := If[
depth > 2,
mediant[v1, v2],
recursive[v1, mediant[v1, v2], depth + 1],
mediant[v1, v2],
recursive[mediant[v1, v2], v2, depth + 1]
]
computeLabels[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["``/``"] @@@ numbers
]
computeLabelsNegative[v1_, v2_] := Module[numbers,
numbers =
Cases[recursive[v1, v2, 0], _Integer, _Integer, Infinity];
StringTemplate["-`2`/`1`"] @@@ numbers
]
labels = Reverse@Join[
"1/0",
computeLabels[1, 0, 1, 1],
"1/1",
computeLabels[1, 1, 0, 1],
"0/1",
computeLabelsNegative[1, 0, 1, 1],
"-1,1",
computeLabelsNegative[1, 1, 0, 1]
];
coords = CirclePoints[1.1, 186 Degree, 64];
Show[
Graphics[Circle[0, 0, 1]],
hypocycloid[2],
hypocycloid[4],
hypocycloid[8],
hypocycloid[16],
hypocycloid[32],
hypocycloid[64],
Graphics@MapThread[Text, labels, coords],
ImageSize -> 500
]
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
edited Apr 9 at 6:50
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
answered Apr 9 at 3:27
C. E.C. E.
51.5k3101207
51.5k3101207
add a comment |
add a comment |
5
$begingroup$
Using Graph with a bit of coding:
addPoint[p : h_[a_,b_], q : h_[c_,d_], i_] :=
With[np = h[a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
fLabel[fr_, angle_] :=
With[tangle=ArcTan@@angle, Placed[fLabel[fr], AngleVector[1/2, 1/2, .7, #] & /@tangle, tangle+Pi]]
fLabel[h_[a_, b_]] := ToString[a] ~~ "/" ~~ ToString[b]
fLabel[h_[-1][a_, b_]] := "-" ~~ ToString[a] ~~ "/" ~~ ToString[b]
FareyDiagram[n_Integer, d_Integer: 1, opts___?OptionQ] :=
Block[fr, top, bottom, stedges, toppart, bottompart, vert, edges, coords, labels, labpos, cfunc, i, edgestyle, dstyle, nopts,
cfunc = ColorFunction /. Flatten[opts] /. ColorFunction -> Automatic;
nopts = FilterRules[Flatten[opts], Options[Graph]];
top = fr[0,1], fr[1,1], fr[1,0];
bottom = fr[1,0], fr[-1][1,1], fr[0,1];
stedges = UndirectedEdge@@@Join[Partition[top, 2, 1], Partition[bottom, 2, 1], fr[0, 1],fr[1, 0]];
i = 0;toppart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#, 2, 1],1]][[All,1]])&, top, n]];
i = 0;bottompart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#,2,1],1]][[All,1]])&,bottom, n]];
vert = Join[toppart[[1]], bottompart[[1, 2;;-2]]];
edges = Flatten[stedges, toppart[[2, 1]], bottompart[[2, 1]]];
coords = CirclePoints[1,0,Length[vert]];
labpos = Range[1, Length[vert], 2 ^ (d - 1)];
labels = Thread[vert[[labpos]]->fLabel@@@Transpose[vert,coords][[labpos]]];
edgestyle = Black;
dstyle = Black;
If[cfunc =!= Automatic,
edgestyle = Flatten[Table[0, Length[stedges]], toppart[[2, 2]], bottompart[[2, 2]]];
edgestyle = edgestyle / Max[edgestyle];
edgestyle = Thread[edges -> Flatten[cfunc[1 - #] & /@ edgestyle]];
dstyle = cfunc[1]
];
Graph[vert, edges, nopts, VertexCoordinates->CirclePoints[1,0,Length[vert]], VertexLabels->labels,
EdgeShapeFunction->(BSplineCurve[#1[[1]],0,0,#1[[2]], SplineWeights->2,EuclideanDistance@@#,2]&),
PerformanceGoal->"Speed", Epilog->dstyle, Circle[], VertexShapeFunction -> "Point", EdgeStyle -> edgestyle, VertexStyle -> dstyle]
]
Example:
FareyDiagram[4]
FareyDiagram[6, 4, ColorFunction -> Hue,
VertexLabelStyle -> Darker[Red]]
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
$endgroup$
add a comment |
5
$begingroup$
Using Graph with a bit of coding:
addPoint[p : h_[a_,b_], q : h_[c_,d_], i_] :=
With[np = h[a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
fLabel[fr_, angle_] :=
With[tangle=ArcTan@@angle, Placed[fLabel[fr], AngleVector[1/2, 1/2, .7, #] & /@tangle, tangle+Pi]]
fLabel[h_[a_, b_]] := ToString[a] ~~ "/" ~~ ToString[b]
fLabel[h_[-1][a_, b_]] := "-" ~~ ToString[a] ~~ "/" ~~ ToString[b]
FareyDiagram[n_Integer, d_Integer: 1, opts___?OptionQ] :=
Block[fr, top, bottom, stedges, toppart, bottompart, vert, edges, coords, labels, labpos, cfunc, i, edgestyle, dstyle, nopts,
cfunc = ColorFunction /. Flatten[opts] /. ColorFunction -> Automatic;
nopts = FilterRules[Flatten[opts], Options[Graph]];
top = fr[0,1], fr[1,1], fr[1,0];
bottom = fr[1,0], fr[-1][1,1], fr[0,1];
stedges = UndirectedEdge@@@Join[Partition[top, 2, 1], Partition[bottom, 2, 1], fr[0, 1],fr[1, 0]];
i = 0;toppart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#, 2, 1],1]][[All,1]])&, top, n]];
i = 0;bottompart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#,2,1],1]][[All,1]])&,bottom, n]];
vert = Join[toppart[[1]], bottompart[[1, 2;;-2]]];
edges = Flatten[stedges, toppart[[2, 1]], bottompart[[2, 1]]];
coords = CirclePoints[1,0,Length[vert]];
labpos = Range[1, Length[vert], 2 ^ (d - 1)];
labels = Thread[vert[[labpos]]->fLabel@@@Transpose[vert,coords][[labpos]]];
edgestyle = Black;
dstyle = Black;
If[cfunc =!= Automatic,
edgestyle = Flatten[Table[0, Length[stedges]], toppart[[2, 2]], bottompart[[2, 2]]];
edgestyle = edgestyle / Max[edgestyle];
edgestyle = Thread[edges -> Flatten[cfunc[1 - #] & /@ edgestyle]];
dstyle = cfunc[1]
];
Graph[vert, edges, nopts, VertexCoordinates->CirclePoints[1,0,Length[vert]], VertexLabels->labels,
EdgeShapeFunction->(BSplineCurve[#1[[1]],0,0,#1[[2]], SplineWeights->2,EuclideanDistance@@#,2]&),
PerformanceGoal->"Speed", Epilog->dstyle, Circle[], VertexShapeFunction -> "Point", EdgeStyle -> edgestyle, VertexStyle -> dstyle]
]
Example:
FareyDiagram[4]
FareyDiagram[6, 4, ColorFunction -> Hue,
VertexLabelStyle -> Darker[Red]]
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
$endgroup$
add a comment |
5
5
5
$begingroup$
Using Graph with a bit of coding:
addPoint[p : h_[a_,b_], q : h_[c_,d_], i_] :=
With[np = h[a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
fLabel[fr_, angle_] :=
With[tangle=ArcTan@@angle, Placed[fLabel[fr], AngleVector[1/2, 1/2, .7, #] & /@tangle, tangle+Pi]]
fLabel[h_[a_, b_]] := ToString[a] ~~ "/" ~~ ToString[b]
fLabel[h_[-1][a_, b_]] := "-" ~~ ToString[a] ~~ "/" ~~ ToString[b]
FareyDiagram[n_Integer, d_Integer: 1, opts___?OptionQ] :=
Block[fr, top, bottom, stedges, toppart, bottompart, vert, edges, coords, labels, labpos, cfunc, i, edgestyle, dstyle, nopts,
cfunc = ColorFunction /. Flatten[opts] /. ColorFunction -> Automatic;
nopts = FilterRules[Flatten[opts], Options[Graph]];
top = fr[0,1], fr[1,1], fr[1,0];
bottom = fr[1,0], fr[-1][1,1], fr[0,1];
stedges = UndirectedEdge@@@Join[Partition[top, 2, 1], Partition[bottom, 2, 1], fr[0, 1],fr[1, 0]];
i = 0;toppart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#, 2, 1],1]][[All,1]])&, top, n]];
i = 0;bottompart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#,2,1],1]][[All,1]])&,bottom, n]];
vert = Join[toppart[[1]], bottompart[[1, 2;;-2]]];
edges = Flatten[stedges, toppart[[2, 1]], bottompart[[2, 1]]];
coords = CirclePoints[1,0,Length[vert]];
labpos = Range[1, Length[vert], 2 ^ (d - 1)];
labels = Thread[vert[[labpos]]->fLabel@@@Transpose[vert,coords][[labpos]]];
edgestyle = Black;
dstyle = Black;
If[cfunc =!= Automatic,
edgestyle = Flatten[Table[0, Length[stedges]], toppart[[2, 2]], bottompart[[2, 2]]];
edgestyle = edgestyle / Max[edgestyle];
edgestyle = Thread[edges -> Flatten[cfunc[1 - #] & /@ edgestyle]];
dstyle = cfunc[1]
];
Graph[vert, edges, nopts, VertexCoordinates->CirclePoints[1,0,Length[vert]], VertexLabels->labels,
EdgeShapeFunction->(BSplineCurve[#1[[1]],0,0,#1[[2]], SplineWeights->2,EuclideanDistance@@#,2]&),
PerformanceGoal->"Speed", Epilog->dstyle, Circle[], VertexShapeFunction -> "Point", EdgeStyle -> edgestyle, VertexStyle -> dstyle]
]
Example:
FareyDiagram[4]
FareyDiagram[6, 4, ColorFunction -> Hue,
VertexLabelStyle -> Darker[Red]]
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
$endgroup$
Using Graph with a bit of coding:
addPoint[p : h_[a_,b_], q : h_[c_,d_], i_] :=
With[np = h[a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
addPoint[p : h_[-1][a_,b_], q : h_[-1][c_,d_], i_] :=
With[np = h[-1][a + c, b + d], Sow[p [UndirectedEdge] np, np [UndirectedEdge] q]; Sow[i, i, "Depth"]; p, np, q]
fLabel[fr_, angle_] :=
With[tangle=ArcTan@@angle, Placed[fLabel[fr], AngleVector[1/2, 1/2, .7, #] & /@tangle, tangle+Pi]]
fLabel[h_[a_, b_]] := ToString[a] ~~ "/" ~~ ToString[b]
fLabel[h_[-1][a_, b_]] := "-" ~~ ToString[a] ~~ "/" ~~ ToString[b]
FareyDiagram[n_Integer, d_Integer: 1, opts___?OptionQ] :=
Block[fr, top, bottom, stedges, toppart, bottompart, vert, edges, coords, labels, labpos, cfunc, i, edgestyle, dstyle, nopts,
cfunc = ColorFunction /. Flatten[opts] /. ColorFunction -> Automatic;
nopts = FilterRules[Flatten[opts], Options[Graph]];
top = fr[0,1], fr[1,1], fr[1,0];
bottom = fr[1,0], fr[-1][1,1], fr[0,1];
stedges = UndirectedEdge@@@Join[Partition[top, 2, 1], Partition[bottom, 2, 1], fr[0, 1],fr[1, 0]];
i = 0;toppart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#, 2, 1],1]][[All,1]])&, top, n]];
i = 0;bottompart = Reap[Nest[(i++; Split[Flatten[addPoint[#, i] & /@ Partition[#,2,1],1]][[All,1]])&,bottom, n]];
vert = Join[toppart[[1]], bottompart[[1, 2;;-2]]];
edges = Flatten[stedges, toppart[[2, 1]], bottompart[[2, 1]]];
coords = CirclePoints[1,0,Length[vert]];
labpos = Range[1, Length[vert], 2 ^ (d - 1)];
labels = Thread[vert[[labpos]]->fLabel@@@Transpose[vert,coords][[labpos]]];
edgestyle = Black;
dstyle = Black;
If[cfunc =!= Automatic,
edgestyle = Flatten[Table[0, Length[stedges]], toppart[[2, 2]], bottompart[[2, 2]]];
edgestyle = edgestyle / Max[edgestyle];
edgestyle = Thread[edges -> Flatten[cfunc[1 - #] & /@ edgestyle]];
dstyle = cfunc[1]
];
Graph[vert, edges, nopts, VertexCoordinates->CirclePoints[1,0,Length[vert]], VertexLabels->labels,
EdgeShapeFunction->(BSplineCurve[#1[[1]],0,0,#1[[2]], SplineWeights->2,EuclideanDistance@@#,2]&),
PerformanceGoal->"Speed", Epilog->dstyle, Circle[], VertexShapeFunction -> "Point", EdgeStyle -> edgestyle, VertexStyle -> dstyle]
]
Example:
FareyDiagram[4]
FareyDiagram[6, 4, ColorFunction -> Hue,
VertexLabelStyle -> Darker[Red]]
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
edited Apr 9 at 16:08
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
answered Apr 9 at 15:53
halmirhalmir
10.8k2544
10.8k2544
add a comment |
add a comment |
4
$begingroup$
I looked up the Farey sequence on Wikipedia, out of curiosity, because I had not heard of it before. The Farey sequence of order $n$ is "the sequence of completely reduced fractions between 0 and 1 which, when in lowest terms, have denominators less than or equal to $n$, arranged in order of increasing size".
On that basis, you can generate the sequence as follows, for instance:
ClearAll[farey]
farey[n_Integer] := (Divide @@@ Subsets[Range[n], 2]) ~ Join ~ 0, 1 //DeleteDuplicates //Sort
So for instance:
farey[5]
0, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1
I am not sure how these sequences are connected with the figure you showed though.
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
$endgroup$
$begingroup$
Thanks to C.E., it is a concrete answer
$endgroup$
– G. R.
Apr 9 at 12:58
add a comment |
4
$begingroup$
I looked up the Farey sequence on Wikipedia, out of curiosity, because I had not heard of it before. The Farey sequence of order $n$ is "the sequence of completely reduced fractions between 0 and 1 which, when in lowest terms, have denominators less than or equal to $n$, arranged in order of increasing size".
On that basis, you can generate the sequence as follows, for instance:
ClearAll[farey]
farey[n_Integer] := (Divide @@@ Subsets[Range[n], 2]) ~ Join ~ 0, 1 //DeleteDuplicates //Sort
So for instance:
farey[5]
0, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1
I am not sure how these sequences are connected with the figure you showed though.
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
$endgroup$
$begingroup$
Thanks to C.E., it is a concrete answer
$endgroup$
– G. R.
Apr 9 at 12:58
add a comment |
4
4
4
$begingroup$
I looked up the Farey sequence on Wikipedia, out of curiosity, because I had not heard of it before. The Farey sequence of order $n$ is "the sequence of completely reduced fractions between 0 and 1 which, when in lowest terms, have denominators less than or equal to $n$, arranged in order of increasing size".
On that basis, you can generate the sequence as follows, for instance:
ClearAll[farey]
farey[n_Integer] := (Divide @@@ Subsets[Range[n], 2]) ~ Join ~ 0, 1 //DeleteDuplicates //Sort
So for instance:
farey[5]
0, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1
I am not sure how these sequences are connected with the figure you showed though.
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
$endgroup$
I looked up the Farey sequence on Wikipedia, out of curiosity, because I had not heard of it before. The Farey sequence of order $n$ is "the sequence of completely reduced fractions between 0 and 1 which, when in lowest terms, have denominators less than or equal to $n$, arranged in order of increasing size".
On that basis, you can generate the sequence as follows, for instance:
ClearAll[farey]
farey[n_Integer] := (Divide @@@ Subsets[Range[n], 2]) ~ Join ~ 0, 1 //DeleteDuplicates //Sort
So for instance:
farey[5]
0, 1/5, 1/4, 1/3, 2/5, 1/2, 3/5, 2/3, 3/4, 4/5, 1
I am not sure how these sequences are connected with the figure you showed though.
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
answered Apr 8 at 21:59
MarcoBMarcoB
38.8k558117
38.8k558117
$begingroup$
Thanks to C.E., it is a concrete answer
$endgroup$
– G. R.
Apr 9 at 12:58
add a comment |
$begingroup$
Thanks to C.E., it is a concrete answer
$endgroup$
– G. R.
Apr 9 at 12:58
$begingroup$
Thanks to C.E., it is a concrete answer
$endgroup$
– G. R.
Apr 9 at 12:58
$begingroup$
Thanks to C.E., it is a concrete answer
$endgroup$
– G. R.
Apr 9 at 12:58
add a comment |
0
$begingroup$
grupo[n_] := Show[Graphics[Thin, Red,
Circle[0, 0, 1, 0, Pi/2]], Graphics[Thin,
Map[BSplineCurve[#1[[1]], 0, 0, #1[[2]],
SplineWeights -> 2, EuclideanDistance @@
#,2]&,
Partition[ReIm[Exp[Pi/2 I #]] & /@
FareySequence[n], 2, 1]]], Map[Graphics[Blue,
Point[ReIm[Exp[Pi/2 I #]]]] &,
FareySequence[n]], PlotRange -> All]
Show[Table[grupo[n], n, 2, 7]]
answered Apr 16 at 23:48
G. R.G. R.
343
$endgroup$
$begingroup$
the true farey diagram based on the answers given above
$endgroup$
– G. R.
Apr 16 at 23:52
add a comment |
0
$begingroup$
grupo[n_] := Show[Graphics[Thin, Red,
Circle[0, 0, 1, 0, Pi/2]], Graphics[Thin,
Map[BSplineCurve[#1[[1]], 0, 0, #1[[2]],
SplineWeights -> 2, EuclideanDistance @@
#,2]&,
Partition[ReIm[Exp[Pi/2 I #]] & /@
FareySequence[n], 2, 1]]], Map[Graphics[Blue,
Point[ReIm[Exp[Pi/2 I #]]]] &,
FareySequence[n]], PlotRange -> All]
Show[Table[grupo[n], n, 2, 7]]
answered Apr 16 at 23:48
G. R.G. R.
343
$endgroup$
$begingroup$
the true farey diagram based on the answers given above
$endgroup$
– G. R.
Apr 16 at 23:52
add a comment |
0
0
0
$begingroup$
grupo[n_] := Show[Graphics[Thin, Red,
Circle[0, 0, 1, 0, Pi/2]], Graphics[Thin,
Map[BSplineCurve[#1[[1]], 0, 0, #1[[2]],
SplineWeights -> 2, EuclideanDistance @@
#,2]&,
Partition[ReIm[Exp[Pi/2 I #]] & /@
FareySequence[n], 2, 1]]], Map[Graphics[Blue,
Point[ReIm[Exp[Pi/2 I #]]]] &,
FareySequence[n]], PlotRange -> All]
Show[Table[grupo[n], n, 2, 7]]
answered Apr 16 at 23:48
G. R.G. R.
343
$endgroup$
grupo[n_] := Show[Graphics[Thin, Red,
Circle[0, 0, 1, 0, Pi/2]], Graphics[Thin,
Map[BSplineCurve[#1[[1]], 0, 0, #1[[2]],
SplineWeights -> 2, EuclideanDistance @@
#,2]&,
Partition[ReIm[Exp[Pi/2 I #]] & /@
FareySequence[n], 2, 1]]], Map[Graphics[Blue,
Point[ReIm[Exp[Pi/2 I #]]]] &,
FareySequence[n]], PlotRange -> All]
Show[Table[grupo[n], n, 2, 7]]
answered Apr 16 at 23:48
G. R.G. R.
343
answered Apr 16 at 23:48
G. R.G. R.
343
answered Apr 16 at 23:48
G. R.G. R.
343
answered Apr 16 at 23:48
G. R.G. R.
343
343
$begingroup$
the true farey diagram based on the answers given above
$endgroup$
– G. R.
Apr 16 at 23:52
add a comment |
$begingroup$
the true farey diagram based on the answers given above
$endgroup$
– G. R.
Apr 16 at 23:52
$begingroup$
the true farey diagram based on the answers given above
$endgroup$
– G. R.
Apr 16 at 23:52
$begingroup$
the true farey diagram based on the answers given above
$endgroup$
– G. R.
Apr 16 at 23:52
add a comment |
draft saved
draft discarded
Thanks for contributing an answer to Mathematica Stack Exchange!
- Please be sure to answer the question. Provide details and share your research!
But avoid …
- Asking for help, clarification, or responding to other answers.
- Making statements based on opinion; back them up with references or personal experience.
Use MathJax to format equations. MathJax reference.
To learn more, see our tips on writing great answers.
draft saved
draft discarded
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
StackExchange.ready(
function ()
StackExchange.openid.initPostLogin('.new-post-login', 'https%3a%2f%2fmathematica.stackexchange.com%2fquestions%2f194838%2fhow-can-i-plot-a-farey-diagram%23new-answer', 'question_page');
);
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Sign up or log in
StackExchange.ready(function ()
StackExchange.helpers.onClickDraftSave('#login-link');
);
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Sign up using Google
Sign up using Facebook
Sign up using Email and Password
Post as a guest
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
Required, but never shown
$begingroup$
From the beautiful book A. Hatcher Topology of numbers
$endgroup$
– G. R.
Apr 8 at 21:16
2
$begingroup$
Could you perhaps expand a bit on how the curves are calculated etc?
$endgroup$
– MarcoB
Apr 8 at 21:40
1
$begingroup$
pi.math.cornell.edu/~hatcher/TN/TNch1.pdf
$endgroup$
– Moo
Apr 8 at 23:17
1
$begingroup$
Technically this is not a Farey series/sequence $F_n$ of order $n$, which is defined to be all fractions (sometimes restricted to the interval between 0 and 1) with denominator at most $n$. For example 3/8 is present but not 1/8. It's a recursive mediant subdivision. It's related in that in any three successive terms of a Farey sequence, the middle one is the mediant of the other two.
$endgroup$
– Michael E2
Apr 9 at 17:44
$begingroup$
If it wasn't for the very good answers you got, I would have voted to close this question as it gives no details, no definitions no code and shows no personal effort. Please, next time try asking good questions.
$endgroup$
– rhermans
Apr 11 at 9:18