Image perl中的图像细化算法？

我从网上阅读了Zhang Suen的细化算法，并编写了细化图像的perl代码。但是，当代码运行时，代码会对该区域造成过度侵蚀。下面的ascii图像就是一个例子。谁能告诉我代码有什么问题吗？非常感谢

Before thinning ********** ********** ********** ********** ********** ********** ********** ********** ***###*#** **##**###* *##****### *#******#* *##****##* *##****##* **######** ***####*** **##*###** *##****##* *#******## ##******## ##*****### *##****##* **######** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** After thinning ********** ********** ********** ********** ********** ********** ********** ********** ***###**** **#***##** *#*****### ********** ********** *******#** ******#*** ***###**** **#**###** *#*****##* ********## #*******## ##*******# *##****##* **#####*** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** 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=(); } } 间伐前 ********** ********** ********** ********** ********** ********** ********** ********** ***###*#** **##**###* *##****### *#******#* *##****##* *##****##* **######** ***####*** **##*###** *##****##* *#******## ##******## ##*****### *##****##* **######** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** 稀释后 ********** ********** ********** ********** ********** ********** ********** ********** ***###**** **#***##** *#*****### ********** ********** *******#** ******#*** ***###**** **#**###** *#*****##* ********## #*******## ##*******# *##****##* **#####*** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** 代码如下

##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';
      }
    }
  }
}

##图像数组长度：0-37，图像数组宽度：$div[$idx]>{'R'}和$div[$idx]->{'L'}
##图像数组：$div[$idx]->{'A'}
while（$flag eq'Y'）{
my$diff=$div[$idx]->{'R'}-$div[$idx]->{'L'}；
my$ra=$div[$idx]->{'A'}；
$flag='N'；
对于（$y=1；$y[$y-1][$x]；
我的$p3=$ra->[$y-1][$x+1]；
我的$p4=$ra->[$y][$x+1]；
我的$p5=$ra->[$y+1][$x+1]；
我的$p6=$ra->[$y+1][$x]；
我的$p7=$ra->[$y+1][$x-1]；
我的$p8=$ra->[$y][$x-1]；
我的$p9=$ra->[$y-1][$x-1]；
如果（$p1 ne$mark）{next；}
如果（$p2 eq$mark）{$np1++；}
如果（$p3 eq$mark）{$np1++；}
如果（$p4 eq$mark）{$np1++；}
如果（$p5 eq$mark）{$np1++；}
如果（$p6 eq$mark）{$np1++；}
如果（$p7 eq$mark）{$np1++；}
如果（$p8 eq$mark）{$np1++；}
如果（$p9 eq$mark）{$np1++；}
如果（$p2 eq$unmark）&（$p3 eq$mark））{$sp1++；}
如果（$p3 eq$unmark）&（$p4 eq$mark））{$sp1++；}
如果（$p4 eq$unmark）&（$p5 eq$mark））{$sp1++；}
如果（$p5 eq$unmark）&（$p6 eq$mark））{$sp1++；}
如果（$p6 eq$unmark）&（$p7 eq$mark））{$sp1++；}
如果（$p7 eq$unmark）&（$p8 eq$mark））{$sp1++；}
如果（$p8 eq$unmark）&（$p9 eq$mark））{$sp1++；}
如果（$np1＞=2）&（$np1＜=6））{$cond1++；$cond2++；}
如果（$sp1 eq 1）{$cond1++；$cond2++；}
如果（$p2 eq$unmark）| |（$p4 eq$unmark）| |（$p6 eq$unmark））{$cond1++}
如果（$p4 eq$unmark）| |（$p6 eq$unmark）| |（$p8 eq$unmark））{$cond1++}
如果（$p2 eq$unmark）| |（$p4 eq$unmark）| |（$p8 eq$unmark））{$cond2++}
如果（$p2 eq$unmark）| |（$p6 eq$unmark）| |（$p8 eq$unmark））{$cond2++}
如果（$cond1 eq 4）{
$div[$idx]->{'A'}->[$y][$x]=$unmark；
$flag='Y'；
}
如果（$cond2 eq 4）{
$div[$idx]->{'A'}->[$y][$x]=$unmark；
$flag='Y'；
}
}
}
}

更新： 我修改了我的代码。它似乎可以工作。但我不知道它是否工作正常。 任何建议。非常感谢

Before thinning ********** ********** ********** ********** ********** ********** ********** ********** ***###*#** **##**###* *##****### *#******#* *##****##* *##****##* **######** ***####*** **##*###** *##****##* *#******## ##******## ##*****### *##****##* **######** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** After thinning ********** ********** ********** ********** ********** ********** ********** ********** ***###**** **#***##** *#*****### ********** ********** *******#** ******#*** ***###**** **#**###** *#*****##* ********## #*******## ##*******# *##****##* **#####*** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** ********** 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=(); } } 亚细化{ 我的$idx=班次； 我的$flag='Y'； 我的@unmarklist； 我的$aheight=37；##0..37 my$awidth=$div[$idx]->{'R'}-$div[$idx]->{'L'}； while（$flag eq'Y'）{ $flag='N'； my$ra=$div[$idx]->{'A'}； $y（1..$aheight-1）{ $x（1..$awidth-1）{ 我的$np1=0； 我的$sp1=0； 我的邻居； 我的$pixel=$ra->[$y][$x]； $neights[2]=$ra->[$y-1][$x]； $neights[3]=$ra->[$y-1][$x+1]； $neights[4]=$ra->[$y][$x+1]； $neights[5]=$ra->[$y+1][$x+1]； $neights[6]=$ra->[$y+1][$x]； $neights[7]=$ra->[$y+1][$x-1]； $neights[8]=$ra->[$y][$x-1]； $neights[9]=$ra->[$y-1][$x-1]； 如果（$pixel ne$mark）{next；} 对于$i（2..9）{if（$i]eq$mark）{$np1++；} 如果（（$np1＞=2）和（$np1＜=6））{ 对于$i（2..8）{if（$neights[$i]eq$unmark）&（$neights[$i+1]eq$mark））{$sp1++；} if（$neights[9]eq$unmark）&（$neights[2]eq$mark））{$sp1++；} 如果（$sp1==1）{ if（（$neights[2]eq$unmark）| |（$neights[4]eq$unmark）| |（$neights[6]eq$unmark））&& （$neights[4]eq$unmark）| |（$neights[6]eq$unmark）| |（$neights[8]eq$unmark）））{ 推送（@unmarklist，[$y，$x]）； $flag='Y'； } } } } } 对于$i（0..$#未标记列表）{ my$y=$unmarklist[$i]->[0]； my$x=$unmarklist[$i]->[1]； $div[$idx]->{'A'}->[$y][$x]=$unmark； } @unmarklist=（）； my$ra=$div[$idx]->{'A'}； $y（1..$aheight-1）{ $x（1..$awidth-1）{ 我的$np1=0； 我的$sp1=0； 我的邻居； 我的$pixel=$ra->[$y][$x]； $neights[2]=$ra->[$y-1][$x]； $neights[3]=$ra->[$y-1][$x+1]； $neights[4]=$ra->[$y][$x+1]； $neights[5]=$ra->[$y+1][$x+1]； $neights[6]=$ra->[$y+1][$x]； $neights[7]=$ra->[$y+1][$x-1]； $neights[8]=$ra->[$y][$x-1]； $neights[9]=$ra->[$y-1][$x-1]； 如果（$pixel ne$mark）{next；} 对于$i（2..9）{if（$i]eq$mark）{$np1++；} 如果（（$np1＞=2）和（$np1＜=6））{ 对于$i（2..8）{if（$neights[$i]eq$unmark）&（$neights[$i+1]eq$mark））{$sp1++；} if（$neights[9]eq$unmark）&（$neights[2]eq$mark））{$sp1++；} 如果（$sp1==1）{ if（（$neights[2]eq$unmark）| |（$neights[4]eq$unmark）| |（$neights[8]eq$unmark））&& （$neights[2]eq$unmark）| |（$neights[6]eq$unmark）| |（$neights[8]eq$unmark）））{ 推送（@unmarklist，[$y，$x]）； $flag='Y'； } } } } } 对于$i（0..$#未标记列表）{ my$y=$unmarklist[$i]->[0]； my$x=$unmarklist[$i]->[1]；