Skip to main content

Is there a way to convert an image into a Graph?


I'm trying to convert an image with several overlapping dots into a Graph. The goal is to be able to derive the Kirchhoff matrix for the randomly created "network of resistors" a.k.a dots with the function KirchhoffMatrix[]. Any thoughts or ideas?


Here's the image I'm trying to extract the graph from: enter image description here


Haha, sorry I suppose I have been pretty vague with this question. I am currently researching percolation simulations. The dots in the image represent metallic particles. The dots the overlap represent metallic particles connected via a resistor. We randomize the dots on the screen, group the ones that are touching with MorphologicalComponents[] // Colorize , and then we Isolate the 'BackBone Cluster' a.k.a the largest component with DeleteSmallComponents[]. We check to see if the cluster spans all the way from the top to the bottom and if it does, the sample percolated. We are then trying to find the conductance of the sample from the BackBone cluster. We have been using the Finite Element Method for this, which requires the KirchhoffMatrix[].


Your answer, Vitaliy Kaurov, looks like it will very thoroughly answer my question. I'm going to test things before I accept it but thank you for putting so much time into it!!



Answer



==== Method 1 ===


Here is a way to get a graph from an image. MorphologicalGraph can get you started.


img = Import["http://i.stack.imgur.com/9HXZ5.png"];

g = MorphologicalGraph[img]

enter image description here


And here is your KirchhoffMatrix of the graph. Please note that MatrixPlot averages values for the best visual representation, - actual plot would be too detailed to be a good representation.


m = KirchhoffMatrix[g]; MatrixPlot[m]

enter image description here


A good guess is that your graph, due to its random nature, not all entirely connected. This maybe important in your case, because with no connection you have no conductance. Here is the way to find all connected components, highlight them and compute their own KirchhoffMatrix.


cc = ConnectedComponents[g];
index = Length /@ ConnectedComponents[g];

ctrl = Sort[MapThread[Rule, {cc, index}], #1[[2]] > #2[[2]] &];
Manipulate[
 GraphicsRow[{HighlightGraph[g, Subgraph[g, n], 
    GraphStyle -> "LargeNetwork"], 
   MatrixPlot[KirchhoffMatrix[Subgraph[g, n]], 
    ColorFunction -> "DarkBands"]}, 
  ImageSize -> 600], {{n, ctrl[[1, 1]], "Vertex number"}, ctrl}, 
 FrameMargins -> 0]

enter image description here



Let's do some math now. Here is a famous property:



The number of times 0 appears as an eigenvalue in the KirchhoffMatrix is the number of connected components in the graph.



The number of connected comments (separate sub-graphs) is found as


 ConnectedComponents[g] // Length


159




And as you can see it is equal to the number of zero eigenvalues :


 ev = Chop[Eigenvalues[N@m]]; Count[ev, 0]


159



Isn't it great to see programming and math matching up perfectly?


Here is the way to list all connected sub-graphs separately. Mouse-over will give KirchhoffMatrix.


Tooltip[#, 
   MatrixPlot[KirchhoffMatrix[Subgraph[g, #]], 

    ColorFunction -> "DarkBands", 
    ImageSize -> 200]] & /@ (Subgraph[g, #, ImageSize -> 80, 
     VertexSize -> 0] & /@ ctrl[[All, 1]])

enter image description here


Note some extra image processing before MorphologicalGraph would result in different graphs. For example finding first SkeletonTransform or DistanceTransform would change the game:


GraphicsRow[{DistanceTransform[Dilation[img, 3]] // ImageAdjust,
  SkeletonTransform[img]}, ImageSize -> 600]

enter image description here



So if you now apply MorphologicalGraph function to these images you of course will get different graphs as result. This maybe useful because there is no exact guarantee that MorphologicalGraph will give you always what you need in all cases, especially with low-res images. Below is an example of possible issue - with real question being where exactly is the boundary between these two cases?


Grid@{{r = .6; 
   img = ColorNegate@
     Graphics[{Disk[{0, 0}, r], Disk[{.5, .9}, r], Disk[{1, 0}, r]}],
   MorphologicalGraph[img, VertexSize -> .1]},
  {r = 1.2; 
   img = ColorNegate@
     Graphics[{Disk[{0, 0}, r], Disk[{.5, .9}, r], Disk[{1, 0}, r]}],
   MorphologicalGraph[img, VertexSize -> .1]}}


enter image description here


So this is just the word of caution - you may need some image pre-processing before you get your MorphologicalGraph. Or you may use something else - see method below.


==== Method 2 ===


This is just an outline, not complete solution:


1) This question and answers by @Verbeia and @Szabolcs and Fred Simons on MathGroup are a starting point


2) They work only if you know center and radius of every point in your image - which you do NOT


3) You can get center and radius of every point by using for example ComponentMeasurements function. Then you can apply methods by @Verbeia and @Szabolcs and Fred Simons on MathGroup.



  • Example 1: This Wolfram Blog gives code for finding what you need even in the case of overlapping particles, like this (image - courtesy of Wolfram Research):



enter image description here



enter image description here


Comments

Post a Comment

Popular posts from this blog

functions - Get leading series expansion term?

Given a function f[x] , I would like to have a function leadingSeries that returns just the leading term in the series around x=0 . For example: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x)] x and leadingSeries[(1/x + 2 + (1 - 1/x^3)/4)/(4 + x)] -(1/(16 x^3)) Is there such a function in Mathematica? Or maybe one can implement it efficiently? EDIT I finally went with the following implementation, based on Carl Woll 's answer: lds[ex_,x_]:=( (ex/.x->(x+O[x]^2))/.SeriesData[U_,Z_,L_List,Mi_,Ma_,De_]:>SeriesData[U,Z,{L[[1]]},Mi,Mi+1,De]//Quiet//Normal) The advantage is, that this one also properly works with functions whose leading term is a constant: lds[Exp[x],x] 1 Answer Update 1 Updated to eliminate SeriesData and to not return additional terms Perhaps you could use: leadingSeries[expr_, x_] := Normal[expr /. x->(x+O[x]^2) /. a_List :> Take[a, 1]] Then for your examples: leadingSeries[(1/x + 2)/(4 + 1/x^2 + x), x] leadingSeries[Exp[x], x] leadingSeries[(1/x + 2 + (1 - 1/x...
Post a Comment
Read more

mathematical optimization - Minimizing using indices, error: Part::pkspec1: The expression cannot be used as a part specification

I want to use Minimize where the variables to minimize are indices pointing into an array. Here a MWE that hopefully shows what my problem is. vars = u@# & /@ Range[3]; cons = Flatten@ { Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; Minimize[{Total@((vec1[[#]] - vec2[[u[#]]])^2 & /@ Range[1, 3]), cons}, vars, Integers] The error I get: Part::pkspec1: The expression u[1] cannot be used as a part specification. >> Answer Ok, it seems that one can get around Mathematica trying to evaluate vec2[[u[1]]] too early by using the function Indexed[vec2,u[1]] . The working MWE would then look like the following: vars = u@# & /@ Range[3]; cons = Flatten@{ Table[(u[j] != #) & /@ vars[[j + 1 ;; -1]], {j, 1, 3 - 1}], 1 vec1 = {1, 2, 3}; vec2 = {1, 2, 3}; NMinimize[ {Total@((vec1[[#]] - Indexed[vec2, u[#]])^2 & /@ R...
Post a Comment
Read more

How to remap graph properties?

Graph objects support both custom properties, which do not have special meanings, and standard properties, which may be used by some functions. When importing from formats such as GraphML, we usually get a result with custom properties. What is the simplest way to remap one property to another, e.g. to remap a custom property to a standard one so it can be used with various functions? Example: Let's get Zachary's karate club network with edge weights and vertex names from here: http://nexus.igraph.org/api/dataset_info?id=1&format=html g = Import[ "http://nexus.igraph.org/api/dataset?id=1&format=GraphML", {"ZIP", "karate.GraphML"}] I can remap "name" to VertexLabels and "weights" to EdgeWeight like this: sp[prop_][g_] := SetProperty[g, prop] g2 = g // sp[EdgeWeight -> (PropertyValue[{g, #}, "weight"] & /@ EdgeList[g])] // sp[VertexLabels -> (# -> PropertyValue[{g, #}, "name"]...
Post a Comment
Read more