Edges and crossing

Question

I want to make a program where I have a collection of labeled vertices and edges between the vertices such that they join up with edges $a_{1} a_{2}, \; a_{2} a_{3}, \ldots ,\; a_{n} a_{1}$, so the edges form a "circle". Then I want to be able to input whether edges cross each other, and if they do, which edge crosses over and which edge crosses under. Is it possible to do this with Mathematica?

Answer 1

  vertices = Array[Subscript[a, #] &, {12}];
  edges = Thread[vertices -> RotateLeft@vertices];
  style = {VertexSize -> .3, VertexLabels -> Placed["Name", {1/2, 1/2}],
    ImagePadding -> 15, ImageSize -> 400};
  g0 = Graph[vertices, edges, style]

 ClearAll[vertexOrderF, foldVertexOrderF];
 vertexOrderF[lst_List, {{a_, b_}, {c_, d_}}] := lst /.
   {left___, part : Alternatives @@ {PatternSequence[b, middle___, c],
    PatternSequence[c, middle___, b]}, right___} :>
 Flatten@{left, Reverse[{part}], right};
 foldVertexOrderF[lst_List, crsedgs : {{{_, _}, {_, _}} ..}] := 
     Fold[vertexOrderF[#1, #2] &, lst, crsedgs]

Examples:

  Graph[vertices[[foldVertexOrderF[Range[12], {{{1, 2}, {7, 8}}}]]], edges, style]
  (* let edge(1,2) and edge(7,8) cross *)

  Grid[Partition[Column[#, Alignment -> Center] & /@
  ({" ", #, Graph[vertices[[foldVertexOrderF[Range[12], #]]],
    edges, style]} & /@ {{{{1, 2}, {9, 10}}},
  {{{1, 2}, {3, 4}}, {{5, 6}, {8, 9}}},
  {{{1, 2}, {3, 4}}, {{4, 5}, {6, 7}}, {{7, 8}, {12, 1}}},
  {{{1, 2}, {3, 4}}, {{4, 5}, {6, 7}}, {{7, 8}, {9, 10}}, {{10, 
     11}, {12, 1}}}}), {2}],
  Dividers -> All]

Answer 2

When you say you want to input, do you mean you want the code to output whether or not the lines cross?

Is this what you're looking for? It's not pretty but it should do the trick. The elements in table t1 below should give you all the information you need. The rows and columns correspond to different edges and when they are non-zero it means that they are intersecting. The values are the positions at which they cross in (x,y) coordinates.

r2 are the vertices of the circle:

r1 = Table[{Random[], Random[]}, {n, 10}];
r2 = Append[r1, r1[[1]]];

These define the lines making up the circle:

lines = Partition[Riffle[r2, r2][[2 ;; -2]], 2];

These are the equations for the lines:

equations = 
 (#[[1, 2]] - #[[2, 2]])/(#[[1, 1]] - #[[2, 1]]) (x - #[[1, 1]]) + #[[1, 2]] & /@ lines;

These functions are just min and max functions for the end points of a given line

minl[m_] := Min[lines[[m, 1, 1]], lines[[m, 2, 1]]]
maxl[m_] := Max[lines[[m, 1, 1]], lines[[m, 2, 1]]]

This gives you a table which contains zero when there is no intersection, and the point of the intersection if there is one. It does not give intersections of lines with themselves or with their neighbours which are trivial.

(t1 = Table[If[Abs[m - n] > 1, 
   With[{p = (x /. Solve[equations[[m]] == equations[[n]], x][[1, 1]])}, 
     If[Max[minl[m], minl[n]] < p < Min[maxl[m], maxl[n]],
       {p, equations[[m]] /. x -> p}, 0]], 0],
   {m, Length[equations]},
   {n,Length[equations]}]) // MatrixForm

This plots the lines generated randomly above and then points in the points of the intersections. I think from t1 you should be able to see, in your definition, which lies above and below which line

Show[Graphics[Line[#] & /@ lines], 
  ListPlot[DeleteCases[Flatten[t1, 1], 0],
  PlotStyle -> {Blue, PointSize -> 0.02}]]