====== 植物拉丁名校验species_la-verify.pl ======

===== 拉丁名 =====

植物物种采用拉丁文的双名命名法，通常都很长。手工输入难免出错，一般都是错误一两个字母的情形，肉眼很难发现。如果我们有一个事先校验过的名录，只需将输入的拉丁名与名录中的名字做个相似性比较，就很容易发现并纠正此类小错误，从而可以避免后续分析处理时可能导致巨大误差的潜在风险。

这里说的物种拉丁名，指拉丁名通用代码，不包含命名人等部分，通常由属名和种加词构成，如果是变种、亚种等，则包括相应的变种加词、亚种加词等。如：
  * Abelia macrotera
  * Abelmoschus manihot var. manihot
  * Acer caesium subsp. giraldii
  * Angelica decursiva form. albiflora

===== 程序功能 =====

程序流程：
  - 将拉丁名与名录对照，如果命中，则认为拉丁名是正确的，输出该拉丁名，以及标志“FINE”；
  - 如果找不到，则在名录中进行相似性搜索，找出与该拉丁名相似率在90%以上的所有名称，与该拉丁名一起列出，供用户选择，缺省为该拉丁名：
    * 如果用户仍旧选择该拉丁名，则输出名称和标志“NEW”；
    * 如果用户选择了名录中的名称，则输出名称和标志“MOD”。
  - 如果相似搜索失败，则直接输出名称和标志“NEW”。

这里对不同的结果设置了一些标志，供后续处理。比如标志为“NEW“的名称，如果确认无误，则可以将其添加到名录里，这样名录会不断增长，可用性和准确性也随之提高。

===== String::Similarity模块 =====

相似性比较用到String::Similarity模块，需要事先安装，详细信息可访问[[http://search.cpan.org/~mlehmann/String-Similarity-1.04/Similarity.pm|CPAN]]。

如果系统是[[http://www.centos.org|CentOS]]，并且启用了[[http://repoforge.org|RPMforge]]源，则可以直接YUM安装：
<code bash>
yum install perl-String-Similarity
</code>

如果从源代码安装，方法如下：
<code bash>
gunzip String-Similarity-1.04.tar.gz
tar xvf String-Similarity-1.04.tar
cd String-Similarity-1.04/
perl Makefile.PL
make
make test
make install
</code>

===== 代码简述 =====

使用String::Similarity模块：
<code perl>
use String::Similarity;
</code>

参数分别为名录文件和要校验的名称列表文件：
<code perl>
my $conf_file = shift;
my $la_file = shift;
</code>

读入名录，放到列表变量里：
<code perl>
my @conf;
open(IN, $conf_file);
chomp(@conf = <IN>);
close IN;
</code>

读入要校验的名称列表，同时放到列表变量和哈希变量里，这样的相同的名字都对应同一个哈希键（key），避免后续的重复校验：
<code perl>
my @all_list;
my %la_names;
open(IN, $la_file);
while (<IN>) {
    chomp;
    push @all_list, $_;
    $la_names{$_} = "";
}
close IN;
</code>

对每个哈希键（拉丁名称）依次进行处理。如果键为空，则设定标志“NONE”：
<code perl>
foreach my $value (keys %la_names) {
    if ($value eq "") {
        $la_names{$value} = "NONE\t" . $value;
        next;
    }
</code>

如果键存在于名录中，则设定标志“FINE”：
<code perl>
    my @temp_list = grep { $_ eq $value } @conf;
    if (@temp_list) {
        $la_names{$value} = "FINE\t" . $value;
        next;
    }
</code>

进行相似性搜索：
<code perl>
    @temp_list = grep { similarity($_, $value, 0.9) >= 0.9 } @conf;
</code>

如果搜不到，则直接设定标志“NEW”：
<code perl>
    if (!@temp_list) {
        $la_names{$value} = "NEW\t" . $value;
        next;
    }
</code>

列出所有结果供用户选择：
<code perl>
    my $choose;
    print STDERR "[$value] Similar Records:\n";
    print STDERR "0): $value\n";
    my $i = 1;
    foreach (@temp_list) {
        print STDERR "$i): $_\n";
        $i++;
    }
    while (1) {
        print STDERR "Please choose(Ctrl+C to Abort)[0]: ";
        chomp($choose = <STDIN>);
        last if ($choose >= 0 && $choose <= @temp_list);
    }
</code>

根据选择结果设定相应标志：
<code perl>
    if ($choose) {
        $la_names{$value} = "MOD\t" . $temp_list[$choose - 1];
    } else {
        $la_names{$value} = "NEW\t" . $value;
    }
</code>

处理完所有键后，根据哈希中的设置输出所有名称的校验结果：
<code perl>
foreach (@all_list) {
    print STDOUT $la_names{$_} . "\r\n";
}

exit 0;
</code>

完毕。


{{tag>Perl}}