Разделение списка имен на пары "FirstName {TAB} Lastname" - PullRequest
Новая
       12

Разделение списка имен на пары "FirstName {TAB} Lastname"

0 голосов
/ 03 января 2012

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

"Acme Corporation Inc., John, Doe, F."
"Smith, Allen, Smith,Susan"
"Marshall, J., L., Johnson, H., Caruso, D., Jones, J."
"Stein, Harry, Joan, and Mike"

Эти строки следует преобразовать в текст, содержащий: 

Acme {TAB} Corporation
Doe {TAB} John
Smith {TAB} Allen
Smith {TAB} Susan
Marshall {TAB} J.
Johnson {TAB} H.
Caruso {TAB} D.
Jones {TAB} J.
Stein {TAB} Harry
Stein {TAB} Joan
Stein {TAB} Mike

Оригинальный текст содержит только собственные имена и средние инициалы (D. или J.), за исключением случайных "и" разделенных братьев и сестер с той же фамилией, что и в последней строке исходного текста выше.

Кроме того, это считается "Распознаванием именованных сущностей" или есть какое-то другое техническое имя для этого процесса?

В идеале, я хотел бы, чтобы код или алгоритмы были на языке, подобном Ruby / Python /Perl / PHP, который мог бы сделать этот перевод.

Есть идеи?Заранее спасибо.

1 Ответ

0 голосов
/ 03 января 2012

Это работает, почти: 

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

my $tok = undef;
my @pairs = ();
my $looking_for = 'surname';

sub parse_line_to_words($){
    my $l = shift;
    my @words;
    my $word = '';
    my $start = 1;

    # remove trailing newlines
    chomp $l;
    if(index($l, '"', -1) != -1){
            # remove trailing quotation mark.
            chop $l;
    }
    foreach my $c (split//,$l){
            if($c eq '"'){
                    if($#words == -1){
                            # skip leading quotation marks
                            next;
                    }
            }

            if($c eq ','){
                    push(@words, $word);
                    $word = '';
                    $start = 1;
            } else{
                    if($start && $c eq ' '){
                            next;
                    } else{
                            $start = 0;
                    }
                    $word .= $c;
            }
    }
    if($word ne ''){
            push(@words, $word);
    }
    return @words;
}
sub peek_and(@){
    foreach my $word (@_){
            return 1 if $word eq 'and'
    }
    return 0;
}
sub split_and(@){
    my @copy;
    foreach my $word (@_){
            if(index($word, 'and ', 0) != -1){
                    my $i = index($word, 'and ', 0) + 4;
                    push(@copy, substr($word, 0, $i - 1));
                    push(@copy, substr($word, $i));
            } else{
                    push(@copy, $word);
            }
    }
    return @copy;
}
sub count_spaces($){
    my $w = shift;
    my $s=0;
    for(my $p = index($w, ' ', 0); $p != -1; $p=index($w, ' ', $p+1), $s++) {}
    return $s;
}
sub found($$$){
    my $pairs = shift;
    push(@{$pairs}, {'surname' => shift, 'firstname' => shift});
}
while(<>){
    chomp;
    my $line = $_;
    my @words = parse_line_to_words($line);
    @words = split_and(@words);
    my $line_has_and = peek_and(@words);
    foreach my $word (@words){
            my $spaces = count_spaces($word);

            if($looking_for eq 'surname'){
                    if(index($word, '.', -1) != -1 && $spaces == 0){
                            # looks like an initial to me, skip it
                    } else{
                            if($spaces > 0){
                                    # multi-word token; must be corporation name
                                    my($f, $l) = split(/ /, $word);
                                    found(\@pairs, $f, $l);
                            } else{
                                    $tok = $word;
                                    $looking_for = 'firstname';
                            }
                    }
            } elsif ($looking_for eq 'firstname'){
                    if($line_has_and){
                            # lastname, first1, ..., firstn and firstn+1
                            if($word ne 'and'){
                                    found(\@pairs, $tok, $word);
                            }
                    } else{
                            # lastname, f. or lastname, firstname
                            found(\@pairs, $tok, $word);
                            $looking_for = 'surname';
                    }
            }
    }
    $looking_for = 'surname'; # reset for new line
}

foreach my $p (@pairs){
    printf("%s\t%s\n", $p->{'surname'}, $p->{'firstname'});
}

Фактический вывод для данного образца ввода 

Acme    Corporation
John    Doe
Smith   Allen
Smith   Susan
Marshall        J.
Johnson H.
Caruso  D.
Jones   J.
Stein   Harry
Stein   Joan
Stein   Mike

Обсуждение

Я использовал следующую эвристику:

  • Начальные и конечные кавычки в строке следует игнорировать.
  • Каждая строка может быть разбита на слова в виде серии значений, разделенных запятыми.
  • Если слово начинается с пробеласимволы, затем эти символы следует игнорировать.
  • Первое слово в любой паре слов - это фамилия, второе - имя (кроме особых случаев).
  • Если слово в строке начинаетсяс 'и' вся строка должна обрабатываться особым образом, если первое слово является фамилией, а остальные - соответствующими именами.
  • Если фамилия имеет более 0 пробелов, то это имя корпорации
  • Имя корпорации - это всегда два слова, разделенных пробелами, которые должны рассматриваться как фамилия и имя соответственно.
  • Имена не корпорации не содержат пробелов.

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

Даже несмотря на все это, я все еще неправильно понимаю «Джон Доу», потому что его имена меняются местами на входе.Я не мог придумать надежный способ обнаружить это.

...