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

Ответ 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
}

ПРИМЕЧАНИЕ. Значение undef ined ведет себя как пустая строка ("") при использовании в качестве строки в 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;
}

Ответ 2

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

Это может быть приемлемо. Кроме того, использование 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;
}

Ответ 3

TIMTOWTDI, и я в последнее время читал много Mark Jason Dominus.

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";
}

Ответ 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;
    }
}

Ответ 5

Я использую 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 здесь, чтобы избежать проблем со значениями, которые вычисляются как false.

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

Ответ 6

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

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