These are quite easy to implement yourself, as long as you restrict yourself to simple arrays and not complicated structures:

my $equal = ! scalar grep { $_ ne $array1[0] } @array1;
[download]

Of course, there is a minor niggle regarding the border case of an empty array - is the empty array uniform or not?

If you want to handle more complex structures than plain scalars, you have to answer the question whether all elements need to have the same structure and the same values, or whether all elements need to be the same reference. If it's the same reference, you can just use the above case, if not, you need to look at is_deeply in Test::More for example, or dump both structures with Data::Dumper and do a string compare.

Updated: neversaint spotted a typo

use List::MoreUtils qw( all );
@array = qw (A A B C);
if (@array && all { $_ eq $array[0] } @array) {
    print "Uniform array: @array\n";
}
[download]

sub check_uniform { 
    my @array = @_;
    my $first = $array[0];
    for(@array) { 
        return 0 unless $_ eq $first;
    }

    return 1;
}
[download]

Something like this perhaps:

#!/usr/bin/perl

use strict;
use warnings;

while (<DATA>) {
  chomp;

  my @a = split;

  my $same = 1;
  for (1 .. $#a) {
    if ($a[$_] ne $a[$_ - 1]) {
      $same = 0;
      last;
    }
  }

  print "@a - elements are ", $same ? "the same\n" : "different\n";
}

__DATA__
A A A A
A B C
A A B C
[download]

Or, if you like something a bit more esoteric:

#!/usr/bin/perl

use strict;
use warnings;

while (<DATA>) {
  chomp;

  my @a = split;

  my %h;
  @h{@a} = @a;
  my $same = keys %h == 1;

  print "@a - elements are ", $same ? "the same\n" : "different\n";
}

__DATA__
A A A A
A B C
A A B C
[download]

use Perl6::Junction qw(all);

print "uniform\n" if (all(@array) eq $array[0]);
[download]

Dear tirwhan,

Thanks for the response. This module (Perl6::Junction) surely is interesting, glad you brought it up.
But is it safe for a production code?


---
neversaint and everlastingly indebted.......

That would depend on your definition of "production safe" I guess. Some pointers

• It has a fairly extensive test suite, which currently passes on all platforms
• The implementation is straightforward and does not rely on any 'dark magic' sort of code(Update:Well, it does use overload which some people consider dark and dangerous magic, but I disagree with these people ;-)
• There are no open bug reports on CPAN (nor are there resolved ones)
• It is at version 1.10 (which depending on the author's philosophy may signify something)
• It is not a source filter (some Perl6:: modules are not considered production safe because they are implemented as source filters)

Personally I've never had a problem with it. While I've not yet used it in client code, I would do so (with tests for all expected outcomes of my own code, as always). If you want more assurance you could always mail the module author and see what he thinks.


Debugging is twice as hard as writing the code in the first place. Therefore, if you write the code as cleverly as possible, you are, by definition, not smart enough to debug it. -- Brian W. Kernighan

You can use a hash:

sub is_uniform {
    my %hash;
    @hash{@_} = ();
    !(1 - keys %hash);
}
[download]

sub equal {@_ < 2 || $_[0] eq $_[1] && equal(@_[1..$#_])}
[download]

Not the fastest? Let's see what we can do about it.

That's tail-end recursion, so it can be optimized:

sub equal {
   return 1 if @_ < 2;
   return 0 if $_[0] ne $_[1];
   shift;
   goto(&equal);
}
[download]

And the recursive call can be eliminated completely:

sub equal {
   while (@_ >= 2) {
      return 0 if $_[0] ne $_[1];
      shift;
   }
   return 1;
}
[download]

Benchmarks:

Read more... (842 Bytes)

            Rate equal_pm  equal_i equal_i2
equal_pm 17854/s       --     -51%     -74%
equal_i  36454/s     104%       --     -46%
equal_i2 67523/s     278%      85%       --
[download]

Oh well, if we're going for speed:

#!/usr/bin/perl

use List::MoreUtils;
use Perl6::Junction;
use strict;
use warnings;

use Benchmark qw( cmpthese );

my @list = ('1')x10;

sub equal_pm {@_ < 2 || $_[0] eq $_[1] && equal_pm(@_[1..$#_])}

sub equal_i {
    return 1 if @_ < 2;
    return 0 if $_[0] ne $_[1];
    shift;
    goto(&equal_i);
}

sub equal_i2 {
    while (@_ >= 2) {
        return 0 if $_[0] ne $_[1];
        shift;
    }
    return 1;
}

sub equal_ti {
    return 1 if (Perl6::Junction::all(@_) eq $_[0]);
    return 0;
}

sub equal_fr {
    my $first = shift;
    for(@_) {
        return 0 unless $_ eq $first;
    }
    return 1;
}

sub equal_pw {
    return 1 if (List::MoreUtils::all { $_ eq $_[0] } @_);
    return 0;
}

sub equal_zx {
    my %hash;
    @hash{@_} = ();
    !(1 - keys %hash);
}

cmpthese(-3, {
              pm => sub { my $rv = equal_pm(@list) ?1:0; 1; },
              i1 => sub { my $rv = equal_i (@list) ?1:0; 1; },
              i2 => sub { my $rv = equal_i2(@list) ?1:0; 1; },
              pw => sub { my $rv = equal_pw(@list) ?1:0; 1; },
              ti => sub { my $rv = equal_ti(@list) ?1:0; 1; },
              fr => sub { my $rv = equal_fr(@list) ?1:0; 1; },
              zx => sub { my $rv = equal_zx(@list) ?1:0; 1; },
                        });
[download]

Which gives:

       Rate   pm   ti   i1   pw   i2   fr   zx
pm  52188/s   -- -30% -47% -69% -73% -78% -82%
ti  74488/s  43%   -- -24% -55% -61% -68% -74%
i1  97929/s  88%  31%   -- -41% -49% -58% -65%
pw 166481/s 219% 123%  70%   -- -13% -29% -41%
i2 192200/s 268% 158%  96%  15%   -- -18% -32%
fr 235585/s 351% 216% 141%  42%  23%   -- -17%
zx 283834/s 444% 281% 190%  70%  48%  20%   --
[download]

So friedo's solution (with some slight alterations for performance) wins.

Update:Included Zaxo's hash solution, all hail the new speed king!


Debugging is twice as hard as writing the code in the first place. Therefore, if you write the code as cleverly as possible, you are, by definition, not smart enough to debug it. -- Brian W. Kernighan