Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.
n = 8;
Initial = ToCharacterCode["bgehadfc"] - 96;
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]

enter image description here

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?

share|improve this question
    
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 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 at 15:32

4 Answers 4

up vote 5 down vote accepted

Here is a solution.

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

n = 8;
initial = ToCharacterCode["bgehadfc"] - 96;
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}]}]

enter image description here

share|improve this answer
    
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 at 14:28
    
@forumcash - edited solution accordingly. –  Chris Degnen May 12 at 15:01
    
That's exactly what I need. Thank you for your time and effort. –  forumcash May 12 at 15:38

Further changes to Chris Degnen's code:

n = 8;
initial = ToCharacterCode["bgehadfc"] - 96
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]
}]

enter image description here

share|improve this answer

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, ""];
Graph[UndirectedEdge @@@ Thread[{tag, RotateLeft@tag}], 
  VertexCoordinates -> coor, VertexLabels -> "Name", 
  VertexLabelStyle -> Large, ImagePadding -> 20]

enter image description here

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, ""];
Graph[UndirectedEdge @@@ Thread[{tag, RotateLeft@tag}], 
  VertexCoordinates -> coor, VertexLabels -> "Name", 
  VertexLabelStyle -> Large, ImagePadding -> 20]

enter image description here

share|improve this answer
    
It look very nice. Thank you. –  forumcash May 12 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}]

poly

share|improve this answer

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

Not the answer you're looking for? Browse other questions tagged or ask your own question.