Рассчитать расстояние для помех в perl

Question

У меня есть следующий список слов (words.txt) в файле, указанном в символах IPA (международный фонетический алфавит).

Ниже я присвоил каждому символу IPA двоичный код в отдельном файле (sounds.txt). Я хочу сравнить каждое слово в файле words.txt с использованием значений для каждого «символа» (например, «b» или «ŋ», как показано ниже) из файла sounds.txt.

Я хочу напечатать слова и результаты их количества в отдельном файле.

Первый желаемый пример вывода: выходное значение для bʀɥi и fʀɥi будет равно 5, поскольку две бинарные строки для символов «b» и «f» различаются в 5 местах.

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

Второй пример: выходное значение для bʀɥi и plɥi будет 6, так как символы «б» и «р» отличаются в 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 с двоичными кодами в хеше. Вы не можете просто сломать каждое слово на символы и сопоставить их с хешем, так как некоторые из «символов» не представлены одним кодовым пунктом в Юникоде. Итак, я просто заменил каждую известную комбинацию кодом, а затем использовал XOR для удаления общих или нулей.

Некоторые из символов отсутствуют в вашем образце, я должен был добавить их (ʀ и ɡ).

#!/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"; 
    } 
}