# How to count the number of n-gons and line intersections in an image of a complete graph?

I would like to count the number of line intersections and number of n-gons in a complete graph (which forms a regular polygon). The only way I've come up with that would allow me to do both in Mathematica would be to:

1. Produce an image of the graph;
2. Apply some image processing tricks. I'm completely new to the world of image processing though.

Here is an example of a 10-graph:

n = 10;
firstCorners = Table[{Cos[2 Pi i], Sin[2 Pi i]}, {i, 0, 1, 1/n}];
lines = Subsets[firstCorners, {2}];
img = Image[Graphics[{Thick, Line[lines]}, ImageSize -> 350]]


I've got no idea how to proceed from here, everything I've tried has failed.

-
"everything I've tried has failed." What exactly have you tried? :) – Öskå May 17 '14 at 16:24
I edited your question so KSubsets is not needed anymore. – Öskå May 17 '14 at 16:31
@GenericUsrnme Do you want image processing solution or graph based solution with Mathematica. you may check mathematica.stackexchange.com/questions/19546/… belisarius's solution for detecting intersection point using image processing solution. For 2d intersection detection algorithms you can check mathematica.stackexchange.com/questions/24211/… for references form this site. – s.s.o May 17 '14 at 18:38
Please note that for a given graph the number of intersections may vary with the choice of layout method. It's not an intrinsic property of a graph. Try for instance Graph[{1 -> 2, 1 -> 3, 1 -> 5, 2 -> 4, 2 -> 6, 3 -> 4, 3 -> 7, 4 -> 8, 5 -> 6, 5 -> 7, 6 -> 8, 7 -> 8}] and Graph[{1 -> 2, 1 -> 3, 1 -> 5, 2 -> 4, 2 -> 6, 3 -> 4, 3 -> 7, 4 -> 8, 5 -> 6, 5 -> 7, 6 -> 8, 7 -> 8}, GraphLayout -> "PlanarEmbedding"]. BTW Your graph can be generated simply by CompleteGraph[10]. – Sjoerd C. de Vries May 17 '14 at 20:18
Ah, thanks!, @Öskå I'm mainly tried ImageCorner/Keypoints/Lines to try and generate a list for the number of intersections but I've only ever managed to get lists much larger than the real value when I've been testing with small n. For example with n=5 I get 2365 Lines, 1347 Corners when there is 10 and 10 respectively. Past this I have no idea what to do - I'm completely new to the Image Processing scene – GenericUsrnme May 18 '14 at 11:06

Here is my humble attempt to solve this problem.

## - Counting the intersections:

Basically I'm just taking every points, I create linear functions out of them, and I search where they intersect.

n=10;
firstCorners=N[Table[{Cos[2 Pi i],Sin[2 Pi i]},{i,0,1,1/n}]];
lines=Subsets[firstCorners[[1;;n]],{2}];
slope[points_]:=Subtract@@(Last/@points)/Subtract@@(First/@points)
eq[points_,x_]:=Quiet@Simplify[slope[points]*x+Last@First@points-First@First@points*slope@points]
isInside[{x_,y_}]:=If[x^2+y^2<=1,True,False]
coor[{i_,j_}]:=
If[Reduce[eq[lines[[i]],x]==eq[lines[[j]],x]&&-1<=x<=1]=!=False,
With[{c=Reduce[x==Reduce[eq[lines[[i]],x]==eq[lines[[j]],x]&&-1<=x<=1][[2]]&&y==eq[lines[[j]],x]&&-1<=y<=1]},
If[c=!=False&&isInside[{x,y}/.ToRules@c],{x,y}/.ToRules@c,{0,0}]],{0,0}]
subsets=Subsets[Range@Length@lines,{2}];
vertical=Flatten@Position[eq[lines[[#]],x]&/@Range@Length@lines,Indeterminate];
samePoint=Flatten@Position[lines,{firstCorners[[#]],_}|{_,firstCorners[[#]]},Infinity]&/@Range@(Length@firstCorners-1);
posSamePoint=Flatten@Position[subsets,#]&/@Flatten[Subsets[#,{2}]&/@samePoint,1]/.{}:>Sequence[];
subsets=Delete[subsets,posSamePoint];
subsets=Cases[subsets, Except[{Alternatives @@ vertical, _} | {_, Alternatives @@ vertical}]];
pts=DeleteDuplicates@Cases[coor@#&/@subsets,_List];//AbsoluteTiming
vpts=DeleteDuplicates@Flatten[Select[Table[With[{x=First@First@lines[[#]]},{x,eq[lines[[i]],x]}],{i,Delete[Range@Length@lines,List/@vertical]}],isInside@#&]&/@vertical,1];
allpts=If[OddQ@n,Cases[DeleteDuplicates@Round[Chop@Flatten[{pts,vpts,firstCorners},1],10^-10],Except[{0,0}]],DeleteDuplicates@Round[Chop@Flatten[{pts,vpts,firstCorners},1],10^-10]];
Length@allpts

{0.491546, Null}
171

Graphics[{Thin, Line[lines], Red, PointSize@.015, Point@allpts}, ImageSize -> 350]


So that method works for at least n = 30. Here is the result with n = 20 (n = 30 is quite messy):

{11.589748, Null}
3861


By running this piece of code for n = Range[3, 10] one can easily find that the number of intersections is equal to {3, 5, 10, 19, 42, 57, 135, 171}. Thus, searching for this sequence in Wolfram|Alpha leads to this OEIS sequence with it's associated Mathematica code:

del[m_, n_] := If[Mod[n, m] == 0, 1, 0];
numberOfNodes[n_] :=
If[n < 4, n,
n + Binomial[n, 4] + del[2, n] (-5 n^3 + 45 n^2 - 70 n + 24)/24 -
del[4, n] (3 n/2) + del[6, n] (-45 n^2 + 262 n)/6 +
del[12, n]*42 n + del[18, n]*60 n + del[24, n]*35 n -
del[30, n]*38 n - del[42, n]*82 n - del[60, n]*330 n -
del[84, n]*144 n - del[90, n]*96 n - del[120, n]*144 n -
del[210, n]*96 n];
numberOfNodes[#] & /@ Range[1, 20]

{1, 2, 3, 5, 10, 19, 42, 57, 135, 171, 341, 313, 728, 771, 1380,
1393, 2397, 1855, 3895, 3861}


Where 171 can be found for n = 10 and 3861 for n = 30. In fact, they all seem to match with my code until n = 30. I haven't tried to go further due to computation time.

## - Counting the n-gons:

I did write a code for that part thanks to the code above, but it only works properly for even n smaller than 14. For this reason I'm not keen to post it here unless requested.

But thanks to this code I found the following sequence of number of n-gons:

{0, 0, 1, 4, 11, 24, 50, 80, 154, 220}


del[m_, n_] := If[Mod[n, m] == 0, 1, 0];
numberOfNGons[n_] := If[n < 3,
0, (n^4 - 6 n^3 + 23 n^2 - 42 n + 24)/24 +
del[2, n] (-5 n^3 + 42 n^2 - 40 n - 48)/48 - del[4, n] (3 n/4) +
del[6, n] (-53 n^2 + 310 n)/12 + del[12, n] (49 n/2) +
del[18, n]*32 n + del[24, n]*19 n - del[30, n]*36 n -
del[42, n]*50 n - del[60, n]*190 n - del[84, n]*78 n -
del[90, n]*48 n - del[120, n]*78 n - del[210, n]*48 n];
numberOfNGons[#] & /@ Range@20

{0, 0, 1, 4, 11, 24, 50, 80, 154, 220, 375, 444, 781, 952, 1456,
1696, 2500, 2466, 4029, 4500}


Finally, for n = 12 I have indeed 444 n-gons and I can then generate this kind of figure:

-
Thanks! I remember seeing that paper before but I could never find it again. This is really helpful though – GenericUsrnme Jul 24 '14 at 20:19
@GenericUsrnme You are welcome :) That was quite a few times ago but I had fun with that :D You can consider accepting it if you like :) – Öskå Jul 24 '14 at 21:19

(This should be a comment, but it got too long. In a nutshell: Don't use image processing for this. It's a computational geometry problem, and you should solve it as such. Look up line sweep algorithms, if you're worried about computational complexity. But for n<=30, a simple brute-force algorithm might be fast enough.)

Getting an image processing solution is pretty easy. You already have img, just use

colors = MorphologicalComponents[DeleteBorderComponents[Binarize[img]]];


to assign a unique index to every connected component of white pixels in img. So Max[img] is the total number of connected component, and Colorize[colors] gives an image where each connected component is colored differently:

Unfortunately, this gives you the wrong result. If you look closely in the image above, there are a few single-pixel "components" that are really artifacts from the drawing algorithm. We can highlight them:

smallComponents =
ComponentMeasurements[
DeleteBorderComponents[Binarize[img]], {"Centroid",
"Area"}, #2 < 5 &];
HighlightImage[Darker@Darker@Colorize[colors],
smallComponents[[All, 2, 1]]]


So this is really only useful if you want to create pretty pictures or if a rough estimate is good enough.

-
Thanks! Would you be able to provide references to any relevant literature on computational geometry? I'm relatively new to the computational end of things here – GenericUsrnme Jul 24 '14 at 20:02