How to draw line connecting points on circle

Question

Consider the list {1,2,3,4,3,4,2,1}. I want to label these points on circle the way they appear on list(clockwise, counter clock wise doesn't matter). After that I want to connect same points by straight lines. I am not sure how to do this. Any comment appreciated.

I tried:

a = {1, 2, 3, 4, 3, 4, 2, 1}; 
b = DeleteDuplicates[a]; 
c1 = Flatten[Position[a, #, 1][[1]] & /@ b];
c2 = Flatten[Position[a, #, 1][[2]] & /@ b];
pts = Table[{2 Cos[t], 2 Sin[t]}, {t, 0, 2 Pi, 2 Pi/8}]; 
f[x_] := Graphics[Line[{pts[[c1[[x]]]], pts[[c2[[x]]]]}]];

But this give lines separate from each other. Also How do you add circle to that? After @cormullion answer I removed my function. Now I have what I want but without labels.

a = {1, 2, 3, 4, 5, 1, 2, 3, 5, 4};
b = DeleteDuplicates[a];
c2 = Flatten[Position[a, #, 1][[2]] & /@ b];
c1 = Flatten[Position[a, #, 1][[1]] & /@ b];
r = 2;(*radius*)
pts = Table[{r*Cos[t], r*Sin[t]}, {t, 0, 2 Pi, 2 Pi/Length[a]}];
Graphics[{Circle[{0, 0}, r], 
  Line[{pts[[c1[[#]]]], pts[[c2[[#]]]]}] & /@ Range[Length[b]]} ]

Answer 1

A pretty easy solution is to use Graph because there you can

• create edges
• position the vertices on a circle
• label all vertices
• put a circle on it

A somewhat condensed form of this idea is the following

drawMe[l_List] :=
 With[{ed = Range[Length[l]], dphi = 2 Pi/(Length[l])},
  Graph[ed, (UndirectedEdge @@@ 
        Subsets[Flatten[#], {2}]) & /@ (Position[l, #] & /@ 
       Union[l]) // Flatten, 
   VertexLabels -> (Rule @@@ Transpose[{ed, l}]),
   VertexCoordinates -> 
    Table[{Cos[phi], Sin[phi]}, {phi, 0, 2 Pi - dphi, dphi}], 
   Epilog -> {Circle[]}, ImagePadding -> 15]]

drawMe[{1, 2, 3, 4, 5, 1, 2, 3, 5, 4}]

Btw, you can create nice things with this

drawMe@Table[Mod[i, 8], {i, 2^6}]

Answer 2

This is how I would do it:

coords[list_] := 
  With[{offset = 2 Pi/Length[list]}, Array[{Cos[# offset], Sin[# offset]} &, Length[list]]]
lines[list_] := Line[coords[list][[#]] & /@ Partition[Ordering[list], 2]]
labels[labels_, scaling_] := MapThread[Text, {labels, scaling coords[labels]}]

b = {1, 2, 3, 4, 5, 1, 2, 3, 5, 4};
Graphics[{
  Circle[],
  lines[b],
  labels[b, 1.1]
  }]

It assumes there are two of each label. It would have to be adjusted to work for other cases. I think the labeling function will work for your case as well. What it does is take the coordinates of the vertices and multiply them by some constant, to put them further away from the middle.

Answer 3

list = {1, 2, 3, 4, 5, 1, 2, 3, 5, 4};

Using RelationGraph

RelationGraph[UnsameQ[##] && SameQ @@ list[[{##}]] &, Range@Length@list, 
  VertexCoordinates -> CirclePoints[Length@list], 
  VertexLabels -> (MapIndexed[#2[[1]] -> Placed[#, Center] &, list]), 
  GraphStyle -> "SmallNetwork", Prolog -> {Red, Circle[]}]

Using AdjacencyGraph

am = Outer[Boole[Equal@##] &, list, list] - IdentityMatrix[Length@list];
AdjacencyGraph[am, VertexCoordinates -> CirclePoints[Length @ list], 
 VertexLabels -> (MapIndexed[#2[[1]] -> Placed[#, Center] &, list]), 
 GraphStyle -> "SmallNetwork", Prolog -> {Red, Circle[]}]

Note: If you replace CirclePoints[Length @ list]with

Table[{Cos[2 Pi k /Length[list]], Sin[2 Pi k /Length[list]]}, {k, Length@list}]

the second approach also works in versions before 10.1,

Answer 4

Using Reap/Sow:

Graphics[{Circle[], 
  Reap[With[{cp = CirclePoints[Length@list]}, 
     Sow @@@ Thread[{cp, list}]], _, {Line[#2], 
      Function[u, 
        Text[Framed[#1, Background -> Yellow], u]] /@ #2} &][[-1]]}]