Алгоритм прореживания изображения в Perl?

Question

Я читаю Алгоритм истощения Чжан-Суена из Интернета и пишу 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';
      }
    }
  }
}

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

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. Лучше было бы лучше использовать имена переменных:)