將黑白圖片的每一個pixel存成一個陣列，
該陣列中，黑色的pixel為mark，白色的pixel為unmark
| p9 | p2 | p3 |
| p8 | p1 | p4 |
| p7 | p6 | p5 |
細線化演算法：
一、步驟一
將陣列讀入，並將讀到的那個pixel設為p1
其週圍的8個pixel設為p2,p3,p4,p5,p6,p7,p8,p9，位置如上圖。
如果p1為mark的，對其週圍的8個pixel做如下判斷：
1、p1週圍的8個點是mark的有幾個，假設合計為np1個
2、p1週圍的8個點，由unmark變成mark的有幾個，假設合計為sp1個
3、p2或p4或p6是否有unmark的
4、p4或p6或p8是否有unmark的
如果
1、np1大於1個且小於7個 而且
2、sp1等於1 而且
3、p2或p4或p6有umark的 而且
4、p2或p4或p6有umark的
那麼p1這個pixel就要把它標記為可以刪除的。
將所有陣列中的pixel做完判斷後，
將標記需刪除的pixel全部由mark改為unmark。
二、步驟二
將陣列讀入，並將讀到的那個pixel設為p1
其週圍的8個pixel設為p2,p3,p4,p5,p6,p7,p8,p9，位置如上圖。
如果p1為mark的，對其週圍的8個pixel做如下判斷：
1、p1週圍的8個點是mark的有幾個，假設合計為np1個
2、p1週圍的8個點，由unmark變成mark的有幾個，假設合計為sp1個
3、p2或p4或p8是否有unmark的
4、p2或p6或p8是否有unmark的
如果
1、np1大於1個且小於7個 而且
2、sp1等於1 而且
3、p2或p4或p8有umark的 而且
4、p2或p6或p8有umark的
那麼p1這個pixel就要把它標記為可以刪除的。
將所有陣列中的pixel做完判斷後，
將標記需刪除的pixel全部由mark改為unmark。
三、重覆步驟一和步驟二直到沒有任何pixel被標記為止。
註：步驟一和步驟二只有在檢查p1其週圍的點數是否有unmark的地方有所不同
完整程式碼如下：
假設陣列的高為0..37，
寬為在分割圖片時計算出來，
圖片的陣列存放在$div[$idx]->{'A'}裡。
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 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 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-thinning-algorithm-in-perl
細線化與骨架抽取
留言列表
