Efficient code to do a countif, ranking on huge csv file - csv

Question

need help to accelerate the run of below perl code. 4 to 6hours should be fine. faster is better :)
csv file is about 14m to 14.5m rows, and aorund 1100 to 1500columns; 62gig
what it does:
do a count (like a countif in excel)
get the percent (based on 14m rows)
get the rank based on count
My current code:
use List::MoreUtils qw(uniq);
$x="Room_reserve";
$in = "D:\\package properties\\${x}.csv";
$out = "D:\\package properties\\output\\${x}_output.csv";
open($fh, '<', $in) or die "Could not open file '$file' $!";
#data = <$fh>;
close($fh);
%counts;
#columns;
$first = 1;
#counter
foreach $dat (#data) {
chomp($dat);
#rows = split(',',$dat);
if ($first == 1) {
$first = 0;
next;
}
else {
$count = 1;
foreach $i (0..$#rows) {
if ( exists($columns[$i]{$rows[$i]}) ) {
$columns[$i]{$rows[$i]}++;
}
else {
$columns[$i]{$rows[$i]} = int($count);
}
}
}
}
#output
$first = 1;
open($fh, '>', $out) or die "Could not open file '$file' $!";
foreach $dat (#data) {
chomp($dat);
#rows = split(',',$dat);
foreach $i (0..$#rows) {
if ($i > 6) {
#for modifying name
if ( $first == 1 ) {
$line = join( ",", "Rank_$rows[$i]", "Percent_$rows[$i]",
"Count_$rows[$i]", $rows[$i]);
print $fh "$line,";
if ( $i == $#rows ) {
$first = 0;
}
}
else {
#dat_val = reverse sort { $a <=> $b } values %{$columns[$i]};
%ranks = {};
$rank_cnt = 0;
foreach $val (#dat_val) {
if ( ! exists($ranks{$val}) ) {
$rank_cnt++;
}
$ranks{$val} = $rank_cnt;
}
$rank = $ranks{$columns[$i]{$rows[$i]}};
$cnt = $columns[$i]{$rows[$i]};
$ave = ($cnt / 14000000) * 100;
$line = join( ",", $rank, $ave, $cnt, $rows[$i]);
print $fh "$line,";
}
}
else {
print $fh "$rows[$i],";
}
}
print $fh "\n";
}
close($fh);
thanks in advance.
my table
Col
_1
_2
_3
_4
_5
_6
Col2
Col3
Col
Col5
FALSE
1
2
3
4
5
6
6
6
1
4
FALSE
1
2
3
4
5
6
6
6
1
4
FALSE
1
2
3
4
5
7
6
6
1
3
edited to show sample table and correct $x
##Sample output
Col
_1
_2
_3
_4
_5
_6
Col2
rank_Col2
percent_rank_Col2
count_Col2
Col3
rank_Col3
percent_rank_Col3
count_Col3
Col
rank_Col
percent_rank_Col
count_Col
Col5
rank_Col5
percent_rank_Col5
count_Col5
FALSE
1
2
3
4
5
6
9
2
0.33
1
6
1
0.67
2
1
1
0.67
2
11
1
0.33
1
FALSE
1
2
3
4
5
6
6
1
0.67
2
6
1
0.67
2
2
2
0.33
1
4
1
0.33
1
FALSE
1
2
3
4
5
7
6
1
0.67
2
4
2
0.33
1
1
1
0.67
2
3
1
0.33
1

Answer 1

Presume you have this file:
% ls -lh file
-rw-r--r-- 1 dawg wheel 57G Jul 24 13:15 file
% time wc -l file
14000000 file
wc -l file 29.24s user 7.27s system 99% cpu 36.508 total
% awk -F, 'FNR==1{print $NF; exit}' file
1099
So we have a 57GB file with 14,000,000 line by 1099 col csv with random numbers.
It only takes 20 to 30 SECONDS to read the entire file in a line-by-line fashion.
How long in Perl?
% time perl -lnE '' file
perl -lnE '' file 5.70s user 9.67s system 99% cpu 15.381 total
So only 15 seconds in Perl line by line. How long to 'gulp' it?
% time perl -0777 -lnE '' file
perl -0777 -lnE '' file 12.13s user 23.86s system 98% cpu 36.688 total
But that is on THIS computer which has 255GB of RAM...
It took this Python script approximately 23 minutes to write that file:
total=0
cols=1100
with open('/tmp/file', 'w') as f_out:
for cnt in range(14_000_000):
line=','.join(f'{x}' for x in range(cols))
total+=cols
f_out.write(f'{cnt},{total},{line}\n')
The issue with your Perl script is you are gulping the whole file (with #data = <$fh>;) and the OS maybe is running out of RAM. It is likely swapping and this is very slow. (How much RAM do you have?)
Rewrite the script to do it line by line. You should be able to do your entire analysis in less than 1 hour.

Answer 2

Can you try the following script? It precomputes the ranks instead of recalculating them for each row. It also avoids saving the first 7 columns in #columns since they appear not to be used for anything.
use feature qw(say);
use strict;
use warnings;
{
my $x="Room_reserve";
my $in = "D:\\package properties\\${x}.csv";
my $out = "D:\\package properties\\output\\${x}_output.csv";
my $min_col = 7;
my ($data1, $data2) = read_input_file($in, $min_col);
my $columns = create_counter($data2);
my $ranks = create_ranks( $columns);
write_output($data1, $data2, $columns, $ranks, $min_col, $out);
}
sub create_counter {
my ($data) = #_;
print "Creating counter..";
my #columns;
my $first = 1;
for my $row (#$data) {
if ( $first ) {
$first = 0; next; # skip header
}
for my $i (0..$#$row) {
$columns[$i]{$row->[$i]}++;
}
}
say "done.";
return \#columns;
}
sub create_ranks {
my ( $columns ) = #_;
print "Creating ranks..";
my #ranks;
for my $col (#$columns) {
# sort the column values according to highest frequency.
my #freqs = sort { $b <=> $a } values %$col;
my $idx = 1;
my %ranks = map {$_ => $idx++} #freqs;
push #ranks, \%ranks;
}
say "done.";
return \#ranks;
}
sub read_input_file {
my ($in, $min_col) = #_;
print "Reading input file $in ..";
open(my $fh, '<', $in) or die "Could not open file '$in' $!";
my #data1;
my #data2;
while( my $line = <$fh> ) {
chomp $line;
my #fields = split(',', $line);
next if #fields == 0;
die "Unexpected column count at line $.\n" if #fields < $min_col;
push #data1, [#fields[0..($min_col-1)]];
push #data2, [#fields[$min_col..$#fields]];
}
say " $. lines.";
close($fh);
return \#data1, \#data2;
}
sub write_output {
my ($data1, $data2, $columns, $ranks, $min_col, $out) = #_;
say "Saving output file $out..";
open(my $fh, '>', $out) or die "Could not open file '$out': $!";
for my $i (0..$#$data1) {
my $row1 = $data1->[$i];
my $row2 = $data2->[$i];
if ($i == 0) {
print $fh join ",", #$row1;
print $fh ",";
for my $j (0..$#$row2) {
print $fh join ",", $row2->[$j],
"Rank_" . $row2->[$j],
"Percent_". $row2->[$j],
"Count_" . $row2->[$j];
print $fh "," if $j < $#$row2;
}
print $fh "\n";
next;
}
print $fh join ",", #$row1;
print $fh ",";
for my $j (0..$#$row2) {
my $cnt = $columns->[$j]{$row2->[$j]};
my $rank = $ranks->[$j]{$cnt};
my $ave = ($cnt / 14000000) * 100;
print $fh join ",", $row2->[$j], $rank, $ave, $cnt;
print $fh "," if $j < $#$row2;
}
print $fh "\n";
}
close $fh;
say "Done.";
}