A unit distance graph is a graph that is embeddable in the plane so that every edge has length 1.
UnitDistanceQ[input_]:=Module[
{g, x, F, v, min, nod, gl},
g = input;
gl = Length[g]; (* Vertex Count *)
(* 2 vertex count variables x1, x2, etc... *)
x = Table[Symbol@@ToExpression["x" <> ToString[i]], {i, 1, 2*gl}];
(* The force to minimize is the squared error of the lengths *)
F = \!\(
\*UnderoverscriptBox[\(\[Sum]\), \(i = 1\), \(gl\)]\(
\*UnderoverscriptBox[\(\[Sum]\), \(j = 1\), \(gl\)]g[[i, j]] \((\((x[[2 i]] - x[[2 j]])\)^2 + \((x[[2 i - 1]] - x[[2 j - 1]])\)^2 - 1)\)^2\)\);
(* Initial vertex positions *)
v = Table[gl*Random[], {i, 1, 2*gl}];
(* Minimization *)
{min, nod} = FindMinimum[F, Transpose[{x,v}], Method->"QuasiNewton"];
(* Output Solution *)
If[min < 10^-3,
Print[{min,nod}];
GraphPlot[g, VertexCoordinateRules ->
Thread[Range[gl] -> Partition[ x /. nod, 2]],
AspectRatio -> Automatic,
VertexLabeling -> None,
ImageSize->Small]
]
]
For example, the Golomb graph is unit distance.
g = Graph[
UndirectedEdge @@@ {{1, 2}, {1, 3}, {1, 4}, {2, 3}, {2, 6}, {3,
8}, {4, 5}, {4, 9}, {4, 10}, {5, 6}, {5, 10}, {6, 7}, {6,
10}, {7, 8}, {7, 10}, {8, 9}, {8, 10}, {9, 10}}];
m = AdjacencyMatrix[g];
UnitDistanceQ[m]
(* gives
FindMinimum::sdprec: Line search unable
to find a sufficient decrease in the function value with
MachinePrecision digit precision. >>
*)
So the question is how to check for a unit distance embedding as fast as possible, my code is not working yet but I think something along these lines will work...
My iterative approach works well for the Golomb graph when run many times
This is a great question and cool algorithms could be invented here!
UnitDistance
is meant to work? $\endgroup$g
is a graph, you'll want to useVertexCount
rather thanLength
to determine the number of vertices. $\endgroup$