Revisions to Adjacency matrix from image file of plane map

deleted 550 characters in body

Source Link

edited Sep 7, 2015 at 19:19

116.2k
13
205
456

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = ToAdjacencyMatrix@FromOrderedPairs[l];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
ToAdjacencyMatrix@FromOrderedPairs[l] // MatrixPlot

Mathematica graphics

Edit:

Without using Combinatorica

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
UndirectedEdge @@@ DeleteDuplicates[Sort /@ l] // System`Graph // 
                                                   AdjacencyMatrix // MatrixPlot

Mathematica graphics

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = ToAdjacencyMatrix@FromOrderedPairs[l];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
ToAdjacencyMatrix@FromOrderedPairs[l] // MatrixPlot

Mathematica graphics

Edit:

Without using Combinatorica

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
UndirectedEdge @@@ DeleteDuplicates[Sort /@ l] // System`Graph // 
                                                   AdjacencyMatrix // MatrixPlot

Mathematica graphics

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = ToAdjacencyMatrix@FromOrderedPairs[l];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
ToAdjacencyMatrix@FromOrderedPairs[l] // MatrixPlot

Mathematica graphics

Rollback to Revision 5

Source Link

edited Sep 7, 2015 at 19:19

Dr. belisarius

116.2k
13
205
456

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = AdjacencyMatrix@Graph[UndirectedEdge @@@ DeleteDuplicates[Sort /@ l]];ToAdjacencyMatrix@FromOrderedPairs[l];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
MatrixPlot@AdjacencyMatrix@Graph[UndirectedEdgeToAdjacencyMatrix@FromOrderedPairs[l] // MatrixPlot

Mathematica graphics

Edit:

Without using Combinatorica

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
UndirectedEdge @@@ DeleteDuplicates[Sort /@ l]];l] // System`Graph // 
                                                   AdjacencyMatrix // MatrixPlot

Mathematica graphics

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = AdjacencyMatrix@Graph[UndirectedEdge @@@ DeleteDuplicates[Sort /@ l]];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
MatrixPlot@AdjacencyMatrix@Graph[UndirectedEdge @@@ DeleteDuplicates[Sort /@ l]];

Mathematica graphics

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = ToAdjacencyMatrix@FromOrderedPairs[l];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
ToAdjacencyMatrix@FromOrderedPairs[l] // MatrixPlot

Mathematica graphics

Edit:

Without using Combinatorica

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
UndirectedEdge @@@ DeleteDuplicates[Sort /@ l] // System`Graph // 
                                                   AdjacencyMatrix // MatrixPlot

Mathematica graphics

deleted 536 characters in body

Source Link

edited Sep 7, 2015 at 17:56

Dr. belisarius

116.2k
13
205
456

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = ToAdjacencyMatrix@FromOrderedPairs[l];AdjacencyMatrix@Graph[UndirectedEdge @@@ DeleteDuplicates[Sort /@ l]];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
ToAdjacencyMatrix@FromOrderedPairs[l] // MatrixPlot

Mathematica graphics

Edit:

Without using Combinatorica

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
UndirectedEdgeMatrixPlot@AdjacencyMatrix@Graph[UndirectedEdge @@@ DeleteDuplicates[Sort /@ l] // System`Graph // 
                                                   AdjacencyMatrix // MatrixPlotl]];

Mathematica graphics

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = ToAdjacencyMatrix@FromOrderedPairs[l];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

<< Combinatorica`;
i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
ToAdjacencyMatrix@FromOrderedPairs[l] // MatrixPlot

Mathematica graphics

Edit:

Without using Combinatorica

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
UndirectedEdge @@@ DeleteDuplicates[Sort /@ l] // System`Graph // 
                                                   AdjacencyMatrix // MatrixPlot

Mathematica graphics

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /. 
            Rule -> List, 1];
am = AdjacencyMatrix@Graph[UndirectedEdge @@@ DeleteDuplicates[Sort /@ l]];
f[n_] := f[n] = Rasterize@ ImageAdd[
    Image[Unitize[mc - n] /. {1 -> {0, 0, 0}, 0 -> RandomReal[{0, 1}, 3]}, 
          ImageSize -> IntegerPart@(ImageDimensions@i/10)], 
    ColorNegate@i]
k[i_, j_] := k[i, j] = k[j, i] = ImageAdd[f[i], f[j]]
mi = MapIndexed[Tooltip[#1 /. 
            {0 -> Graphics[{FaceForm[White], EdgeForm[Black], Rectangle[]}], 
             1 -> Graphics[{Orange, Rectangle[]}]}, k @@ #2] &, am, {2}];
GraphicsGrid@mi

Or the simpler:

i = Binarize@Import["https://i.sstatic.net/gFZ3F.png"];
mc = MorphologicalComponents[i];
l = Flatten[ Thread /@ ComponentMeasurements[MaxFilter[mc, 3], "Neighbors"] /.
                                                                    Rule -> List, 1];
MatrixPlot@AdjacencyMatrix@Graph[UndirectedEdge @@@ DeleteDuplicates[Sort /@ l]];

Mathematica graphics

added 550 characters in body

Source Link

edited Sep 7, 2015 at 16:32

Dr. belisarius

116.2k
13
205
456

Loading

added 47 characters in body

Source Link

edited Sep 7, 2015 at 13:48

Dr. belisarius

116.2k
13
205
456

Loading

deleted 54 characters in body

Source Link

edited Sep 7, 2015 at 13:15

Dr. belisarius

116.2k
13
205
456

Loading

added 905 characters in body

Source Link

edited Sep 7, 2015 at 6:09

Dr. belisarius

116.2k
13
205
456

Loading

Source Link

created Sep 7, 2015 at 3:48

Dr. belisarius

116.2k
13
205
456

Loading

Stack Exchange Network

Return to Answer