What is the best way to implement the APL compress operator in Perl?

Question

Sometimes my APL familiarity gives me algorithmic ideas for problem solving that I re-implement in a language I have - Perl, for example.

So I have processed a text file to create a boolean vector indicating the used fields in a delimited file, and now I want to output the indexes of those used fields, and the names of the used fields. In APL, I would use the compress operator over the vector of field names, and over the iota of the number of fields.

In Perl, I did this:

my @UsedFieldNames = map { $UsedFields[$_] ? $FieldNames[$_] : () } 0 .. $#UsedFields;

and

say join " ", map { $UsedFields[$_] ? $) : () } 0 .. $#UsedFields;

where @UsedFields is an array containing 0 for unused and 1 for used fields.

1. I don't really like using map with ?:() to simulate compress - is there a better way (my real program does it a third time when simulating a vertical or reduction over the file)?

2. I don't really like doing the map over the indexes to get the results - is there a better way to compute that? (I guess one optimization would be to compute the used indexes first, then

   @UsedFieldNames = @FieldNames[@UsedIndexes];

Answer 1

Other ways:

my @UsedFieldNames = map { ( $FieldNames[$_] ) x !!$UsedFields[$_] } 0..$#UsedFields;
my @UsedFieldNames = @FieldNames[ grep $UsedFields[$_], 0..$#UsedFields ];

Answer 2

The approach with grep or map is the right one, and is what APL would have been using behind the scenes. You can hide that in Perl too with a subroutine:

sub compress (\@\@) {
    @{$_[0]}[ grep $_[1][$_] => 0 .. $#{$_[1]} ]
#or use:
#   map {$_[1][$_] ? $_[0][$_] : ()} 0 .. $#{$_[0]}
}

my @source = qw(one two three four);
my @ok     = qw(0   1   0     1   );

my @new = compress @source, @ok;

say "@new"; # two four

If you are working with array references, you have a few other syntactic options, and in this case I might write it as a scalar method for infix application:

my $compress = sub {
    my $src = shift;
    my $ok  = @_ == 1 && ref $_[0] eq 'ARRAY' ? shift : \@_;
    wantarray ?            @$src[ grep $$ok[$_] => 0 .. $#$ok ]
              : sub{\@_}->(@$src[ grep $$ok[$_] => 0 .. $#$ok ])
};

my $source = [qw(one two three four)];
my $ok     = [qw(1   0   1     0   )];

my $new = $source->$compress($ok);

say "@$new"; # one three
say join ' ' => $source->$compress(0, 1, 1, 0); # two three