在perl中计算汉明距离

Question

我在一个以 IPA 字符（国际音标）显示的文件中有以下单词列表 (words.txt)。

下面，我在单独的文件 (sounds.txt) 中为每个 IPA 字符分配了一个二进制代码。我想使用sounds.txt文件中每个“字符”（例如下面的“b”或“ŋ”）的值来比较words.txt文件中的每个单词。

我想将单词及其数值结果打印到单独的文件中。

第一个期望的输出示例：bʀɥi 和 fʀɥi 的输出值将是 5，因为字符“b”和“f”的两个二进制字符串在 5 个位置不同。

"b":[10000100000000010000]
"f":[00100010000000000000] 

第二个例子：bʀɥi 和 plɥi 的输出值将是 6，因为字符“b”和“p”有 1 处不同，而字符“ʀ”和“1”有 5 处不同。计算每对单词的最终值是每个字符的二进制代码差异的总和。

"b":[10000100000000010000]
"p":[10000100000000000000]

"ʁ":[00100000000001010000]
"l":[00011000100000010000]

我知道计算每个字母的代码看起来像这样，但我不确定如何合并 sound.txt 文件中的值，然后从两个完整的单词中获取比较值。我一直在阅读很多 perl 教程，但我所看到的一切似乎都与我想要完成的相似。任何建议都会很棒。

open(my $f1, "words.txt");
    string1 [$f1]
    string2 [$f1]
        for (i=0,i<string.length,i++)
            if(string1[i]!=string2[i])
                    sum = sum+1

bʀɥi
kʀwa
dʀwa
fʀwa
fʀɥi
ɡʀwɛ̃
plɥi
pʀwa
tʀɥi

"p":[10000100000000000000]
"b":[10000100000000010000]
"f":[00100010000000000000]
"v":[00100010000000010000]
"t":[10000001000000000000]
"d":[10000001000000010000]
"k":[10000000000010000000]
"g":[10000000000010010000]
"s":[00100000100000000000]
"z":[00100000100000010000]
"m":[01000100000000010000]
"n":[01000001000000010000]
"ɲ":[01000000001000010000]
"ŋ":[01000000000010010000]
"ʃ":[00100000010000000000]
"ʒ":[00100000010000010000]
"ʀ":[00100000000001010000]
"w":[00010000000000110000]
"j":[00010000001000010000]
"ɥ":[00010000000100010000]
"l":[00011000100000010000]
"a":[00000000001000011000]
"ɑ":[00000000000010011000]
"ɑ̃":[01000000000010011000]
"e":[00000000001000010010]
"ɛ":[00000000001000010100]
"ɛ̃":[01000000001000010100]
"ə":[00000000000000000000]
"i":[00000000001000010001]
"o":[00000000000000110010]
"ɔ":[00000000000000110100]
"ɔ̃":[01000000000000110100]
"œ":[00000000000100010100]
"œ̃":[01000000000100010100]
"ø":[00000000000100010010]
"u":[00000000000000110001]
"y":[00000000000100010001]

Answer 1

将 IPA 字符到二进制代码的映射存储在哈希中。您不能简单地将每个单词分解为字符并将它们映射到散列，因为某些“字符”不是由 Unicode 中的单个代码点表示的。所以，我只是用代码替换了每个已知的组合，然后使用 XOR 删除常见的 1 或 0。

您的示例中缺少某些字符，我必须添加它们（ʀ 和 ɡ）。

#!/usr/bin/perl
use warnings;
use strict;

use open IO => 'encoding(utf-8)', ':std';

my @words;
open my $WORDS, '<:encoding(utf-8)', 'words.txt' or die $!;
chomp(@words = <$WORDS>);

my %sound;
open my $SOUNDS, '<:encoding(utf-8)', 'sounds.txt' or die $!;
while (<$SOUNDS>) {
    my ($ipa, $features) = /"(.*?)":\[([01]+)\]/;
    $sound{$ipa} = $features;
}

my $chars = join '|', sort { length $b <=> length $a } keys %sound;
my $regex = qr/($chars)/;

my @sounds;
for my $word (@words) {
    (my $wsound = $word) =~ s/$regex/$sound{$1},/g; # / SO bug
    push @sounds, $wsound;
}

for my $i1 (0 .. $#words - 1) {
    for my $i2 ($i1 + 1 .. $#words) {
        warn "Different length: $words[$i1] - $words[$i2]"
            if length $sounds[$i1] != length $sounds[$i2];
        my $hamming = $sounds[$i1] ^ $sounds[$i2];
        $hamming =~ tr/\0//d;
        $hamming = length $hamming;
        print "$words[$i1] - $words[$i2] : $hamming\n";
    }
}