Making a graph or network interactively over an image

Question

Given an image, is it possible to manually draw a graph over it? For example, taking the following image:

I want to manually pick the vertices and draw the edges in a "Paint-like" manner to get, for example,

By manually I mean literally using the mouse to select the vertices.

Any ideas?

Note: This is the "easy" solution to this question, where I intend to build an automatic image processing program. For now, however, a manual solution would suffice.

Answer 1

There are many ways to do this, modifying, improving my method or doing a completely different thing. My goal here is to show a very basic idea that should give you a start. LocatorPane and Manipulate give means of interactive addition/deletion and dragging of points in 2D plane. The problem is how to add an edge -- there has to be interaction between 2 points. The idea used here is the following:

• Assume empty initial list of edges
• Trigger for making an edge is when 2 points become close enough
• Accumulate such edges and build a graph
• Jump through various hoops for proper sorting, duplicate deletion, etc.

Let's start from importing image:

i=Import["https://i.stack.imgur.com/f5PX3.png"];

defining a function:

makeEDGEs[r_][pts_]:=
UndirectedEdge@@@Cases[Union[Sort/@Nearest[pts->"Index",pts,{2,r}]],{_,_}]

Note "Index" property usage, which important, because you need to build edges from indexes of points - not from point coordinates. Read docs on all these functions to understand how it works. r defines distance threshold between the points -- if you go under it an edge will be created. Here is an easy interactive app that uses above function to accumulate edges:

Clear[edges]
edges={};
Manipulate[
edges=Union[edges~Join~makeEDGEs[10][pts]];
g=Graph[Range[Length[pts]],edges,
    VertexCoordinates->pts,
    VertexSize->5{1,1},VertexStyle->Red,
    EdgeStyle->Directive[Thickness[.01],Black]];
Show[i,g],
{{pts,{{100,100},{100,150},{150,100}}},
Appearance->None,Locator,LocatorAutoCreate->True}]

You are adding a point with CMD+CLICK action. Note there are many possible improvements. For instance, optimization for speed. Or "undo" action -- you cal also remove a point with CMD+CLICK action, but this will destroy the graph due to ordering and numbering issues, - so there is no undo for now -- up to you to make it. Cool thing about it is - the graph object is easy to get separately and compute with:

{g, MatrixPlot[AdjacencyMatrix[g]]}

Related Resources

Constructing and Manipulating Graphs

https://demonstrations.wolfram.com/ConstructingAndManipulatingGraphs

Also take a look at this legacy tool:

Needs["GraphUtilities`"]
GraphEdit[]