Углеродный алгоритм изображения в perl?

Question

Я прочитал алгоритм измельчения Zhang-Suen's из Интернета и написал код perl для прореживания изображения. Но когда код работает, код вызывает чрезмерную эрозию региона. Ниже приведен пример ascii. Кто-нибудь скажет мне, что не так с кодом. Спасибо большое.

 
Before thinning 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
***###*#** 
**##**###* 
*##****### 
*#******#* 
*##****##* 
*##****##* 
**######** 
***####*** 
**##*###** 
*##****##* 
*#******## 
##******## 
##*****### 
*##****##* 
**######** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 

After thinning   
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
***###**** 
**#***##** 
*#*****### 
********** 
********** 
*******#** 
******#*** 
***###**** 
**#**###** 
*#*****##* 
********## 
#*******## 
##*******# 
*##****##* 
**#####*** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 
********** 

код приведен ниже.

##image array length: 0-37，image array width: $div[$idx]->{'R'}和$div[$idx]->{'L'} 
##image array: $div[$idx]->{'A'} 
while($flag eq 'Y'){ 
    my $diff= $div[$idx]->{'R'} - $div[$idx]->{'L'}; 
    my $ra= $div[$idx]->{'A'}; 
    $flag= 'N';  
    for($y=1; $y<= 36; $y++){ 
    for($x=1; $x<= $diff-1; $x++){ 
     my $np1=0; 
     my $sp1=0; 
     my $cond1= 0; 
     my $cond2= 0; 
     my $p1= $ra->[$y][$x]; 
     my $p2= $ra->[$y-1][$x]; 
     my $p3= $ra->[$y-1][$x+1]; 
     my $p4= $ra->[$y][$x+1]; 
     my $p5= $ra->[$y+1][$x+1]; 
     my $p6= $ra->[$y+1][$x]; 
     my $p7= $ra->[$y+1][$x-1]; 
     my $p8= $ra->[$y][$x-1]; 
     my $p9= $ra->[$y-1][$x-1]; 

     if($p1 ne $mark){next;} 
     if($p2 eq $mark){$np1++;} 
     if($p3 eq $mark){$np1++;} 
     if($p4 eq $mark){$np1++;} 
     if($p5 eq $mark){$np1++;} 
     if($p6 eq $mark){$np1++;} 
     if($p7 eq $mark){$np1++;} 
     if($p8 eq $mark){$np1++;} 
     if($p9 eq $mark){$np1++;} 
     if(($p2 eq $unmark)&&($p3 eq $mark)){$sp1++;} 
     if(($p3 eq $unmark)&&($p4 eq $mark)){$sp1++;} 
     if(($p4 eq $unmark)&&($p5 eq $mark)){$sp1++;} 
     if(($p5 eq $unmark)&&($p6 eq $mark)){$sp1++;} 
     if(($p6 eq $unmark)&&($p7 eq $mark)){$sp1++;} 
     if(($p7 eq $unmark)&&($p8 eq $mark)){$sp1++;} 
     if(($p8 eq $unmark)&&($p9 eq $mark)){$sp1++;} 
     if(($np1 ＞= 2)&&($np1 ＜= 6)){$cond1++; $cond2++;} 
     if($sp1 eq 1){$cond1++; $cond2++;} 
     if(($p2 eq $unmark)||($p4 eq $unmark)||($p6 eq $unmark)){$cond1++;} 
     if(($p4 eq $unmark)||($p6 eq $unmark)||($p8 eq $unmark)){$cond1++;} 
     if(($p2 eq $unmark)||($p4 eq $unmark)||($p8 eq $unmark)){$cond2++;} 
     if(($p2 eq $unmark)||($p6 eq $unmark)||($p8 eq $unmark)){$cond2++;} 

     if($cond1 eq 4){ 
     $div[$idx]->{'A'}->[$y][$x]= $unmark; 
     $flag= 'Y'; 
     } 
     if($cond2 eq 4){ 
     $div[$idx]->{'A'}->[$y][$x]= $unmark; 
     $flag= 'Y'; 
     } 
    } 
    } 
} 

Update: я изменить свой код. И это похоже на работу. Но я не знаю, работает ли он правильно. Любое предложение. Огромное спасибо.

 
sub thinning{ 
    my $idx= shift; 
    my $flag= 'Y'; 
    my @unmarklist; 
    my $aheight= 37; ##0..37 
    my $awidth= $div[$idx]->{'R'} - $div[$idx]->{'L'}; 

    while($flag eq 'Y'){  
    $flag= 'N'; 
    my $ra= $div[$idx]->{'A'}; 

    for $y(1..$aheight-1){  
     for $x(1..$awidth-1){   
     my $np1=0; 
     my $sp1=0; 
     my @neighbors; 
     my $pixel= $ra->[$y][$x]; 
     $neighbors[2]= $ra->[$y-1][$x]; 
     $neighbors[3]= $ra->[$y-1][$x+1]; 
     $neighbors[4]= $ra->[$y][$x+1]; 
     $neighbors[5]= $ra->[$y+1][$x+1]; 
     $neighbors[6]= $ra->[$y+1][$x]; 
     $neighbors[7]= $ra->[$y+1][$x-1]; 
     $neighbors[8]= $ra->[$y][$x-1]; 
     $neighbors[9]= $ra->[$y-1][$x-1]; 

     if($pixel ne $mark){next;}   
     for $i(2..9){if($neighbors[$i] eq $mark){$np1++;}} 
     if(($np1 ＞= 2)&&($np1 ＜= 6)){ 
      for $i(2..8){if(($neighbors[$i] eq $unmark)&&($neighbors[$i+1] eq $mark)){$sp1++;}}   
      if(($neighbors[9] eq $unmark)&&($neighbors[2] eq $mark)){$sp1++;} 
      if($sp1 == 1){ 
      if((($neighbors[2] eq $unmark)||($neighbors[4] eq $unmark)||($neighbors[6] eq $unmark))&& 
       (($neighbors[4] eq $unmark)||($neighbors[6] eq $unmark)||($neighbors[8] eq $unmark))){ 
       push(@unmarklist, [$y, $x]); 
       $flag= 'Y'; 
      } 
      } 
     }   
     } 
    } 

    for $i(0..$#unmarklist){ 
     my $y= $unmarklist[$i]->[0]; 
     my $x= $unmarklist[$i]->[1]; 
     $div[$idx]->{'A'}->[$y][$x]= $unmark; 
    } 
    @unmarklist=(); 

    my $ra= $div[$idx]->{'A'}; 
    for $y(1..$aheight-1){  
     for $x(1..$awidth-1){   
     my $np1=0; 
     my $sp1=0; 
     my @neighbors; 
     my $pixel= $ra->[$y][$x]; 
     $neighbors[2]= $ra->[$y-1][$x]; 
     $neighbors[3]= $ra->[$y-1][$x+1]; 
     $neighbors[4]= $ra->[$y][$x+1]; 
     $neighbors[5]= $ra->[$y+1][$x+1]; 
     $neighbors[6]= $ra->[$y+1][$x]; 
     $neighbors[7]= $ra->[$y+1][$x-1]; 
     $neighbors[8]= $ra->[$y][$x-1]; 
     $neighbors[9]= $ra->[$y-1][$x-1]; 

     if($pixel ne $mark){next;}   
     for $i(2..9){if($neighbors[$i] eq $mark){$np1++;}} 
     if(($np1 ＞= 2)&&($np1 ＜= 6)){ 
      for $i(2..8){if(($neighbors[$i] eq $unmark)&&($neighbors[$i+1] eq $mark)){$sp1++;}}   
      if(($neighbors[9] eq $unmark)&&($neighbors[2] eq $mark)){$sp1++;} 
      if($sp1 == 1){ 
      if((($neighbors[2] eq $unmark)||($neighbors[4] eq $unmark)||($neighbors[8] eq $unmark))&& 
       (($neighbors[2] eq $unmark)||($neighbors[6] eq $unmark)||($neighbors[8] eq $unmark))){ 
       push(@unmarklist, [$y, $x]); 
       $flag= 'Y'; 
      } 
      } 
     }   
     } 
    } 

    for $i(0..$#unmarklist){ 
     my $y= $unmarklist[$i]->[0]; 
     my $x= $unmarklist[$i]->[1]; 
     $div[$idx]->{'A'}->[$y][$x]= $unmark; 
    } 
    @unmarklist=(); 
    } 
} 

Answer 1

Вы сделали несколько ошибок в реализации алгоритма:

1. Вы не можете изменить $ra на месте. Если вы это сделаете, то при стирании одного пикселя вы измените условия для пикселов, которые обрабатываются после него, что приводит к тому, что ошибки ползут вниз и вправо.

2. Ваши $cond1 и $cond2 условия не должны проверяться в том же цикле. Вместо этого все изображение должно обрабатываться с условием $cond1, тогда все изображение обрабатывается с условием $cond2, повторяя при необходимости.

3. Когда вы вычисляете связность, вам не хватает условия, при которых $p9 является «отметкой», а $p2 является «отметкой» - вы забыли пройти весь круг вокруг круга.

После исправления всех этих ошибок, похоже, что все работает.

Еще несколько предложений, хотя:

1. Вы не должны использовать eq с числами - используйте оператор == для количественного сравнения.
2. Вместо использования переменных $cond1 и $cond2 используйте логические операторы && или and - они упростят чтение кода и избегают ненужной работы.
3. Вместо for ($x = lower; $x <= $upper; $x++) вы можете написать for $x (lower .. upper).
4. Если вы изменили * и # в 0 и 1 на входе, а затем снова на выходе, вы могли бы сделать много логики легче читать, заменив if ($pixel eq $mark) с if ($pixel) и т.д.
5. Используйте массивы вместо серия нумерованных переменных, таких как $p1 - $p9. Если $p1 был вызван $pixel и $p2 через $p9 были массивом под названием @neighbors, вы могли бы переписать восемнадцать строк для подсчета $np1 и $sp1 в три строки.
6. лучше имена переменных была бы хорошая идея, в общем :)