Message Boards Message Boards

GROUPS:

Number of similar pixels on a loop arround some pixel

Posted 2 months ago
275 Views
|
2 Replies
|
0 Total Likes
|

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}]
  ]

enter image description here

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?

2 Replies
Posted 2 months ago

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

Posted 2 months ago
Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract