Image Thinning Algorithm in perl?

I read the Zhang-Suen 's Thinning Algorithm from the web and write the perl code to thinning the image. But when the code runs, the code causes a excessive erosion of the region. the ascii image below is example. Would someone tell me what's wrong with the code.Thanks very much.

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

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

code is below.

##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: I modify my code. And it seems work. But I don't know if it works correctly. Any suggestion. Thanks very much.

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..$#u开发者_运维问答nmarklist){
      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=();
  }
}

You've made several mistakes in implementing the algorithm:

1. You can't modify $ra in place. If you do, then when you erase one pixel, you change the conditions for the pixels that are processed after it, which causes errors to creep downward and rightward.

2. Your $cond1 and $cond2 conditions aren't supposed to be checked in the same loop. Instead, the whole image has to be processed with the $cond1 condition, then the whole image processed with the $cond2 condition, repeating as necessary.

3. When you calculate connectedness, you're missing the condition where $p9 is "unmark" and $p2 is "mark" -- you forgot to go all the way around the circle.

After correcting all of those errors, it looks like things are working.

A few more suggestions, though:

1. You shouldn't be using eq with numbers -- use the == operator for numeric comparison.
2. Instead of using the $cond1 and $cond2 variables, use the && or and logical operators -- they will make your code easier to read, and avoid unnecessary work.
3. Instead of for ($x = lower; $x <= $upper; $x++) you can write for $x (lower .. upper).
4. If you changed * and # into 0 and 1 on input, and then back again on output, you could make a lot of the logic easier to read by replacing if ($pixel eq $mark) with if ($pixel), etc.
5. Use arrays instead of a series of numbered variables like $p1 through $p9. If $p1 was called $pixel and $p2 through $p9 were an array called @neighbors, you could rewrite the eighteen lines to count $np1 and $sp1 into three lines.
6. Better variable names would be a nice idea in general :)