Как я могу проверить, все ли элементы массива идентичны в Perl?

Question

У меня есть массив @test. Какой лучший способ проверить, является ли каждый элемент массива одинаковой строкой?

Я знаю, что могу сделать это с помощью цикла foreach, но есть ли лучший способ сделать это? Я проверил функцию карты, но я не уверен, что это то, что мне нужно.

Answer 1

Если строка известна, вы можете использовать grep в скалярном контексте:

if (@test == grep { $_ eq $string } @test) {
 # all equal
}

В противном случае используйте хеш:

my %string = map { $_, 1 } @test;
if (keys %string == 1) {
 # all equal
}

или более короткая версия:

if (keys %{{ map {$_, 1} @test }} == 1) {
 # all equal
}

ПРИМЕЧАНИЕ. Значение ined undef ведет себя как пустая строка (""), когда используется как строка в Perl. Поэтому проверки вернут true, если массив содержит только пустые строки и undef s.

Вот решение, которое учитывает это:

my $is_equal = 0;
my $string   = $test[0]; # the first element

for my $i (0..$#test) {
    last unless defined $string == defined $test[$i];
    last if defined $test[$i] && $test[$i] ne $string;
    $is_equal = 1 if $i == $#test;
}

Answer 2

Оба метода в принятом сообщении дают неправильный ответ, если @test = (undef, ''). То есть они объявляют неопределенное значение равным пустой строке.

Это может быть приемлемо. Кроме того, использование grep проходит через все элементы массива, даже если на раннем этапе обнаружено несоответствие, а использование хэша более чем вдвое увеличивает объем памяти, используемой элементами массива. Ни один из них не будет проблемой, если у вас есть небольшие массивы. И, grep, вероятно, будет достаточно быстрым для разумных размеров списка.

Однако есть альтернатива, которая 1) возвращает false для (undef, ''), а (undef, 0), 2) не увеличивает объем памяти вашей программы и 3) замыкает накоротко, как только обнаружено несоответствие: *

#!/usr/bin/perl

use strict; use warnings;

# Returns true for an empty array as there exist
# no elements of an empty set that are different
# than each other (see
# http://en.wikipedia.org/wiki/Vacuous_truth)

sub all_the_same {
    my ($ref) = @_;
    return 1 unless @$ref;
    my $cmpv = \ $ref->[-1];
    for my $i (0 .. $#$ref - 1)  {
        my $this = \ $ref->[$i];
        return unless defined $$cmpv == defined $$this;
        return if defined $$this
            and ( $$cmpv ne $$this );
    }
    return 1;
}

Однако использование List :: MoreUtils :: first_index может быть быстрее:

use List::MoreUtils qw( first_index );

sub all_the_same {
    my ($ref) = @_;
    my $first = \ $ref->[0];
    return -1 == first_index {
        (defined $$first != defined)
            or (defined and $_ ne $$first)
    } @$ref;
}

Answer 3

TIMTOWTDI, и я много читал Марк Джейсон Доминус в последнее время.

use strict;
use warnings;

sub all_the_same {
    my $ref = shift;
    return 1 unless @$ref;
    my $cmp = $ref->[0];
    my $equal = defined $cmp ?
        sub { defined($_[0]) and $_[0] eq $cmp } :
        sub { not defined $_[0] };
    for my $v (@$ref){
        return 0 unless $equal->($v);
    }
    return 1;
}

my @tests = (
    [ qw(foo foo foo) ],
    [ '', '', ''],
    [ undef, undef, undef ],
    [ qw(foo foo bar) ],
    [ '', undef ],
    [ undef, '' ]
);

for my $i (0 .. $#tests){
    print "$i. ", all_the_same($tests[$i]) ? 'equal' : '', "\n";
}

Answer 4

Вы можете проверить, сколько раз элемент в массиве (@test) повторяется, посчитав его в хэше (% увиденного). Вы можете проверить, сколько ключей ($ size) присутствует в хэше (% увиденного). Если присутствует более 1 ключа, вы знаете, что элементы в массиве не идентичны.

sub all_the_same {
    my @test = @_;
    my %seen;
    foreach my $item (@test){
      $seen{$item}++
    }
    my $size = keys %seen;
    if ($size == 1){
        return 1;
    }
    else{
        return 0;
    }
}

Answer 5

Я думаю, мы можем использовать List :: MoreUtils qw (uniq)

my @uniq_array = uniq @array;
my $array_length = @uniq_array;
$array_length == 1 ? return 1 : return 0;

Answer 6

Я использую List::Util::first для всех подобных целей.

# try #0: $ok = !first { $_ ne $string } @test;
# try #1: $ok = !first { (defined $_ != defined $string) || !/\A\Q$string\E\z/ } @test;

# final solution
use List::Util 'first';
my $str = shift @test;
my $ok = !first { defined $$_ != defined $str || defined $str && $$_ ne $str } map \$_, @test;

Я использовал map \$_, @test здесь, чтобы избежать проблем со значениями, которые оцениваются как ложные.

Примечание. Как справедливо заметил cjm, использование map сводит на нет преимущество первого короткого замыкания. Поэтому я склоняю шляпу перед Синаном с его решением first_index.