# How to thread lines through the n-th roots of unity in a given order

n = 8;
RootsOfUnity = Table[E^((2 k I \[Pi])/n), {k, n}];

Line1 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[5]]], Part[Im[#] & /@ RootsOfUnity, Initial[[5]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[6]]], Part[Im[#] & /@ RootsOfUnity, Initial[[6]]]}}]];
Line2 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[6]]], Part[Im[#] & /@ RootsOfUnity, Initial[[6]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[7]]], Part[Im[#] & /@ RootsOfUnity, Initial[[7]]]}}]];
Line3 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[7]]], Part[Im[#] & /@ RootsOfUnity, Initial[[7]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[8]]], Part[Im[#] & /@ RootsOfUnity, Initial[[8]]]}}]];
Line4 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[8]]], Part[Im[#] & /@ RootsOfUnity, Initial[[8]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[1]]], Part[Im[#] & /@ RootsOfUnity, Initial[[1]]]}}]];
Line5 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[1]]], Part[Im[#] & /@ RootsOfUnity, Initial[[1]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[2]]], Part[Im[#] & /@ RootsOfUnity, Initial[[2]]]}}]];
Line6 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[2]]], Part[Im[#] & /@ RootsOfUnity, Initial[[2]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[3]]], Part[Im[#] & /@ RootsOfUnity, Initial[[3]]]}}]];
Line7 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[3]]], Part[Im[#] & /@ RootsOfUnity, Initial[[3]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[4]]], Part[Im[#] & /@ RootsOfUnity, Initial[[4]]]}}]];
Line8 = Graphics[ Line[{{Part[Re[#] & /@ RootsOfUnity, Initial[[4]]], Part[Im[#] & /@ RootsOfUnity, Initial[[4]]]}, {Part[Re[#] & /@ RootsOfUnity, Initial[[5]]], Part[Im[#] & /@ RootsOfUnity, Initial[[5]]]}}]];

VerticesNumbers = Graphics[Table[Text[Style[FromCharacterCode[i + 96], Large], {Cos[(i 2 \[Pi])/n], Sin[(i 2 \[Pi])/n]}], {i, n}]];

Show[Line1, Line2, Line3, Line4, Line5, Line6, Line7, Line8, VerticesNumbers, Axes -> False]


Code on the above has irrelevant repetition. I need to put some thing (like For Loop or array), but When I add I don't get the graph. Do you have any idea how to get rid of this repetition?

-
Something like this: pts = RandomReal[{0, 1}, {5, 2}]; order = RandomSample[Range[5]]; lines = Line[pts[[#]]] & /@ Partition[order, 2, 1]; Graphics[lines]? – Yves Klett May 12 '14 at 14:53
Thanks for the answer, but I couldn't modify the code for my purpose. I think I make some syntax error. – forumcash May 12 '14 at 15:32

Here is a solution.

I have kept the line names the same for comparison with the OP's original code.

n = 8;
roots = Table[E^((2 k I \[Pi])/n), {k, n}];

f = Through[{Re, Im}@roots[[initial[[#]]]]] &;

{line5, line6, line7, line8, line1, line2, line3, line4} =
Line[{f[#1], f[#2]}] & @@@ Partition[Range[8], 2, 1, 1];

Graphics[{line1, line2, line3, line4, line5, line6, line7, line8,
Table[Text[Style[FromCharacterCode[i + 96], Large],
{Cos[(i 2 \[Pi])/n], Sin[(i 2 \[Pi])/n]}], {i, n}]}]


-
Sorry, I didn't add graph. It should look like the picture I just added. Main idea is order of letters is important. I will give an ordered 8 letters, and code will make connection between them respect to the order. – forumcash May 12 '14 at 14:28
@forumcash - edited solution accordingly. – Chris Degnen May 12 '14 at 15:01
That's exactly what I need. Thank you for your time and effort. – forumcash May 12 '14 at 15:38

Further changes to Chris Degnen's code:

n = 8;
roots = E^(2 I π Range[n]/n);

lines = {Re@#, Im@#}\[Transpose] & /@ Partition[roots[[initial]], 2, 1, 1];

Graphics[{
Line @ lines,
Array[Text[Style[FromCharacterCode[# + 96], Large], {Cos@#, Sin@#} &[# 2 π/n]] &, n]
}]


-

Yet an other solution but with a Graph alternative:

letters = "bgehadfc";
n = StringLength@letters;
initial = ToCharacterCode[letters] - 96;
roots = Table[E^((2 k I π)/n), {k, n}];
coor = {Re@#, Im@#} & /@ roots[[initial]];
tag = StringSplit[letters, ""];
VertexCoordinates -> coor, VertexLabels -> "Name",
VertexLabelStyle -> Large, ImagePadding -> 20]


You can easily adapt it to make random Graph:

n = 15;
letters = FromCharacterCode[RandomSample[Range[97, 97 + n - 1], n]]
initial = ToCharacterCode[letters] - 96
roots = Table[E^((2 k I π)/n), {k, n}];
coor = {Re@#, Im@#} & /@ roots[[initial]];
tag = StringSplit[letters, ""];
VertexCoordinates -> coor, VertexLabels -> "Name",
VertexLabelStyle -> Large, ImagePadding -> 20]


-
It look very nice. Thank you. – forumcash May 12 '14 at 16:56

As usual, I will contribute a naive, step-by-step solution.

n = 8;
RootsOfUnity = Table[E^((2 k I π)/n), {k, n}];
pts = {Re[#], Im[#]} & /@ RootsOfUnity;
lblChrs = Take[CharacterRange["a", "z"], n];
labels = MapThread[Text[Style[#1, "SR", Large], 1.08 #2] &, {lblChrs, pts}];
ordering = List /@ (ToCharacterCode["bgehadfc"] - 96);
orderedPts = Extract[pts, ordering];
AppendTo[orderedPts, orderedPts[[1]]];
Graphics[{Line[orderedPts], labels}]


-