This is partitioning, and there's a utility in List::MoreUtils to facilitate it:

use feature 'say';
use List::MoreUtils 'part';

@array = (1, 2, 3, 4, 2, 1, 2, 0, 1, 0, 0);

say join ' ', map { @$_ } part { !!$_ } @array;
[download]

The output will be:

0 0 0 1 2 3 4 2 1 2 1
[download]

Update: (Off topic) I supposed that there would be an equally elegant solution to this using Racket (a Lisp dialect based on Scheme). ...and there probably is, but with my limited vocabulary this is what I came up with:

(define array (list 1 2 3 4 2 1 2 0 1 0 0))

(let-values ([(x y) 
              (partition (lambda (x) (< x 1)) 
                         array)])
  (flatten (list x y)))
[download]

I'm wondering if there's a better WTDI.

Update2: As I look again a few hours later I do think the Racket/Scheme solution is fine. Read it from the inside outward: Start with a list named 'array', partition it based on the conditional within the lambda function (similar to the code-ref passed to "part" in Perl). That produces two lists, just like Perl's "part" generates two array refs. Finally gather into 'x' and 'y' those two lists ("let-values" does this, since the minimal syntax doesn't have anything analogous to Perl's "@{$aref}" , and flatten them into a single list, which is what map's coderef is doing for us in the Perl solution. The clutter is because Lisp has almost no syntax beyond ( parens ). This solution is so similar to the Perl one I wrote, perhaps it's proof that you can write Lisp in Perl. Or maybe that you can write Perl in Lisp. ;)

From the benchmarks posted below I see that the 'part' solution falls in the middle of the pack for performance, which probably lends support for the common expression, "Lisp programmers know the value of everything and the cost of nothing."

G'day anilmwr,

Welcome to the monastery.

"Is there any better way to do this?"

That probably depends on what you mean by "better". Here's a different way of doing it which:

• uses strict
• uses warnings
• doesn't use package global variables
• doesn't require the creation of three additional arrays

#!/usr/bin/env perl -l

use strict;
use warnings;

my @array = (1, 2, 3, 4, 2, 1, 2, 0, 1, 0, 0);
print "@array";

my $zeros = 0;
@array = map { $_ == 0 ? ++$zeros && () : $_ } @array;
unshift @array, (0) x $zeros;
print "@array";
[download]

Output:

1 2 3 4 2 1 2 0 1 0 0
0 0 0 1 2 3 4 2 1 2 1
[download]

If by "better", you meant faster, use the builtin module, Benchmark, to find out.

I guess you didn't in fact try that code because it doesn't actually run. With Perl version 5.16 I get an error like Not an ARRAY reference at test.pl line 6..

I'd tend to write something like:

#!user/bin/perl
use warnings;
use strict;

my @array = (1, 2, 3, 4, 2, 1, 2, 0, 1, 0, 0);
my @newArray = grep{!$_} @array;
push @newArray, grep {$_} @array;
[download]

which is succinct but reasonably clear. It makes two grep passes through the array so it could be improved if you are dealing with very large arrays that cause a speed or memory issue, but otherwise go with clarity for the win.

anilmwr:

How about:

my @new_array=();
for my $i (@array) {
   if ($i) {
      push @new_array, $i;
   }
   else {
      unshift @new_array, $i;
   }
}
[download]

or, perhaps:

my @new_array = (
    grep( { ! $_ } @array),
    grep( { $_ } @array)
);
[download]

Note: Untested....

...roboticus

When your only tool is a hammer, all problems look like your thumb.

sort:

@array = sort {-($a == 0) || $b == 0} @array;
[download]

@array = sort {($b == 0)-($a == 0)} @array;
[download]

@array = sort {!$b - !$a} @array;
[download]

Add use sort 'stable'; to ensure you get the correct result.

Here's another way to do it if all the false values are just zero:

my $size = @array;
@array = grep {$_} @array;
unshift @array, (0) x ($size - @array);
[download]

Hi all, after choroba and davido had to point out the epic fail in my last benchmark attempt, I hope I have done better with this one:

#!/usr/bin/perl
#
use strict;
use warnings;
use 5.010;
use Benchmark qw(cmpthese);

our @orig_array;
for (1 .. 1000) {push @orig_array, int rand 4}
say join ", ", @orig_array;

my $count = 10_000;
cmpthese($count, {
  anilmwr        => \&anilmwr,
  roboticus_1    => \&roboticus_1,
  roboticus_2    => \&roboticus_2,
  kennethk_1     => \&kennethk_1,
  kennethk_2     => \&kennethk_2,
  kennethk_3     => \&kennethk_3,
  Anonymous_Monk => \&Anonymous_Monk,
  SuicideJunkie  => \&SuicideJunkie,
  kcott          => \&kcott,
  GrandFather    => \&GrandFather,
  Cristoforo     => \&Cristoforo,
  dbuckhal       => \&dbuckhal,
});

sub anilmwr { # Fixed but keeping the concept of the original
    my @array = @main::orig_array;
    my @array1 = ();
    my @array2 = ();
    foreach my $i (@array) {
        push @array1, $i if $i == 0;
        push @array2, $i if $i != 0;
    }
    my @new_array = (@array1, @array2);
}

sub roboticus_1 {
    my @array = @main::orig_array;
    my @new_array=();
    for my $i (@array) {
        if ($i) {
            push @new_array, $i;
        }
        else {
            unshift @new_array, $i;
        }
    }
}

sub roboticus_2 {
    my @array = @main::orig_array;
    my @new_array = (
        grep( { ! $_ } @array),
        grep( { $_ } @array)
    );
}

sub kennethk_1 {
    my @array = @main::orig_array;
    @array = sort {-($a == 0) || $b == 0} @array;
}

sub kennethk_2 {
    my @array = @main::orig_array;
    @array = sort {($b == 0)-($a == 0)} @array;
}

sub kennethk_3 {
    my @array = @main::orig_array;
    @array = sort {!$b - !$a} @array;
}

# I do not have List::MoreUtils on this work machine, and can't instal
+l it now.
# A shame 'cos I had high hopes for this one. May try it at home later
+ if the tuit
# is to be found
# use List::MoreUtils 'part';
# sub davido {
#    my @array = @main::orig_array;
#    @array = map { @$_ } part { !!$_ } @array;
# }

sub Anonymous_Monk {
    my @array = @main::orig_array;
    @array = do { my @tmp = grep $_, @array; ((0)x(@array-@tmp),@tmp) 
+};
}

sub SuicideJunkie {
    my @array = @main::orig_array;
    my $size = @array;
    @array = grep {$_} @array;
    unshift @array, (0) x ($size - @array);
}

sub kcott {
    my @array = @main::orig_array;
    my $zeros = 0;
    @array = map { $_ == 0 ? ++$zeros && () : $_ } @array;
    unshift @array, (0) x $zeros;
}

sub GrandFather {
    my @array = @main::orig_array;
    my @newArray = grep{!$_} @array;
    push @newArray, grep {$_} @array;
}

sub Cristoforo {
    my @array = @main::orig_array;
    for my $i (0 .. $#array) {
        unshift @array, splice @array, $i, 1 if $array[$i] == 0;
    }
}

sub dbuckhal {
    my @array = @main::orig_array;
    my @y;
    for ( @array ) {
        ( $_ ) ? push @y, $_ : unshift @y, $_;
    }
}
[download]

Results

                 Rate kennethk_2 kennethk_3 kennethk_1 anilmwr Anonymo
+us_Monk kcott Cristoforo roboticus_1 SuicideJunkie dbuckhal Random_Wa
+lk roboticus_2 GrandFather
kennethk_2     1115/s         --        -7%       -11%    -39%        
+   -40%  -47%       -58%        -60%          -60%     -61%        -6
+2%        -62%        -63%
kennethk_3     1205/s         8%         --        -4%    -34%        
+   -35%  -43%       -55%        -56%          -57%     -58%        -5
+9%        -59%        -60%
kennethk_1     1252/s        12%         4%         --    -31%        
+   -32%  -40%       -53%        -55%          -55%     -57%        -5
+8%        -58%        -58%
anilmwr        1821/s        63%        51%        46%      --        
+    -1%  -13%       -31%        -34%          -35%     -37%        -3
+8%        -38%        -39%
Anonymous_Monk 1845/s        65%        53%        47%      1%        
+     --  -12%       -30%        -33%          -34%     -36%        -3
+8%        -38%        -38%
kcott          2101/s        88%        74%        68%     15%        
+    14%    --       -21%        -24%          -25%     -27%        -2
+9%        -29%        -30%
Cristoforo     2653/s       138%       120%       112%     46%        
+    44%   26%         --         -4%           -6%      -8%        -1
+0%        -10%        -11%
roboticus_1    2755/s       147%       129%       120%     51%        
+    49%   31%         4%          --           -2%      -4%         -
+7%         -7%         -8%
SuicideJunkie  2809/s       152%       133%       124%     54%        
+    52%   34%         6%          2%            --      -3%         -
+5%         -5%         -6%
dbuckhal       2882/s       159%       139%       130%     58%        
+    56%   37%         9%          5%            3%       --         -
+3%         -3%         -4%
roboticus_2    2959/s       165%       146%       136%     62%        
+    60%   41%        12%          7%            5%       3%          
+0%          --         -1%
GrandFather    2994/s       169%       149%       139%     64%        
+    62%   43%        13%          9%            7%       4%          
+1%          1%          --
[download]

Cheers,
R.

This benchmark seems reasonable. I made a couple small changes: set the count to a negative interval, which makes it run each for "n" seconds, and increased the array size.

I do have List::MoreUtils, so I added mine to the benchmark test. My solution fell square in the middle of the pack. Here are the results I get:

Read more... (4 kB)

...and the code...

Read more... (3 kB)

I still like the semantic purity of the List::MoreUtils 'part'; solution, but beauty is probably in the eye of the beholder. ;)




Dave

my @array = (1, 2, 3, 4, 2, 1, 2, 0, 1, 0, 0);

for my $i (0 .. $#array) {
    unshift @array, splice @array, $i, 1 if $array[$i] == 0;
}
[download]

$ perl -le '@x = (1, 2, 3, 4, 2, 1, 2, 0, 1, 0, 0);
            for ( @x ) {
              ( $_ ) ? push    @y, $_
                     : unshift @y, $_;
            }
            print "@y\n";
'

__output__
0 0 0 1 2 3 4 2 1 2 1
[download]

This is a fun little TIMTOWTDI question :-) Here's another solution:

my @array = (1, 2, 3, 4, 2, 1, 2, 0, 1, 0, 0);

@array = do { my @tmp = grep $_, @array; ((0)x(@array-@tmp),@tmp) };

print "@array\n";  # prints "0 0 0 1 2 3 4 2 1 2 1"
[download]

My first instinct there would be to:

1. use grep to filter all zeros from the array;
2. count them while you're doing that, and then prepend a suitable number of zeros to the filtered array.

I don't know whether that's a particularly efficient solution.

Thank you all!

By "better", I meant maybe using less arrays or like that.

It seems asking Perl questions here is more fruitful than on StackOverflow. :-)

With all due respect to SO, it is definitely the case that PerlMonks is the “go-to site” on the Internet for Perl related questions.   The greatest concentration of [Perl, and other things] expertise that I have ever found is here, and generally quite willing to jump in and help ... with examples ... for even some mighty esoteric questions.

As others have said, I would solve this problem by using grep to curry out all of the elements that are not zero, then if necessary unshift a list containing an appropriate number of zeros onto the front of the result.   This will have the effect of “moving the zeros to the front” without otherwise altering the order of the elements, although it does so in a different (but equivalent) way.

use strict;
use warnings;
my @array = (3, 5, 0, 0, 7, 7, 0, 8, 2, 0, 1, 8, 4);
my @sorted_array = sort {($a xor $b) ? ($a <=> $b) : 0 } @array;
print "@sorted_array\n";
[download]

Add use sort 'stable'; to ensure you get the correct result.

Hi ikegami,

can you please explain why using the use sort 'stable'; pragma would be important? Admittedly, the sorting block is peculiar and treats non 0 values as equal so that non 0 values may be reshuffled in the process (as would be the case using quick sort). However, since Perl 5.8, the default sorting algorithm (merge sort) is inherently stable, so I would expect the order of non 0 values to be preserved. Is there anything that I am missing?

Thanks, I forgot about stability, especially when my single test case workeed correctly.
Bill