How to optimally move lines with a specific pattern at the top in a huge file using Perl?

Question

I have a huge csv file of nearly 20k rows with below format:

file,tools,edit,syntax,buffers
a,b,c,perl,d
a,w,c33,java,d
a,e,c,perl,d
a,s,c,python,d1
a,n,c,php,d3
d,r,hhh,cpp,d0
d,m,hhh,c#,d0
a,o,c,pdf,d3
a,f,c,python,dd
a,h,c,perl,dg
a,yb,c,c,ddf
a,b,c,perl,dt
wa,b,c33,java,d
d,buuu,hhh,cpp,d0
d44,b,hhh,nlp,d0
a,be,c,js,d4
wa,b,c33,java,d
wa,b,c33,python,d
wa,b,c33,python,d
wa,b,c33,c#,d
wa,b,c33,python,d
wa,b,c33,php,d
wa,b,c33,python,d
wa,b,c33,php,d
wa,b,c33,python,d
wa,b,c33,perl,d
wa,b,c33,php,d
wa,b,c33,java,d
wa,b,c33,python,d

I need to put 2 lines of pattern with same syntax (i.e 4th column) at the top. And then the rest of the lines will be there as is. That means first two lines with syntax as 'perl', then followed by 'java' , 'python' etc that way.

I have so far written this below code using seek and tell to make it optimized. However, it is not working as expected.

use strict;
use warnings;

open(FP, "+<mycsv.csv");

my %hash = ();
my $cur_pos;    


while(<FP>) {

    my $line = $_;
    chomp $line;
    #print "$line aaa\n";
    if($line =~ /^file\,tools,/) {next;}

    if($line =~ /^\w+\,\w+\,\w+,(\w+)\,.*$/) {
        my $type = $1;
        #print "type $type\n";

    if($hash{$type}->{count} < 2 ) {
        #print "--- here type = $type | lastpos = ", $hash{$type}->{lastpos} , "\n";
        $cur_pos = tell(FP);
        my $pos = tell(FP) - length($line); 
        if($hash{$type}->{lastpos} ) {

            my $lastpos = $hash{$type}->{lastpos};
            seek(FP, $lastpos, 1);
            print FP $line;
            seek(FP, $cur_pos, 1);
        } 

        $hash{$type}->{lastpos} = $pos;


    }
        if(exists $hash{$type} ) {
            $hash{$type}->{count} += 1;
        } else {
            $hash{$type}->{count} = 1;
        }


    }
}


close(FP);

The expected output should look like below:

 file,tools,edit,syntax,buffers
    a,b,c,perl,d
    a,e,c,perl,d
    a,w,c33,java,d
    wa,b,c33,java,d
    a,s,c,python,d1
    a,f,c,python,dd
    a,n,c,php,d3
    wa,b,c33,php,d
    d,r,hhh,cpp,d0
    d,buuu,hhh,cpp,d0
    d,m,hhh,c#,d0
    wa,b,c33,c#,d
    a,o,c,pdf,d3 
    a,yb,c,c,ddf 
    d44,b,hhh,nlp,d0
    a,be,c,js,d4  
    a,h,c,perl,dg   
    a,b,c,perl,dt   
    wa,b,c33,java,d
    wa,b,c33,python,d
    wa,b,c33,python,d
    wa,b,c33,python,d
    wa,b,c33,python,d
    wa,b,c33,php,d
    wa,b,c33,python,d
    wa,b,c33,perl,d
    wa,b,c33,php,d
    wa,b,c33,java,d
    wa,b,c33,python,d

Any help to make it work would be much appreciated.

Thanks.

Answer 1

I'm getting little different output than yours for the same logic. Can you please go through this output and let me know if any change is required? Approach is mentioned inline with the comments.

use strict;
use warnings;
use feature 'say';
my $syntax = [];
my $NUM = 2;   # change number if needed
my $filename = 'file.txt';
my $data = {};  # make a hash of data

open(my $fh, '<:encoding(UTF-8)', $filename)
or die "Could not open file '$filename' $!";
while (my $row = <$fh>) {
    chomp $row;
    next if $. == 1; # skip header row
    my @columns = split (',', $row);

    push @$syntax, $columns[3];   # make a list of all syntaxes available
    push @{$data->{$columns[3]}}, $row;
}
close $fh;

my $processed = {};
# loop throught the syntax array and print data from hash
# also, make a counter of the number of times that syntax is used.
# it will help us to skip next (n-1) occurence of that syntax
for my $syntax (@$syntax) {
    if (!$processed->{$syntax}){
        for my $s (splice @{$data->{$syntax}}, 0, $NUM) {
            $processed->{$syntax} += 1;
            say $s;
        }
    } else {
        $processed->{$syntax} -= 1;
    }
}
# print out the remaining values
for my $rem (values %$data){
    say for @$rem;    
}

Output:

a,b,c,perl,d
a,e,c,perl,d
a,w,c33,java,d
wa,b,c33,java,d
a,s,c,python,d1
a,f,c,python,dd
a,n,c,php,d3
wa,b,c33,php,d
d,r,hhh,cpp,d0
d,buuu,hhh,cpp,d0
d,m,hhh,c#,d0
wa,b,c33,c#,d
a,o,c,pdf,d3
a,yb,c,c,ddf
a,h,c,perl,dg
a,b,c,perl,dt
d44,b,hhh,nlp,d0
a,be,c,js,d4
wa,b,c33,python,d
wa,b,c33,python,d
wa,b,c33,python,d
wa,b,c33,python,d
wa,b,c33,php,d
wa,b,c33,php,d
wa,b,c33,java,d
wa,b,c33,java,d
wa,b,c33,python,d
wa,b,c33,python,d
wa,b,c33,perl,d

Answer 2

I'd approach this by parsing the file to collect those first pairs of lines in a data structure and sending the other lines to a temp file. Once you've finished parsing the file, print out the pairs of lines from the data structure into your output file, and then add the temp file on to the end of the output file.

sample code:

use strict;
use warnings;
use feature ':5.16';

my $infile = 'infile';
my $outfile = 'outfile';
my $tempfile = 'temp';
my $quantity = 2;  # or whatever

open my $in, '<', $infile or die 'Could not open infile: ' . $!;
open my $out, '>', $outfile or die 'Could not create output file: ' . $!;
open my $temp, '>', $tempfile or die 'Could not create tempfile: ' . $!;

my $hash = {};
my @order;
my $hdr;

while ( <$in> ) {
  if ( $hdr ) {
    my @cols = split ",", $_;
    my $key = $cols[3];

    # have we seen this key before?
    if ( ! $hash->{$key} ) {
      push @order, $key;
      $hash->{$key} = [ $_ ];
    }
    elsif ( scalar @{$hash->{$key}} < $quantity ) {
      push @{$hash->{$key}}, $_;
    }
    else {
      print { $temp } $_;
    }
  }
  else {
    # the header line
    print { $out } $_;
    $hdr = $_;
  }
}

# print the collected twofers out into the tempfile
for my $key ( @order ) {
  print { $out } @{$hash->{$key}};
}
close $out;
close $temp;

# concatenate the files
system join ' ', ( 'cat', $tempfile, '>>', $outfile );

If the paired lines don't have to be in the order that they appear in the source file, you can skip the @order stuff.

Answer 3

I have a huge CSV file of nearly 20k rows with below format:

That is not huge by any stretch. The file size is probably about a megabyte.

While I normally recommend line-by-line processing to ensure robustness with respect to file size, in this case, you know that the files you are dealing with are small. The question is whether the time you spend optimizing this thing is worth it.

If I understand you correctly, your problem can be solved quickly (in programmer time) by wasting some memory:

#!/usr/bin/env perl

use strict;
use warnings;
use List::Util qw( uniqstr );

my $TOP = 2;

(my $header = <DATA>) =~ s/\s+\z//;
my @header = split /,|\s+/, $header;
my %idx = map +($header[$_] => $_), 0 .. $#header;

my @lines = grep /\S/, <DATA>;
my %syntax_of = map +($_ => (split /,/, $_)[$idx{syntax}]), @lines;

my @syntaxes = uniqstr map $syntax_of{$_}, @lines;

my %lines_of;
for my $n (0 .. $#lines) {
    push @{$lines_of{$syntax_of{$lines[$n]}}}, $n;
}

print "$header\n";

for my $syntax (@syntaxes) {
    my @top = grep defined, map $lines_of{$syntax}->[$_ - 1], 1 .. $TOP;
    print @lines[@top];
    # normally, invoking delete on an array slice is not
    # but it is just what we need here.
    delete @lines[@top];
}

print grep defined, @lines;

__DATA__
file,tools,edit,syntax,buffers
a,b,c,perl,d
a,w,c33,java,d
a,e,c,perl,d
a,s,c,python,d1
a,n,c,php,d3
d,r,hhh,cpp,d0
d,m,hhh,c#,d0
a,o,c,pdf,d3
a,f,c,python,dd
a,h,c,perl,dg
a,yb,c,c,ddf
a,b,c,perl,dt
wa,b,c33,java,d
d,buuu,hhh,cpp,d0
d44,b,hhh,nlp,d0
a,be,c,js,d4
wa,b,c33,java,d
wa,b,c33,python,d
wa,b,c33,python,d
wa,b,c33,c#,d
wa,b,c33,python,d
wa,b,c33,php,d
wa,b,c33,python,d
wa,b,c33,php,d
wa,b,c33,python,d
wa,b,c33,perl,d
wa,b,c33,php,d
wa,b,c33,java,d
wa,b,c33,python,d

PS: See also Tie::File

PPS: At first sight, there are at least six things one might be inclined to tweak here if one wanted to spend time on it.