найти лишние, недостающие, недопустимые строки при сравнении двух списков в perl - PullRequest
0 голосов
/ 11 января 2010
List-1    List-2
one       one
two       three
three     three
four      four
five      six
six       seven
eight     eighttt
nine      nine

Глядя на вывод

one       | one        PASS
two       | *               FAIL MISSING
three     | three      PASS
*         | three           FAIL EXTRA
four      | four       PASS
five      | *               FAIL MISSING
six       | six        PASS
*         | seven           FAIL EXTRA
eight     | eighttt         FAIL INVALID
nine      | nine       PASS

Фактически, возвращение из моего текущего решения является ссылкой на два измененных списка и ссылкой на список «сбой», описывающий сбой для индекса как «без сбоев», «отсутствует», «лишний» или « Недопустимый », что также (очевидно) хороший вывод.

Мое текущее решение:

sub compare {
    local $thisfound = shift;
    local $thatfound = shift;
    local @thisorig = @{ $thisfound };
    local @thatorig = @{ $thatfound };
    local $best = 9999; 

    foreach $n (1..6) {
        local $diff = 0;
        local @thisfound = @thisorig;
        local @thatfound = @thatorig;
        local @fail = ();
        for (local $i=0;$i<scalar(@thisfound) || $i<scalar(@thatfound);$i++) {
            if($thisfound[$i] eq $thatfound[$i]) { 
                $fail[$i] = 'NO_FAIL';
                next;
            }
            if($n == 1) {      # 1 2 3
                next unless __compare_missing__();
                next unless __compare_extra__();
                next unless __compare_invalid__();
            } elsif($n == 2) { # 1 3 2
                next unless __compare_missing__();
                next unless __compare_invalid__();
                next unless __compare_extra__();
            } elsif($n == 3) { # 2 1 3
                next unless __compare_extra__();
                next unless __compare_missing__();
                next unless __compare_invalid__();
            } elsif($n == 4) { # 2 3 1
                next unless __compare_extra__();
                next unless __compare_invalid__();
                next unless __compare_missing__();
            } elsif($n == 5) { # 3 1 2
                next unless __compare_invalid__();
                next unless __compare_missing__();
                next unless __compare_extra__();
            } elsif($n == 6) { # 3 2 1
                next unless __compare_invalid__();
                next unless __compare_extra__();
                next unless __compare_missing__();
            }
            push @fail,'INVALID'; 
            $diff += 1;
        }
        if ($diff<$best) {
            $best = $diff;
            @thisbest = @thisfound;
            @thatbest = @thatfound;
            @failbest = @fail;
        }
    }
    return (\@thisbest,\@thatbest,\@failbest)
}

sub __compare_missing__ {
    my $j;
    ### Does that command match a later this command? ###
    ### If so most likely a MISSING command           ###
    for($j=$i+1;$j<scalar(@thisfound);$j++) {
        if($thisfound[$j] eq $thatfound[$i]) {
            $diff += $j-$i;
            for ($i..$j-1) { push(@fail,'MISSING'); }
            @end = @thatfound[$i..$#thatfound];
            @thatfound = @thatfound[0..$i-1];
            for ($i..$j-1) { push(@thatfound,'*'); }
            push(@thatfound,@end);
            $i=$j-1;
            last;
        }
    }
    $j == scalar(@thisfound);
}

sub __compare_extra__ {
    my $j;
    ### Does this command match a later that command? ###
    ### If so, most likely an EXTRA command           ###
    for($j=$i+1;$j<scalar(@thatfound);$j++) {
        if($thatfound[$j] eq $thisfound[$i]) { 
            $diff += $j-$i;
            for ($i..$j-1) { push(@fail,'EXTRA'); }
            @end = @thisfound[$i..$#thisfound];
            @thisfound = @thisfound[0..$i-1];
            for ($i..$j-1) { push (@thisfound,'*'); }
            push(@thisfound,@end);
            $i=$j-1;
            last; 
        }
    }
    $j == scalar(@thatfound);
}

sub __compare_invalid__ {
    my $j;
    ### Do later commands match?                      ###
    ### If so most likely an INVALID command          ###
    for($j=$i+1;$j<scalar(@thisfound);$j++) {
        if($thisfound[$j] eq $thatfound[$j]) { 
            $diff += $j-$i;
            for ($i..$j-1) { push(@fail,'INVALID'); }
            $i=$j-1;
            last;
        }
    }
    $j == scalar(@thisfound);
}

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

Ответы [ 5 ]

4 голосов
/ 11 января 2010

Если массивы содержат повторяющиеся значения, ответ несколько сложнее, чем этот.

Смотри, например, Алгоритм :: Diff или читайте о Расстояние Левенштейна .

0 голосов
/ 12 января 2010
sub compare {
    local @d = ();

    my $this = shift;
    my $that = shift;
    my $distance = _levenshteindistance($this, $that);

    my @thisorig = @{ $this };
    my @thatorig = @{ $that };

    my $s = $#thisorig;
    my $t = $#thatorig;

    @this = ();
    @that = ();
    @fail = ();

    while($s>0 || $t>0) {
        #                  deletion,    insertion,   substitution
        my $min = _minimum($d[$s-1][$t],$d[$s][$t-1],$d[$s-1][$t-1]);
        if($min == $d[$s-1][$t-1]) {
            unshift(@this,$thisorig[$s]);
            unshift(@that,$thatorig[$t]);
            if($d[$s][$t] > $d[$s-1][$t-1]) {
                unshift(@fail,'INVALID');
            } else {
                unshift(@fail,'NO_FAIL');
            }
            $s -= 1;
            $t -= 1;
        } elsif($min == $d[$s][$t-1]) {
            unshift(@this,'*');
            unshift(@that,$thatorig[$t]);
            unshift(@fail,'EXTRA');
            $t -= 1;
        } elsif($min == $d[$s-1][$t]) {
            unshift(@this,$thisorig[$s]);
            unshift(@that,'*');
            unshift(@fail,'MISSING');
            $s -= 1;
        } else {
            die("Error! $!");
        }
    }

    return(\@this, \@that, \@fail);

}

sub _minimum {
    my $ret = 2**53;
    foreach $in (@_) {
        $ret = $ret < $in ? $ret : $in;
    }
    $ret;
}

sub _levenshteindistance {
    my $s = shift;
    my $t = shift;
    my @s = @{ $s };
    my @t = @{ $t };

    for(my $i=0;$i<scalar(@s);$i++) {
        $d[$i] = ();
    }

    for(my $i=0;$i<scalar(@s);$i++) {
        $d[$i][0] = $i # deletion
    }
    for(my $j=0;$j<scalar(@t);$j++) {
        $d[0][$j] = $j # insertion
    }

    for(my $j=1;$j<scalar(@t);$j++) {
        for(my $i=1;$i<scalar(@s);$i++) {
            if ($s[$i] eq $t[$j]) {
                $d[$i][$j] = $d[$i-1][$j-1];
            } else {
                #                    deletion,      insertion,     substitution
                $d[$i][$j] = _minimum($d[$i-1][$j]+1,$d[$i][$j-1]+1,$d[$i-1][$j-1]+1);
            }
        }
    }

    foreach $a (@d) {
        @a = @{ $a };
        foreach $b (@a) {
            printf STDERR "%2d ",$b;
        }
        print STDERR "\n";
    }

    return $d[$#s][$#t];
}
0 голосов
/ 11 января 2010

От ответа perlfaq4 на Как узнать, содержится ли определенный элемент в списке или массиве? :


(части этого ответа предоставлены Анно Сигелем и Брайаном Д. Фой)

Слушание слова «in» указывает на то, что вам, вероятно, следовало использовать хеш, а не список или массив, для хранения ваших данных. Хэши предназначены для быстрого и эффективного ответа на этот вопрос. Массивы не являются.

Как говорится, есть несколько способов приблизиться к этому. В Perl 5.10 и более поздних версиях вы можете использовать оператор интеллектуального сопоставления, чтобы проверить, содержится ли элемент в массиве или хэше:

use 5.010;

if( $item ~~ @array )
    {
    say "The array contains $item"
    }

if( $item ~~ %hash )
    {
    say "The hash contains $item"
    }

В более ранних версиях Perl вам придется проделать немного больше работы. Если вы собираетесь выполнить этот запрос много раз для произвольных строковых значений, возможно, самый быстрый способ - инвертировать исходный массив и сохранить хеш, ключи которого являются значениями первого массива:

@blues = qw/azure cerulean teal turquoise lapis-lazuli/;
%is_blue = ();
for (@blues) { $is_blue{$_} = 1 }

Теперь вы можете проверить, является ли $ is_blue {$ some_color}. Во-первых, было бы неплохо сохранить блюз в хэше.

Если все значения представляют собой маленькие целые числа, вы можете использовать простой индексированный массив. Этот вид массива займет меньше места:

@primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31);
@is_tiny_prime = ();
for (@primes) { $is_tiny_prime[$_] = 1 }
# or simply  @istiny_prime[@primes] = (1) x @primes;

Теперь вы проверяете, является ли $ is_tiny_prime [$ some_number].

Если рассматриваемые значения являются целыми числами, а не строками, вы можете сэкономить довольно много места, используя вместо этого битовые строки:

@articles = ( 1..10, 150..2000, 2017 );
undef $read;
for (@articles) { vec($read,$_,1) = 1 }

Теперь проверьте, верно ли vec ($ read, $ n, 1) для некоторого $ n.

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

Если вы тестируете только один раз, стандартный модуль List :: Util сначала экспортирует функцию для этой цели. Он работает, останавливаясь, как только находит элемент. Он написан на C для скорости, и его Perl-эквивалент выглядит следующим образом:

sub first (&@) {
    my $code = shift;
    foreach (@_) {
        return $_ if &{$code}();
    }
    undef;
}

Если скорость не имеет значения, распространенная идиома использует grep в скалярном контексте (который возвращает количество элементов, прошедших его условие) для обхода всего списка. Тем не менее, вы можете узнать, сколько совпадений найдено.

my $is_there = grep $_ eq $whatever, @array;

Если вы действительно хотите извлечь соответствующие элементы, просто используйте grep в контексте списка.

my @matches = grep $_ eq $whatever, @array;
0 голосов
/ 11 января 2010

Из ответа perlfaq4 на Как вычислить разницу двух массивов? Как вычислить пересечение двух массивов? :


Используйте хэш. Вот код, чтобы сделать и то, и другое. Предполагается, что каждый элемент уникален в данном массиве:

@union = @intersection = @difference = ();
%count = ();
foreach $element (@array1, @array2) { $count{$element}++ }
foreach $element (keys %count) {
    push @union, $element;
    push @{ $count{$element} > 1 ? \@intersection : \@difference }, $element;
    }

Обратите внимание, что это симметричное различие, то есть все элементы в A или B, но не в обоих. Думайте об этом как о операции xor.

0 голосов
/ 11 января 2010

Хитрость в Perl (и похожих языках) - хеш, который не заботится о порядке.

Предположим, что первый массив - это тот, который содержит допустимые элементы. Создайте хэш с этими значениями в качестве ключей:

  my @valid = qw( one two ... );
  my %valid = map { $_, 1 } @valid;

Теперь, чтобы найти недопустимые элементы, вам просто нужно найти элементы, которых нет в хеше %valid:

  my @invalid = grep { ! exists $valid{$_} } @array;

Если вы хотите узнать индексы массива недопустимых элементов:

  my @invalid_indices = grep { ! exists $valid{$_} } 0 .. $#array;

Теперь вы можете расширить это, чтобы найти повторяющиеся элементы тоже. Вы не только проверяете хэш %valid, но и отслеживаете то, что уже видели:

 my %Seen;
 my @invalid_indices = grep { ! exists $valid{$_} && ! $Seen{$_}++ } 0 .. $#array;

Повторяющиеся допустимые элементы - это элементы со значением в %Seen, которое больше 1:

 my @repeated_valid = grep { $Seen{$_} > 1 } @valid;

Чтобы найти недостающие элементы, посмотрите в %Seen, чтобы проверить, чего там нет.

 my @missing = grep { ! $Seen{$_ } } @valid;
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...