Beefy Boxes and Bandwidth Generously Provided by pair Networks
The stupid question is the question not asked
 
PerlMonks  

move all 0s in an array to the beginning keeping other elements order same

by anilmwr (Initiate)
on May 01, 2014 at 21:46 UTC ( #1084692=perlquestion: print w/replies, xml ) Need Help??

anilmwr has asked for the wisdom of the Perl Monks concerning the following question:

I want to move all 0s in an array to the beginning keeping other elements order same.
@array = (1, 2, 3, 4, 2, 1, 2, 0, 1, 0, 0); @array1 = (); @array2 = (); foreach $i (@array) { push($i, @array1) if $i == 0; push($i, @array2) if $i != 0; } @new_array = (@array1, @array2);
Is there any better way to do this?
  • Comment on move all 0s in an array to the beginning keeping other elements order same
  • Download Code

Replies are listed 'Best First'.
Re: move all 0s in an array to the beginning keeping other elements order same
by davido (Cardinal) on May 01, 2014 at 22:10 UTC

    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;

    The output will be:

    0 0 0 1 2 3 4 2 1 2 1

    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)))

    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."


    Dave

Re: move all 0s in an array to the beginning keeping other elements order same
by kcott (Bishop) on May 01, 2014 at 22:16 UTC

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

    Output:

    1 2 3 4 2 1 2 0 1 0 0 0 0 0 1 2 3 4 2 1 2 1

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

    -- Ken

Re: move all 0s in an array to the beginning keeping other elements order same
by GrandFather (Saint) on May 01, 2014 at 23:32 UTC

    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;

    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.

    Perl is the programming world's equivalent of English
Re: move all 0s in an array to the beginning keeping other elements order same
by roboticus (Chancellor) on May 01, 2014 at 21:54 UTC

    anilmwr:

    How about:

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

    or, perhaps:

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

    Note: Untested....

    ...roboticus

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

Re: move all 0s in an array to the beginning keeping other elements order same
by kennethk (Abbot) on May 01, 2014 at 21:56 UTC

    sort:

    @array = sort {-($a == 0) || $b == 0} @array;
    Note that this is not a stable sort for the zeroes. For that you could use
    @array = sort {($b == 0)-($a == 0)} @array;
    or even
    @array = sort {!$b - !$a} @array;
    Of course, I'd curse the programmer that used this in production code.

    #11929 First ask yourself `How would I do this without a computer?' Then have the computer do it the same way.

      Add use sort 'stable'; to ensure you get the correct result.
Re: move all 0s in an array to the beginning keeping other elements order same
by SuicideJunkie (Vicar) on May 01, 2014 at 22:13 UTC

    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);
Re: move all 0s in an array to the beginning keeping other elements order same - Benchmarks
by Random_Walk (Prior) on May 02, 2014 at 07:44 UTC

    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, $_; } }

    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% --

    Cheers,
    R.

    Pereant, qui ante nos nostra dixerunt!

      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:

      ...and the code...

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


      Dave

Re: move all 0s in an array to the beginning keeping other elements order same
by Cristoforo (Curate) on May 02, 2014 at 00:07 UTC
    Another way that works!
    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; }
Re: move all 0s in an array to the beginning keeping other elements order same
by dbuckhal (Hermit) on May 02, 2014 at 04:09 UTC
    Probably a duplicate, but my contribution:
    $ 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
Re: move all 0s in an array to the beginning keeping other elements order same
by Anonymous Monk on May 01, 2014 at 22:10 UTC

    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"
Re: move all 0s in an array to the beginning keeping other elements order same
by AppleFritter (Vicar) on May 02, 2014 at 09:42 UTC

    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.

Re: move all 0s in an array to the beginning keeping other elements order same
by anilmwr (Initiate) on May 02, 2014 at 11:39 UTC

    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.

Re: move all 0s in an array to the beginning keeping other elements order same
by BillKSmith (Monsignor) on May 02, 2014 at 12:08 UTC
    One more variation on sort:
    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";
    Bill
      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

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://1084692]
Approved by kcott
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others imbibing at the Monastery: (4)
As of 2022-05-27 06:21 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Do you prefer to work remotely?



    Results (94 votes). Check out past polls.

    Notices?