10
$\begingroup$

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

enter image description here

$\endgroup$
3
  • $\begingroup$ @rm-rf The points are put on circle in same distance from each other. Since we have 8 values I think we can use 2pi/8. Then I want to connect 1-1, 2-2,likewise. think correct word is label (not mark). $\endgroup$
    – Vajira
    Oct 31, 2013 at 18:45
  • $\begingroup$ Would you like to rename your question "how do I label this diagram?" :) $\endgroup$
    – cormullion
    Oct 31, 2013 at 20:07
  • $\begingroup$ @cormullion Yes. That would be great.:) $\endgroup$
    – Vajira
    Oct 31, 2013 at 20:11

4 Answers 4

13
$\begingroup$

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

Mathematica graphics

Btw, you can create nice things with this

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

Mathematica graphics

$\endgroup$
5
$\begingroup$

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

gfx

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.

$\endgroup$
2
$\begingroup$
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[]}]

enter image description here

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

enter image description here

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,

$\endgroup$
1
$\begingroup$

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

enter image description here

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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