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?
$\begingroup$
$\endgroup$
4
2 Answers
$\begingroup$
$\endgroup$
5
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]
-
$\begingroup$ Nice work... Is there an easy way to count intersecting edges(a1-a2 and a1-a12 ) of lets say vertex a1 (as in below left figure)? $\endgroup$– s.s.oFeb 18, 2013 at 13:06
-
$\begingroup$ @s.s.o, thank you. Not sure if I understand; would the answer in lower-left example be
intersectingEdges[a1]={edge[7,8],edge[3,4]}? ( i.e. the set of edges that intersect the edges incident to a1?) $\endgroup$– kglrFeb 18, 2013 at 13:14 -
$\begingroup$ vertex a1 is used at edge a1-12 and edge a1-12. I want to count edge a1-12 and edge a1-12 with other edges intersections. $\endgroup$– s.s.oFeb 18, 2013 at 13:28
-
$\begingroup$ @s.s.o, that sounds like a good question --"for a given ordering of vertices in a circular layout, find/count the edges that cross the edges incident to vertex v"? Can't think of an easy way. $\endgroup$– kglrFeb 18, 2013 at 13:50
-
$\begingroup$ there the question involves minimization thus more complex. I was just asking about finding intersections. These two links below helped me a bit. demonstrations.wolfram.com/MinimalCrossingsForCompleteGraphs demonstrations.wolfram.com/TheHousesAndUtilitiesCrossingProblem also intrestin mathworld link mathworld.wolfram.com/GraphCrossingNumber.html $\endgroup$– s.s.oFeb 18, 2013 at 19:18
$\begingroup$
$\endgroup$
3
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}]]
-
$\begingroup$ In your code, the position of the vertices was random, and that constrained whether or not edges would cross. I would like the opposite- I want to say which edges should cross, and then the subsequent positions of the edges can be random in the constraint that the edges cross or do not cross. $\endgroup$– j93jd3Dec 18, 2012 at 22:24
-
$\begingroup$ I see, my apologies. I misunderstood. Should I delete the above answer? It is a very inefficient way of doing it, but if the number of vertices in your circle is not too large you could iterate over random graphs using the above code until you find one which fulfils your crossing criteria. $\endgroup$ Dec 19, 2012 at 9:17
-
$\begingroup$ It's a great deal better than nothing :) And it's a great deal better than what I can do. $\endgroup$– j93jd3Dec 19, 2012 at 10:45
Graphics[{Line[{{0,0},{1,1}}]]to draw a lince between points{0,0}and{1,1}. You can use styling to make the latest line appear visually on top. But initially you'll get better help if you try to just make a simple example code demonstrating what you would like to do. $\endgroup$