Re^12: Date Array Convolution

[BrowserUk]

real 3m21.523s ... real 1m24.273s

Nice, and subtle :)

Try this:

#! perl -slw
use strict;
use Data::Dump qw[ pp ];

sub dhm2int {
    my( $d, $h, $m ) = unpack '(A2)*', $_[0];
    return ( ( $d - 1 ) * 24 + $h ) * 60 + $m;
}

sub int2dhm {
    sprintf "%02d%02d%02d", int($_[0]/1440)+1, int($_[0]/60)%24, $_[0]
+%60;
}

my $tally = chr(255) x ( 31*24*60 );

while( <> ) {
    chomp;
    my( $sd, $ed, $v ) = split;
    my( $s, $e ) = map dhm2int( $_ ), $sd, $ed;
    while( int( $s / 1440 ) != int( $e / 1440 ) ) {
        my $newe = ( int( $s / 1440 ) +1 ) * 1440 -1;
        vec( $tally, $_, 8 ) > $v and vec( $tally, $_, 8 ) = $v
            for $s .. $newe;
        $s = $newe +1;
    }
    vec( $tally, $_, 8 ) > $v and vec( $tally, $_, 8 ) = $v
        for $s .. $e;
}

my @res;
my $i = 0;
while( $i < length( $tally ) ) {
    ++$i until vec( $tally, $i, 8 ) != 255;
    my $val = vec( $tally, $i, 8 );
    my $start = $i++;
    ++$i while $i % 1440 and vec( $tally, $i, 8 ) == $val;
    my $end = $i - 1;
    push @res, [ int2dhm( $start ), int2dhm( $end ), $val ];
}

pp \@res;

[choroba]

Same result, your time being now pretty comparable to mine: 1m43.735s. :-)

[BrowserUk]

This is just for grins, but a thought came to me over my morning tea. How does this fare?:

#! perl -slw
use strict;
use Data::Dump qw[ pp ];

sub dhm2int {
    my( $d, $h, $m ) = unpack '(A2)*', $_[0];
    return ( ( $d - 1 ) * 24 + $h ) * 60 + $m;
}

sub int2dhm {
    sprintf "%02d%02d%02d", int($_[0]/1440)+1, int($_[0]/60)%24, $_[0]
+%60;
}

my @data = sort{ $b->[2] <=> $a->[2] } map[ split ], <>;

my $tally = chr(255) x ( 31*24*60 );

for my $d ( @data ) {
    my $s = dhm2int( $d->[0] );
    my $e = dhm2int( $d->[1] );
    substr( $tally, $s, $e-$s+1, chr( $d->[2] ) x ( $e - $s + 1 ) );
}

my @res;
my $i = 0;
while( $i < length( $tally ) ) {
    ++$i until vec( $tally, $i, 8 ) != 255;
    my $val = vec( $tally, $i, 8 );
    my $start = $i++;
    ++$i while $i % 1440 and vec( $tally, $i, 8 ) == $val;
    my $end = $i - 1;
    push @res, [ int2dhm( $start ), int2dhm( $end ), $val ];
}

pp \@res;

[choroba]

Heh, less than 2 seconds. Sorting according to value - very clever!