determine number of fibers at junctions

Question

I work on a structural analysis of SEM image of a gel. I extracted the center of fibers by binarizing ane seletonizing the picture in ImageJ (in red). Then I extracted the positions of junctions where fibers cross using Ultimate Points also in ImageJ(in blue). I want to extract the information on how many fibers cross at a given junction (e.g. histogram). I thought of making a matrix of size 5 or 7 with the position of junction in the middle and then summing up all integers at the sides of the matrix, but I have no idea how to do it. Any idea how to proceed?

Files with positions of points for fibers and junctions below: https://www.dropbox.com/s/93onef13rrkdxrz/fibers.txt?dl=0 https://www.dropbox.com/s/1pjbf2nu8ww17pe/junctions.txt?dl=0

Answer 1

I try to show how you might use Nearest for detecting neighboting white pixels and Graph for connectedness analysis.

This is not perfect as it counts only the neigboring pixels of a junction: For me, a junction is a pixel with more than two direct neighbors. So there might be many false positives.

<< Developer`;
SetDirectory[FileNameJoin[{$HomeDirectory, "Downloads"}]]
fibers0 = ToPackedArray@Import["fibers.txt", "Table"];
(*cutting out a reactangular piece of the data*)

A = SparseArray[fibers0 -> 1];
i0 = 1; i1 = 80;
j0 = 1; j1 = 50;
fibers = A[[i0 ;; i1, j0 ;; j1]]["NonzeroPositions"];
edges = DeleteDuplicates[Sort /@ Join @@ Map[
      x \[Function] Thread[UndirectedEdge[First[x], Rest[x]]],
      Nearest[fibers -> Automatic, fibers, {\[Infinity], 1}, 
       DistanceFunction -> ChessboardDistance]
      ]
   ];
G = Graph[Range[Length[fibers]], edges,
   VertexCoordinates -> fibers,
   VertexSize -> .5,
   VertexLabels -> Placed["Name", Tooltip]];
degrees = AssociationThread[VertexList[G], VertexDegree[G]];
degreegroups = KeySort@GroupBy[Normal[degrees], Last -> First];
junctions = 
 Flatten[Values[KeyDrop[degreegroups, {0, 1, 2}]]]; counts = 
 Length /@ degreegroups;
BarChart[counts, PlotRange -> All, ChartLabels -> Keys[counts]]

Here is the colorization of the graph with respect to junction degree:

HighlightGraph[G, degreegroups /@ Keys[KeyDrop[degreegroups, {1, 2}]],
  ImageSize -> Large]

As you can see, there are many triangles and some quadrangles that ought to be collapsed into single junctions. At least the triangles can be handled by the Mathematica package IGraphM by Szabolcs.

Answer 2

here I how I approached to problem (code is not clean, but works)

skeleton

junctions

Once more, I sued ImageJ to skeletonize image and find the Ultimate Points to get junctions (Pics above) First, I import files, read in the position of pixels and visualize it:

Import["skeleton.jpg"] // ImageRotate[#, -90 Degree] & // Binarize // 
    ImageData // (mask = #) & // 
  Position[#, 0] & // (points = #) & // Point //   
Graphics[{Red, #}] & // (sk = #) &;
Import["junctions.jpg"] // ImageRotate[#, -90 Degree] & // Binarize //
    ImageData // Position[#, 0] & // (pointsUlti = #) & // Point //
Graphics[{PointSize[0.01], Green, #}] & // (ultiPoints = #) &;
Show[sk, ultiPoints]

Then I delete the points for junctions that are too close to edges:

DeleteCases[pointsUlti, 
x_ /; x[[1]] < 4 || x[[1]] > 836 || x[[2]] < 4 || 
x[[2]] > 836] // (newPoints = #) &;

Next, because Mathematica is interpreting data differently I reverse the matrix with data and define how many neighours there are in 3x3 matrix with the center positioned where the juncion is:

(mask - 1) // Abs // (list = #) &;
i = 1;
l = 1;
threeFibers3 = {};
fourFibers3 = {};
other3 = {};
threex3 = {};
Table[newPoints[[i]] // 
   list[[#[[1]] - l ;; #[[1]] + l, #[[2]] - l ;; #[[2]] + l]] & //
   Total // Total // (value = # - 1) & // AppendTo[threex3, #] &;
If[value == 3, AppendTo[threeFibers3, newPoints[[i]]], 
If[value == 4, AppendTo[fourFibers3, newPoints[[i]]], 
 AppendTo[other3, newPoints[[i]]]]], {i, 1, (newPoints // Length)}];
threeFibers3 // Point // 
Graphics[{PointSize[0.008], Green, #}] & // (ttt = #) &;
fourFibers3 // Point // 
Graphics[{PointSize[0.008], Blue, #}] & // (tttt = #) &;
other3 // Point // 
Graphics[{PointSize[0.01], Black, #}] & // (tt = #) &;
Show[sk, tt, ttt, tttt]
Histogram[threex3, {1}, "Probability"]

Then you get junctions with 3 fibers in green, with 4 blue, and all other with black

Next, I check if the results with a bigger matrix 5x5 give a more realistic results. I use 5x5 atrix centered at junction position - 3x3 matrix just to get values from edges:

 i = 1;
 l = 2;
 threeFibers5 = {};
 fourFibers5 = {};
 other5 = {};
 fivex5 = {};
 Table[newPoints[[i]] // 
    list[[#[[1]] - l ;; #[[1]] + l, #[[2]] - l ;; #[[2]] + l]] & //
    Total // Total // (value = # - (threex3[[i]] + 1)) & // 
 AppendTo[fivex5, #] &;;
If[value == 3, AppendTo[threeFibers5, newPoints[[i]]],
 If[value == 4, AppendTo[fourFibers5, newPoints[[i]]],
 AppendTo[other5, newPoints[[i]]]]]
, {i, 1, (newPoints // Length)}];
threeFibers5 // Point // 
Graphics[{PointSize[0.008], Darker[Green], #}] & // (ttt5 = #) &;
fourFibers5 // Point // 
Graphics[{PointSize[0.008], Blue, #}] & // (tttt5 = #) &;
other5 // Point // 
Graphics[{PointSize[0.01], Black, #}] & // (tt5 = #) &;
Show[sk, tt5, ttt5, tttt5]
Histogram[
Table[3, (threeFibers5 // Length)]~Join~
Table[4, (fourFibers5 // Length)]~Join~
Table[5, (other5 // Length)], {1}, "Probability"]

This gives you a more probable results if you look at them, when you compare the approach with 3x3 matrix and 5x5 matrix

Once more, sorry for messy code, but that's current working condition. This way you have a realistic view on the junctions ~80% have 3 fibers,~17% 4 and rest is "other"