How to count the grid in the picture

Question

I want to count how many grids in colunm and row,I know the answer is 38*11,But how can I use mma to count it?It confusion me to think it long.

Answer 1

i = Import["https://i.stack.imgur.com/XKqb1.png"];
iD = ImageData[i, Automatic];

Let us look at the first row in the image:

Short[iD[[1, ;;]], 5]

{{220,220,220,255},{254,254,254,255},{252,252,252,255},{252,252,252,255},{252,252,252,255},
{238,238,238,255},{225,225,225,255},{252,252,252,255},{252,252,252,255},{252,252,252,255},
{252,252,252,255},{246,246,246,255},{221,221,221,255},<<210>>,{238,238,238,255},{252,252,252,255},
{252,252,252,255},{252,252,252,255},{252,252,252,255},{231,231,231,255},{231,231,231,255},
{252,252,252,255},{252,252,252,255},{252,252,252,255},{252,252,252,255},{249,249,249,255}}

We see that all the pixels have equal the R,G,B channel values and most of the pixels have {R,G,B,Alpha} channel values {252,252,252,255} - it is the background. Other pixels mostly have darker colors - they represent the grid lines, brighter pixels are due to anti-aliasing applied to the grid lines and they always are adjacent to the darker pixels. It is important that the first and the last pixels are darker - it means that there probably were also grid lines which were cropped and for the last grid line we have only the adjacent line due to anti-aliasing which is only a little darker than the background.

Considering that the R,G,B channel values are equal, we may take only first of them and then split the list by the criterion of whether the color is darker than 252 or not:

ListLinePlot[iD[[1, ;; , 1]], Filling -> {1 -> 255}, AspectRatio -> 1/10, 
 ImageSize -> 700]
Length /@ SplitBy[iD[[1, ;; , 1]], # < 252 &]

{1, 4, 2, 4, 2, 5, 2, 4, 2, 4, 2, 4, 2, 4, 2, 4, 3, 4, 2, 4, 2, 4, 2, 4, 2, 4, 3, 4, 2, 
4, 2, 4, 2, 4, 2, 4, 2, 5, 2, 4, 2, 4, 2, 4, 2, 4, 2, 4, 3, 4, 2, 4, 2, 4, 2, 4, 2, 4, 3, 
4, 2, 4, 2, 4, 2, 4, 2, 4, 3, 4, 2, 4, 2, 4, 2, 4, 1}

We see that the background pixels mostly occur in groups of 4 successive pixels while the grid lines occur in groups of 2 - 3 pixels with only exception for the first and the last grid lines. Now we can simply count the grid lines:

Count[SplitBy[iD[[1, ;; , 1]], # < 252 &], {c_ /; c < 252, ___}] 

39

We counted 39 grid lines with the last represented by the bordering pixels which arose due to antialiasing and visually are almost indistinguishable from the background. Whether the latter should be counted as a grid line is up to you. The following subtle change of the grouping criterion and the counting criterion discards it from the count:

Count[SplitBy[iD[[1, ;; , 1]], # == 252 &], {c_ /; c != 252, __}]

38

So we have found that the first row contains 38 easily visually distinguishable vertical grid lines.

Application of this procedure for determination of the number of horizontal grid lines I left for you as an exercise. The only note: don't take for the analysis the first two columns because they belong to the first vertical grid line.

Have fun!

---

P.S. Only after writing this I realized that the first row is also affected by the anti-aliasing applied to a horizontal grid line which was later cropped. If we take for the analysis the second or the third row of the image the procedure simplifies:

Count[SplitBy[iD[[3, ;; , 1]], # == 255 &], {c_ /; c < 255, ___}]

39

But now it becomes even lesser obvious whether we should count the last (almost visually indistinguishable from the background) vertical grid line or not: both the first and the last vertical grid line have widths only one pixel and differ from the background much stronger than in the case of above analysis performed for the first row of the image:

ListLinePlot[iD[[3, ;; , 1]], Filling -> {1 -> 255}, AspectRatio -> 1/10, 
 ImageSize -> 700]
Short[iD[[3, ;; , 1]]]

{231,255,255,255,255,236,217,255,255,255,255,247,211,255,
<<207>>,255,217,236,255,255,255,255,226,225,255,255,255,255,248}

In such situation it is preferred to count either both or none of them as actual vertical grid lines. If you prefer the latter, proceed using the following modification of the counting criterion:

Count[SplitBy[iD[[3, ;; , 1]], # == 255 &], {c_ /; c < 255, __}]

37

---

UPDATE

A curious fact: the gray pixels create some interesting periodical pattern when plotted:

ListPlot[iD[[3, ;; , 1]], AspectRatio -> 1/10, ImageSize -> 700]

By taking every second pixel we can make the pattern more evident:

indexedList = MapIndexed[{#2[[1]], #1} &, iD[[3, ;; , 1]]];
ListPlot[{indexedList[[;; ;; 2]], indexedList[[2 ;; ;; 2]]}, AspectRatio -> 1/10, 
 ImageSize -> 700]

Looks very similar to Abs[Sin[x]], isn't it?

lst1 = DeleteCases[indexedList[[;; ;; 2]], {_, 255}];
ListPlot[lst1, AspectRatio -> 1/10, ImageSize -> 700]
Plot[45 (1 - Abs[Sin[x/21 + .7]]) + 210, {x, 0, 235}, AspectRatio -> 1/10, 
 ImageSize -> 700]

Let us try to fit the model to the data without edge points:

model = scY (1 - Abs[Sin[x/scX + shX]]) + shY;
nlm = NonlinearModelFit[lst1[[2 ;; -2]], 
   model, {{shX, .7}, {shY, 210}, {scY, 45}, {scX, 21}}, x];
Plot[nlm[x], {x, 0, 235}, Epilog -> Point@lst1]
ListPlot[Table[{p[[1]], Abs[p[[2]] - nlm[p[[1]]]]}, {p, lst1}], PlotRange -> All, 
 Filling -> {1 -> Axis}]

I'm not sure how this pattern has to be explained but both edge values fall out of the regularity. It supports the decision do not count them.

Answer 2

I have somethint to share,With the help of @AlexeyPopkov ,I can do it right now like this:

list1 = ImageData[
    ColorConvert[pic // RemoveAlphaChannel, "Grayscale"], Automatic][[
   1]];
Split[list, Abs[# - 252] <= 4 &] // 
  Select[#, Length[#] != 1 &] & // Length
(*38*)

list2 = ImageData[
    ColorConvert[pic // RemoveAlphaChannel, "Grayscale"], Automatic][[
   All, -1]];
Split[list, Abs[# - 252] <= 4 &] // 
  Select[#, Length[#] != 1 &] & // Length
(*11*)

But I think a another way to solve it,the code is that:

pic1 = MorphologicalBinarize[pic // ColorNegate, 0.08] // ColorNegate;
pic2 = MorphologicalComponents[pic, 0.04] // Colorize // Binarize // 
   ColorNegate;
pic3 = ImageAdd[pic2, pic1];
pic3 // ComponentMeasurements[#, "Centroid"] & // 
 Show[pic3, 
   Graphics[{Blue, 
     MapIndexed[Inset[Style[#2[[1]], 8], #1] &, #[[All, 2]]]}]] &

the result is:

Anyway thanks anybody.