# Number of similar pixels on a loop arround some pixel

I defined a command ŠtejTakePiksleOkol, that counts the number of pixels on a square loop arround some pixel, that have similar normalized RGB. If the square loop would go over the edge of the picture it only takes the loop bounded by the edge of the image.

ŠtejTakePiksleOkol[slikapiksli_, baarva_, \[Epsilon]_, sred_,
polm_] := {
resx = Length[slikapiksli[[1]]  ];
resy = Length[slikapiksli];
\[CapitalDelta]naštetih = 0;

(*edges of the loop*)
levo = If[polm >= sred[[2]], 1, sred[[2]] - polm  ];
desno = If[sred[[2]] + polm > resx, resx, sred[[2]] + polm ];
gor = If[polm >= sred[[1]], 1, sred[[1]] - polm];
dol = If[sred[[1]] + polm > resy, resy, sred[[1]] + polm];
(*pixels we have to check*)
kpnk = If[polm == 0,
{sred},
Flatten[
{
Table[
{dol, x},
{x, levo, desno - 1}],
Table[
{y, desno},
{y, gor + 1, dol}],
Table[
{gor, x},
{x, levo + 1, desno}],
Table[
{y, levo},
{y, gor, dol - 1}]
},
1]
];
(
{i1, i2} = #;
If[
Normalize[baarva].Normalize[slikapiksli[[i1, i2]]  ] >
1 - \[Epsilon],
\[CapitalDelta]naštetih++;
]
) & /@ kpnk;
\[CapitalDelta]naštetih
}[[1]]


Where slikapiksli is the image data, baarva is the wanted RGB, $$\epsilon$$ is sth like the allowed difference, sred is the middle pixel and polm is the max 'radius' of the loop.

Now let's make a simple image

slikakrogca = Image[
Table[
If[i1^2 + i2^2 < 100^2, {0, 1, 1}, {1, 1, 1}],
{i1, -300, 500},{i2, -700, 500}]
]


Now apply the function for radius polm=15

AbsoluteTiming[
ŠtejTakePiksleOkol[ImageData[slikakrogca], {0, 1, 1}, .001, {3, 40}, 15]
]

{0.0134907, 0}


The same for polm=16

AbsoluteTiming[
ŠtejTakePiksleOkol[ImageData[slikakrogca], {0, 1, 1}, .001, {3, 40}, 16]
]

{0.536426, 0}


And for polm=700

AbsoluteTiming[
ŠtejTakePiksleOkol[ImageData[slikakrogca], {0, 1, 1}, .001, {3, 40}, 700]
]

{0.583814, 185}


Basically it slows down horribly from 15 to 16. Why is that and how to fix it?

I made a version of your code mostly to understand it. But the timing issue seems to have disappeared as well, so I will post it. If I have time later I might try to optimize it further.

getPixels[imageData_, center_, 0] := {center}
resx = Length[imageData[[1]]],
resy = Length[imageData],
columnStart,
columnEnd,
rowStart,
rowEnd
},
columnStart = If[
1,
];
columnEnd = If[
resx,
];
rowStart = If[
1,
];
rowEnd = If[
resy,
];
Flatten[{
Table[{rowEnd, x}, {x, columnStart, columnEnd - 1}],
Table[{y, columnEnd}, {y, rowStart + 1, rowEnd}],
Table[{rowStart, x}, {x, columnStart + 1, columnEnd}],
Table[{y, columnStart}, {y, rowStart, rowEnd - 1}]
}, 1]
]

countSimilarPixels[imageData_, rgbValue_, allowedDifference_, center_,
Normalize[rgbValue].Normalize[imageData[[#, #2]]] > 1 - allowedDifference &,
];

testImage = Image[Table[If[i1^2 + i2^2 < 100^2, {0, 1, 1}, {1, 1, 1}], {i1, -300, 500}, {i2, -700, 500}]];

AbsoluteTiming[countSimilarPixels[ImageData[testImage], {0, 1, 1}, .001, {3, 40}, 50]]

(* Out: {0.012622, 0} *)


# Second look

I had another look at the function getPixels and made it a bit more readable:

getPixels[imageData_, center_, 0] := {center}
getPixels[imageData_, {row_, col_}, radius_] := Module[{
nrOfColumns,
nrOfRows,
columnStart,
columnEnd,
rowStart,
rowEnd
},
{nrOfRows, nrOfColumns} = Dimensions[imageData]~Take~2;
columnStart = Max[1, col - radius];
columnEnd = Min[nrOfColumns, col + radius];
rowStart = Max[1, row - radius];
rowEnd = Min[nrOfRows, row + radius];
Join[
Table[{rowEnd, c}, {c, columnStart, columnEnd - 1}],
Table[{r, columnEnd}, {r, rowStart + 1, rowEnd}],
Table[{rowStart, c}, {c, columnStart + 1, columnEnd}],
Table[{r, columnStart}, {r, rowStart, rowEnd - 1}]
]
]


And alternative way of writing countSimilarPixels is

countSimilarPixels[imageData_, referenceColor_, allowedDifference_, center_, radius_] := Module[
{pixels, colors, similarity},
colors = Normalize /@ Extract[imageData, pixels];
similarity = colors.Normalize[referenceColor];
Total@UnitStep[similarity - (1 - allowedDifference)]
]

• Thanks, this works well. I'll use this command to get pixels of a colored dot on the image by kind of scanning outwards from a guess point. With that I'll track drawn dots on symple paper airplanes footage and compute the data about their motion in 3D. Commented Feb 13, 2021 at 15:08
• @GalZoidberg Sounds interesting! I like those types of projects. I took another look at it and made some additional updates to the functions. Maybe it will help, maybe not. Commented Feb 14, 2021 at 2:23

Okay it turns out, that if i replace last (...)&/@kpnk with Do[...,{i,Length[kpnk]}] it works normally

Do[
If[Normalize[baarva].Normalize[
slikapiksli[[kpnk[[i, 1]], kpnk[[i, 2]]   ]]  ] > 1 - \[Epsilon],
\[CapitalDelta]naštetih++;
\[CapitalDelta]vsotatakih += slikapiksli[[i1, i2]];
\[CapitalDelta]vsotakord += {i1, i2};
],
{i, Length[kpnk]}];

{0.0143393, 0}


I don't know why Map fails, but now it works