Graph from binary matrix (not adjacency) respecting the original matrix positions

Question

What to do

I have a binary matrix. My objective is to connect every close (without "jump") elements with value equal to 1, but I must keep the point positions, just like it's shown at the image.

Can somebody help me with it, please?

Test input thanks to @hftf:

{{0,1,0,0,1,0,1,0},
 {0,1,0,0,1,0,1,0},
 {0,0,1,0,1,0,1,0},
 {0,0,0,1,0,0,1,0},
 {0,0,0,0,1,1,0,0},
 {0,0,0,0,1,0,0,0}}

@Öskå {{0,1,0,0,1,0,1,0}, {0,1,0,0,1,0,1,0}, {0,0,1,0,1,0,1,0}, {0,0,0,1,0,0,1,0}, {0,0,0,0,1,1,0,0}, {0,0,0,0,1,0,0,0}} — hftf, Commented Jun 8, 2014 at 19:31
Unfortunately, I've tryed to use MorphologicalGraph and SkeletonTransform. Both are not helping me to find a graph similar to the image above. But thanks for you help, @Szabolcs. — Jazz, Commented Jun 8, 2014 at 19:36
@Jazz In what way is the output of MorphologicalGraph incorrect? (I'm trying to understand the question.) — Szabolcs, Commented Jun 8, 2014 at 19:38

Öskå · Accepted Answer · 2014-06-09 12:13:15Z

matOP = {{0, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 1, 0}, {0, 0, 1, 0, 1, 0, 1, 0}, 
         {0, 0, 0, 1, 0, 0, 1, 0}, {0, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}};

$\left( \begin{array}{cccccccc} 0 & 1 & 0 & 0 & 1 & 0 & 1 & 0 \\ 0 & 1 & 0 & 0 & 1 & 0 & 1 & 0 \\ 0 & 0 & 1 & 0 & 1 & 0 & 1 & 0 \\ 0 & 0 & 0 & 1 & 0 & 0 & 1 & 0 \\ 0 & 0 & 0 & 0 & 1 & 1 & 0 & 0 \\ 0 & 0 & 0 & 0 & 1 & 0 & 0 & 0 \\ \end{array} \right)$

binaryGraph[mat_, col_] := Module[{pos, edge, dedge},
  pos = Position[mat, 1];
  edge = Select[Subsets[Range@Length@pos, {2}], 
    Last@# - First@# <= (Max@Dimensions@mat + 1) &]; 
  dedge = DeleteDuplicates[
    UndirectedEdge @@@ (Extract[edge, #] & /@ 
       With[{dist = N@(EuclideanDistance[pos[[#]], pos[[#2]]] & @@@ edge)}, 
        Flatten[Position[dist, #] & /@ 
          DeleteDuplicates@N@Select[dist, # <= Sqrt@2 &]]])];
  Graph[dedge, VertexCoordinates -> 
    Rule @@@ Thread[{Range@Length@pos, ({#2, -#1} & @@@ pos)}], 
    VertexStyle -> col, EdgeStyle -> col]]

arrayPlotGraph[mat_, graph_, sc_, opts : OptionsPattern[]] := 
 ArrayPlot[mat, Epilog -> 
   Inset[Show@graph, ImageScaled[{.5, .5}], 
     ImageScaled[{.5, .5}], ImageScaled@sc],
   PlotRangePadding -> 0, 
   Evaluate[FilterRules[{opts}, Options[ArrayPlot]]]]

g = binaryGraph[matOP, [email protected]]

Mathematica graphics

arrayPlotGraph[matOP, g, .88, ImageSize -> 350]

Mathematica graphics

The same can obviously be done with random matrices:

SeedRandom@0;
mat = RandomInteger[{0, 1}, {20, 20}];
gg = binaryGraph[mat, Red]

Mathematica graphics

arrayPlotGraph[mat, gg, 1, ImageSize -> 350]

Mathematica graphics

If anyone had an idea about how to make ArrayPlot and Graph perfectly overlay at the right position without using ImageScaled@sc and playing around with sc please let me know :)

Note that the process can be reversed (except that last 0-columns and lonely 1 are lost):

rmat = SparseArray[# -> 1 & /@ 
  Rationalize /@ PropertyValue[g, VertexCoordinates]]
Row[MatrixPlot[#, ImageSize -> {200, 200}] & /@ {matOP, rmat}]

Mathematica graphics

It should be working for any matrices as well, just notify me if you have an issue. — Öskå, Commented Jun 8, 2014 at 20:03
@Öskå - so nice ! would there be a way to show that the outermost columns are empty? — eldo, Commented Jun 8, 2014 at 20:05
@eldo How about now? I think it shows that the outermost columns are empty ;o) — Öskå, Commented Jun 9, 2014 at 12:16

kglr · Accepted Answer · 2014-06-10 10:51:57Z

mtrx = {{0, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 1, 0},
        {0, 0, 1, 0, 1, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 1, 0}, 
        {0, 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}};

Once we re-number the elements of mtrx using a function like

renumber = Module[{i = 1}, # /. 1 :> i++] &; (* thanks: Mr.W *)

mtrx2 =renumber@mtrx

ComponentMeasurements, with a little additional processing, provides evertything we need -- vertices, edges, vertex coordinates:

vertices =  ComponentMeasurements[mtrx2, "Label"][[All,1]];
centroids = ComponentMeasurements[mtrx2, "Centroid"];
neighbors = ComponentMeasurements[mtrx2, "Neighbors"];
edges = UndirectedEdge @@@DeleteDuplicates[Sort /@ Flatten[Thread /@ neighbors]];

Graph[vertices, edges, VertexCoordinates -> centroids]

enter image description here

ClearAll[arrayGraph];
arrayGraph[mat_, opts : OptionsPattern[]] := 
 Module[{m = Module[{i = 1}, mat /. 1 :> i++], edges, vcs, v},
  v = ComponentMeasurements[m, "Label"][[All, 1]];
  vcs = ComponentMeasurements[m, "Centroid"];
  edges = UndirectedEdge @@@ 
    DeleteDuplicates[Sort /@ Flatten[Thread /@ ComponentMeasurements[m, "Neighbors"]]];
 Graph[v, edges, VertexCoordinates -> vcs, opts]]

Show[ArrayPlot[mtrx], 
     arrayGraph[mtrx, VertexSize -> .3, EdgeStyle -> Directive[Thick, Red]]]

enter image description here

m2 = RandomInteger[{0, 1}, {20, 20}];
Show[ArrayPlot[m2], arrayGraph[m2, EdgeStyle -> Yellow]]

enter image description here

mat = RandomInteger[{0, 1}, {24, 10, 10}];
Grid[Partition[
       arrayGraph[#, ImageSize -> 120, VertexSize -> .4,
          EdgeStyle -> Directive[{Thick, Hue[RandomReal[]]}]] & /@ mat, 6],
  Background -> Black]

enter image description here

@kguler - concerning the 2nd part of your answer (starting with ClearAll[arrayGraph]; I don't see any lines between the points. Maybe my display shipwrecked? Aside from this: Impressive! — eldo, Commented Jun 10, 2014 at 0:53
@eldo, thank you. Do you mean the image after Show[ArrayPlot[mtrx], arrayGraph[mtrx]] or the last image? — kglr, Commented Jun 10, 2014 at 1:00
@kguler - Yes, I see blue lines and points looking at Öska's answer, but I don't see the lines in your answer. This blue on black is difficult to see anyway.- — eldo, Commented Jun 10, 2014 at 1:07
@kguler...very nice...centroids and neighbours just what was needed...always learning — ubpdqn, Commented Jun 10, 2014 at 3:50

Mr.Wizard · Accepted Answer · 2014-06-10 10:05:14Z

Using old-school GraphPlot:

Edit: the comments that broke the code have been removed.

input =
 {{0,1,0,0,1,0,1,0},
  {0,1,0,0,1,0,1,0},
  {0,0,1,0,1,0,1,0},
  {0,0,0,1,0,0,1,0},
  {0,0,0,0,1,1,0,0},
  {0,0,0,0,1,0,0,0}};

new = Module[{i = 1}, input /. 1 :> i++];

Developer`PartitionMap[Union @@ # &, %, {2, 2}, 1];

Union @@ DeleteCases[%, 0, {-1}];

Union @@ (Subsets[#, {2}] & /@ %);

GraphPlot[Rule @@@ %,
  VertexCoordinateRules -> Reverse[Most @ ArrayRules[new], 2]
]

enter image description here

Operations by line are:

renumber elements
find neighbors
get rid of zeros and duplicates
convert to neighboring pairs
plot

ubpdqn · Accepted Answer · 2014-06-09 09:43:43Z

6

Just another answer (not very efficient):

vis[m_] := Module[{n, gr},
  n = SparseArray[m]["NonzeroPositions"];
  gr = Union[
    UndirectedEdge @@@ (Sort /@ 
       Flatten[Map[
         Function[u, 
          Thread[{w[u], 
            w /@ (Pick[n, 
               Or[Abs[u - #] == {1, 0}, Abs[u - #] == {0, 1}, 
                  Abs[u - #] == {1, 1}] & /@ n])}]], n], 1])];
  Graph[w /@ n, gr, VertexCoordinates -> ({#2, -#1} & @@@ n)]]

Using test matrix:

test = {{0, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 1, 0}, {0, 0, 1, 
    0, 1, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 1, 0}, {0, 0, 0, 0, 1, 1, 0, 
    0}, {0, 0, 0, 0, 1, 0, 0, 0}};

then

vis[test]

enter image description here

Some random small tests:

mat = RandomInteger[{0, 1}, {30, 10, 10}];
GraphicsRow[{ArrayPlot[#], vis[#]}] & /@ mat

and visualizing:

enter image description here

answered Jun 9, 2014 at 9:43

ubpdqn

64.8k3 gold badges65 silver badges154 bronze badges

$\begingroup$ +1! I'm going to steal your ({#2, -#1} & @@@ n) if you don't mind.. :) $\endgroup$
– Öskå
Commented Jun 9, 2014 at 9:56
$\begingroup$ @Öskå just my lazy way of dealing with coordinates...so feel free...have+1 your neat answer $\endgroup$
– ubpdqn
Commented Jun 9, 2014 at 10:01

Add a comment |

lalmei · Accepted Answer · 2014-06-10 11:55:28Z

In this answer the goal is simply to build an adjancy matrix first, that gives you all the information about the graph. The great thing about the code is that you can change how the matrix is connected. For example, in your case you want diagonal components to be connected, here you can change to have only diagonal, only lateral or both. At the moment, is simply set by hand. If you want self connections then one can simply replace the array of positions

{#[[1,1]],....,#[[3,3]]}

with

Flatten[#]

Otherwise this should allow you to generate the adjancy matrix.

myadjancyMatrixforcrystalC[crystal_] := 
     Module[{list = crystal, positions, newcrystal},
             positions = Position[list, 1];
      newcrystal = 
                SparseArray[# -> Range[Length[#]], Dimensions[list], 0] &[positions];
      Return[Map[DeleteCases[#,0] &, 
      {#[[1, 1]], #[[1, 2]], #[[1, 3]], #[[2, 1]], #[[2, 3]], #[[3, 1]], #[[3, 2]], #[[3, 3]]} & /@ (Function[{y}, 
      Take[ArrayPad[newcrystal,1], ##]&@@((# + {1, 1} + {-1, +1}) & /@ y)] /@ positions)]];
      ];

since I was dealing with huge matrixes at the time I wrote it, everything was kept as SparseMatrices, but it may not make much of a difference. Also I don't keep track of the positions of the points, but one could easily return that as part of the code too, to have a graph that can be overlaid over the matrix as some of the other answers, I might add that later.

Here is a small code to takes that adjancy matrix and generates undirected edges.

 myedges[adj_] := Module[{myadj = adj},
    Return[
      DeleteDuplicates[
       Sort /@ Flatten[
     MapIndexed[UndirectedEdge[First@#2, #1] &, myadj, {2}]]]];
  ];

And the graph for your matrix then is simply.

  Graph[myedges[
       myadjancyMatrixforcrystalC[
       {{0, 1, 0, 0, 1, 0, 1, 0}, 
        {0, 1, 0, 0,1, 0, 1, 0}, 
        {0, 0, 1, 0, 1, 0, 1, 0}, 
        {0, 0, 0, 1, 0, 0, 1, 0}, 
        {0, 0, 0, 0, 1, 1, 0, 0},
        {0, 0, 0, 0, 1, 0, 0, 0}}]]]

Since I didn't keep track of the positions it leads to the same topological graph.

enter image description here

As I mentioned you can also keep track of the positions in the first part of the code,

 myadjancyMatrixforcrystalC[crystal_] := 
     Module[{list = crystal, positions, newcrystal},
      positions = Position[list, 1];


 newcrystal = 
   SparseArray[# -> Range[Length[#]], Dimensions[list], 0] &[
    positions];

  Return[{Map[
    DeleteCases[#,0] &, {#[[1, 1]], #[[1, 2]], #[[1, 3]], #[[2, 1]], #[[2, 
       3]], #[[3, 1]], #[[3, 2]], #[[3, 3]]} & /@ (Function[{y}, 
      Take[ArrayPad[newcrystal, 
          1], ##] & @@ ((# + {1, 1} + {-1, +1}) & /@ y)] /@ 
     positions)], 
 Rule @@@ 
    Thread[{Range[Length[#]], #}] &@({1, -1}*# & /@ (Reverse /@ 
      positions))}];
 ];

Now the module myadjancyMatrixforcrystalC returns {adjancy_matrix,vertex->posisionts} , where the second component is given above by

 Rule@@@ 
    Thread[{Range[Length[#]], #}] &@({1, -1}*#&/@(Reverse /@ 
      positions))

which is simply vertexid->position, the rest of the math is simply due to the fact Position measures the upper left matrix location as {1,1} and increases as we go to further rows and columns, and therefore matches with results from say ArrayPlot

The positions can be added as option in Graph.

Graph[myedges[#[[1]]], VertexCoordinates -> #[[2]]] &[
  myadjancyMatrixforcrystalC[{{0, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 1,
 0, 1, 0}, {0, 0, 1, 0, 1, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 1, 0}, {0,
 0, 0, 0, 1, 1, 0, 0}, {0, 0, 0, 0, 1, 0, 0, 0}}]]

enter image description here

yode · Accepted Answer · 2017-05-02 14:42:54Z

2

mat = {{0, 1, 0, 0, 1, 0, 1, 0}, {0, 1, 0, 0, 1, 0, 1, 0}, {0, 0, 1, 
    0, 1, 0, 1, 0}, {0, 0, 0, 1, 0, 0, 1, 0}, {0, 0, 0, 0, 1, 1, 0, 
    0}, {0, 0, 0, 0, 1, 1, 0, 0}}; 


pos = SparseArray[mat]["NonzeroPositions"];
NearestNeighborGraph[pos, DistanceFunction -> ChessboardDistance, 
 VertexCoordinates -> RotationTransform[-Pi/2]@pos]

edited May 2, 2017 at 14:42

answered Feb 12, 2017 at 18:57

yode

27.2k4 gold badges66 silver badges174 bronze badges

Add a comment |

Stack Exchange Network

Graph from binary matrix (not adjacency) respecting the original matrix positions

6 Answers 6

Your Answer

Not the answer you're looking for? Browse other questions tagged
matrix
graphs-and-networks
binary
or ask your own question.

Linked

Hot Network Questions

Graph from binary matrix (not adjacency) respecting the original matrix positions

6 Answers 6

Your Answer

Sign up or log in

Post as a guest

Not the answer you're looking for? Browse other questions tagged matrixgraphs-and-networksbinary or ask your own question.

Linked

Related

Hot Network Questions

Not the answer you're looking for? Browse other questions tagged
matrix
graphs-and-networks
binary
or ask your own question.