Try to remove specific columns using splice in Perl

perl, split

Solution

After I blogged about this question, a commenter pointed out that it is possible to reduce run time by 45% for my test case. I paraphrased his code a little bit:

my @keep;
while (<>) {
    my @data = split;

    unless (@keep) {
        @keep = (0, 1, 0, 1, 1);
        for (my $i = 5; $i < @data; $i += 3) {
            push @keep, 1, 1, 0;
        }
    }

    my $i = 0;
    print join(' ', grep $keep[$i++], @data), "\n";
}

This runs in almost half the time my original solution took:

$ time ./zz.pl input.data > /dev/null 
real 0m21.861s
user 0m21.310s
sys 0m0.280s

Now, it is possible to gain another 45% performance by using Inline::C in a rather dirty way:

#!/usr/bin/env perl

use strict;
use warnings;

use Inline C => <<'END_C'

/*
  This code 'works' only in a limited set of circumstances!
  Don't expect anything good if you feed it anything other
  than plain ASCII 
*/

#include <ctype.h>

SV *
extract_fields(char *line, AV *wanted_fields)
{
    int ch;
    IV current_field = 0;
    IV wanted_field = -1;

    unsigned char *cursor = line;
    unsigned char *field_begin = line;
    unsigned char *save_field_begin;

    STRLEN field_len = 0;
    IV i_wanted = 0;
    IV n_wanted = av_len(wanted_fields);

    AV *ret = newAV();
    while (i_wanted <= n_wanted) {
        SV **p_wanted = av_fetch(wanted_fields, i_wanted, 0);
        if (!(*p_wanted)) {
            croak("av_fetch returned NULL pointer");
        }
        wanted_field = SvIV(*p_wanted);

        while ((ch = *(cursor++))) {

            if (!isspace(ch)) {
                continue;
            }

            field_len = cursor - field_begin - 1;
            save_field_begin = field_begin;
            field_begin = cursor;

            current_field += 1;
            if (current_field != wanted_field) {
                continue;
            }

            av_push(ret, newSVpvn(save_field_begin, field_len));
            break;
        }
        i_wanted += 1;
    }
    return newRV_noinc((SV *) ret);
}

END_C
;

And, here is the Perl part. Note that we `split` only once to figure out the indices of fields to keep. Once we know those, we pass the line and the (1-based) indices to the C routine to slice and dice.

my @keep;
while (my $line = <>) {
    unless (@keep) {
        @keep = (2, 4, 5);
        my @data = split ' ', $line;
        push @keep, grep +(($_ - 5) % 3), 6 .. scalar(@data);
    }
    my $fields = extract_fields($line, \@keep);
    print join(' ', @$fields), "\n";
}

$ time ./ww.pl input.data > /dev/null 
real 0m11.539s
user 0m11.083s
sys 0m0.300s

`input.data` was generated using:

$ perl -E 'say join(" ", "A" .. "ZZZZ") for 1 .. 100' > input.data

and it is about 225MB in size.

Problem

Original source