Сравнение строк Девнагари

Question

У меня есть несколько сотен тысяч слов девнагари в текстовом файле (одно слово в строке). Мне нужно скопировать большинство похожих слов, таких как «अक्तूबर, अक्‍टूबर», «कौम, क़ौम», в другой файл для исправления. Максимальная разница в два места допускается для копирования. Для этого я использовал «awk», чтобы найти разницу слов и скопировать похожие слова в другой файл. Но ее не удалось, потому что эта команда работает только с римским символом, а не с символом девнагари.

awk -v string=कौम -v string1=क़ौम '{ for (i=1;i<=length(string);i++) { if (substr(string,i,1) != substr(string1,i,1)) { count++ } }} END { print (count/length(string)*100"% difference") }' <<< ""

66,6667% разница

Вышеуказанные проценты неверны, потому что выше два слова имеют очень заднюю разницу иожидаемая разница должна быть между 5-10%.

Можете ли вы предложить мне, что делать в этом случае?

python, perl, shell что-нибудь принято.

Answer 1

Похоже, вы хотите сравнить кластеры графем .

Кластер графем представляет горизонтально сегментируемую единицу текста, состоящую из некоторой базы графем (которая может состоять из корейского языка)слог) вместе с любым количеством непространственных меток, примененных к нему.

Это просто «причудливый» способ, которым каждый кластер графем является «визуальным символом».

Давайте подтвердим. Следующая программа позволяет нам взглянуть на вашу строку, разделенную на кластеры графем.

use open ':std', ':encoding(UTF-8)';

use charnames qw( :full );

for my $arg_idx (0..$#ARGV) {
   my $arg = $ARGV[$arg_idx];

   utf8::decode($arg);

   for my $grapheme_cluster ($arg =~ /\X/g) {
      printf("%s %v04X\n", $grapheme_cluster, $grapheme_cluster);
      for my $code_point (unpack('W*', $grapheme_cluster)) {
         printf("   %04X %s\n", $code_point, charnames::viacode($code_point));
      }
   }

   print("\n") if $arg_idx != $#ARGV;
}

Для одной из ваших строк мы получим

$ grapheme_clusters क़ौम              $ grapheme_clusters क़ौम           
कौ 0915.094C                         क़ौ 0915.093C.094C                 
   0915 DEVANAGARI LETTER KA            0915 DEVANAGARI LETTER KA       
                                        093C DEVANAGARI SIGN NUKTA      
   094C DEVANAGARI VOWEL SIGN AU        094C DEVANAGARI VOWEL SIGN AU   
म 092E                               म 092E                             
   092E DEVANAGARI LETTER MA            092E DEVANAGARI LETTER MA       

Пока все хорошо;это дает единственную разницу, как и ожидалось.

Для другого набора строк мы получаем

$ grapheme_clusters अक्तूबर            $ grapheme_clusters अक्‍टूबर
अ 0905                               अ 0905         
   0905 DEVANAGARI LETTER A             0905 DEVANAGARI LETTER A
क् 0915.094D                          क्‍ 0915.094D.200D
   0915 DEVANAGARI LETTER KA            0915 DEVANAGARI LETTER KA
   094D DEVANAGARI SIGN VIRAMA          094D DEVANAGARI SIGN VIRAMA
                                        200D ZERO WIDTH JOINER
तू 0924.0942                          टू 091F.0942
   0924 DEVANAGARI LETTER TA            091F DEVANAGARI LETTER TTA
   0942 DEVANAGARI VOWEL SIGN UU        0942 DEVANAGARI VOWEL SIGN UU
ब 092C                               ब 092C           
   092C DEVANAGARI LETTER BA            092C DEVANAGARI LETTER BA
र 0930                               र 0930
   0930 DEVANAGARI LETTER RA            0930 DEVANAGARI LETTER RA       

Ах, там неожиданно ZERO WIDTH JOINER. Если бы мы удалили его (например, используя s/\N{ZERO WIDTH JOINER}//g, или удалив все управляющие символы, используя s/\pC//g), мы получили бы ожидаемое единственное различие.

---

Теперь, когда мы установили, чтоПри необходимости мы можем закодировать решение.

use List::Util qw( max );

sub count_diffs {
   my ($s1, $s2) = @_;

   s/\N{ZERO WIDTH JOINER}//g for $s1, $s2;

   my @s1 = $s1 =~ /\X/g;
   my @s2 = $s2 =~ /\X/g;

   no warnings qw( uninitialized );
   return 0+grep { $s1[$_] ne $s2[$_] } 0..max(0+@s1, 0+@s2)-1;
}

Основная проблема этого подхода заключается в том, что он плохо обрабатывает вставки или удаления. Например, он считает, что abcdef и bcdef имеют 6 отличий. Было бы гораздо эффективнее вычислять расстояние Левенштейна последовательности кластеров, а не сравнивать по индексу.

use Algorithm::Diff qw( traverse_balanced );

sub count_diffs {
   my ($s1, $s2) = @_;

   s/\N{ZERO WIDTH JOINER}//g for $s1, $s2;

   my @s1 = $s1 =~ /\X/g;
   my @s2 = $s2 =~ /\X/g;

   my $diffs = 0;
   traverse_balanced(\@s1, \@s2,
      {
         DISCARD_A => sub { ++$diffs; },
         DISCARD_B => sub { ++$diffs; },
         CHANGE    => sub { ++$diffs; },
      },
   );

   return $diffs;
}

Наконец, из соображений производительности не нужно сравниватьтолько две строки одновременно;Вы хотите сравнить каждую строку с каждой другой строкой сразу. Я не знаю легкодоступного решения для этого.

Answer 2

use utf8;
use List::Util qw(sum max);
use List::SomeUtils qw(pairwise);

sub norm { $_[0] =~ s/\pC//gr =~ /\X/g }
for my $pair (
    [qw(अक्तूबर अक्‍टूबर)],
    [qw(कौम क़ौम)],
) {
    my @e0 = norm $pair->[0];
    my @e1 = norm $pair->[1];
    my $equal = sum pairwise { $a eq $b } @e0, @e1;
    my $max = max scalar(@e0), scalar(@e1);
    my $similarity = $equal / $max;
    printf "%.1f%% similarity, %.1f%% difference\n",
        100 * $similarity,
        100 * (1 - $similarity);
}