Re^2: Code review: function to trim whitespace from all items in a list

[choroba]

My solution doesn't change the list, as it uses the /r modifier.

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

use Test::More;

sub trim_nonempties {
   ## no critic (ProhibitMutatingListFunctions)
   grep { !/^\s*$/ && s/^\s*|\s*$//g } @_;
   ## use critic
}

sub choroba {
    grep !/^$/, map s/^\s+|\s+$//gr, @_
}

my @X = ( ' hello ', "\thello again\t", '', " ", " \t", 'jock', "\t ab
+c", "def \t " );
my @changed = @X;
my @y = trim_nonempties(@changed);

my @stay = @X;
my @w = choroba(@stay);
is_deeply(\@y, \@w, 'same');
is_deeply(\@X, \@stay, 'no mutation');
done_testing();

[Tux]

What about undef? It can be even faster:

use 5.16.2;
#use warnings;

use Test::More;
use Benchmark qw( cmpthese );

# Returns non-empty strings with leading and trailing spaces removed.
sub mca # McA
{
    grep { $_ ne "" } map { s/^\s+//; s/\s+$//; $_ } @_;
    }

sub tux # Tux
{
    map { defined $_ ? m/(\S(?:.*\S)?)/ : () } @_;
    }

sub choroba # choroba
{
    grep !m/^$/ => map s/^\s+|\s+$//gr => @_
    }

sub eplam # eyepopslikeamosquito
{
    grep { !m/^\s*$/ && s/^\s*|\s*$//g } @_;
    }

my @x = (" hello ", "\thello again\t", "", " ",
     undef, " \t", "jock", "\t abc", "def \t ");
my @e = ("hello", "hello again", "jock", "abc", "def");

is_deeply ([ mca     (@x) ], \@e, "mca");
is_deeply ([ tux     (@x) ], \@e, "tux");
is_deeply ([ choroba (@x) ], \@e, "choroba");
is_deeply ([ eplam   (@x) ], \@e, "eplam");

cmpthese (1000000, {
    "mca"     => sub { my @y = mca     (@x); },
    "tux"     => sub { my @y = tux     (@x); },
    "choroba" => sub { my @y = choroba (@x); },
    "eplam"   => sub { my @y = eplam   (@x); },
    });

done_testing;
__END__
ok 1 - mca
ok 2 - tux
ok 3 - choroba
ok 4 - eplam
            Rate   eplam choroba     mca     tux
eplam   100908/s      --    -40%    -57%    -66%
choroba 169205/s     68%      --    -29%    -43%
mca     236967/s    135%     40%      --    -20%
tux     297619/s    195%     76%     26%      --
1..4

[duelafn]

These benchmarks are unreliable due to the mutating aspect of some of the functions. With original list copying, the results change (eplam and chorba now tied). Also, reporting whether the code is mutating and/or offends Perl::Critic can help in actually deciding what really is best. (modify Perl::Critic settings to taste)

ok 1 - mca
       is mutating
       does not offend Perl::Critic
ok 2 - choroba
       is NOT mutating
       offends Perl::Critic
           Expression form of "grep" at line 6, column 5. See page 169
+ of PBP.
           Expression form of "map" at line 6, column 20. See page 169
+ of PBP.
ok 3 - tux
       is NOT mutating
       does not offend Perl::Critic
ok 4 - eplam
       is mutating
       does not offend Perl::Critic
           Rate   eplam choroba     mca     tux
eplam   41701/s      --     -2%    -40%    -54%
choroba 42626/s      2%      --    -39%    -53%
mca     69930/s     68%     64%      --    -23%
tux     91241/s    119%    114%     30%      --
1..4

More honest benchmark code:

use 5.14.2;
#use warnings;
no strict 'refs';
no warnings 'uninitialized';

use Perl::Critic;
use Test::More;
use Benchmark qw( cmpthese );

# Returns non-empty strings with leading and trailing spaces removed.
my %tests = (
    mca => <<'MCA',
sub mca # McA
{
    grep { $_ ne "" } map { s/^\s+//; s/\s+$//; $_ } @_;
    }
MCA
    tux => <<'TUX',
sub tux # Tux
{
    map { defined $_ ? m/(\S(?:.*\S)?)/ : () } @_;
    }
TUX
    choroba => <<'CHOROBA',
sub choroba # choroba
{
    grep !m/^$/ => map s/^\s+|\s+$//gr => @_
    }
CHOROBA
    eplam => <<'EPLAM',
sub eplam # eyepopslikeamosquito
{
    grep { !m/^\s*$/ && s/^\s*|\s*$//g } @_;
    }
EPLAM
);

my @orig = (" hello ", "\thello again\t", "", " ",
     undef, " \t", "jock", "\t abc", "def \t ");
my @e = ("hello", "hello again", "jock", "abc", "def");
my @x;

# Configure Perl::Critic as you will:
my $critic = Perl::Critic->new(-severity => 4);

sub test {
    my ($name, $code) = @_;
    eval $code;
    @x = @orig;
    is_deeply ([ &$name(@x) ], \@e, $name);
    say "       ", (eq_array(\@orig, \@x) ? "is NOT mutating" : "is mu
+tating");
    # Optional fixups that your Perl::Critic config expects
    $code = <<"FAKE_CODE";
package Foo;
use strict;
use warnings;
$code;
1;
FAKE_CODE
    say "       ", ($critic->critique(\$code) ? "offends Perl::Critic"
+ : "does not offend Perl::Critic");
    print "           ", $_ for $critic->critique(\$code);
}

my %compare;
for (keys %tests) {
    my ($name, $code) = ($_, $tests{$_});
    test $name => $code;
    $compare{$name} = sub { @x = @orig; my @y = &$name(@x); };
}

cmpthese (1000000, \%compare);

done_testing;

Update: Added reporting about whether method is mutating or not.

Update 2: Ok, just having fun now, added inline Perl::Critic check and reporting.

[Tux]

So I win on every point :)

Couldn't resist

[LanX]

True my deepest apologies° , I oversaw the /r !

Partially also bc I haven't got used to this new feature yet. :)

>= 5.18 ?

°) Kowtow ;)

[choroba]

Syntax::Construct says 5.14.

[LanX]

Cool so I can use it already. =)

But are you sure that Critic is silenced now if you are still operating on @_ ?

PS: can I raise my head again now? ;-p