in reply to Re^9: Date Array Convolution
in thread Date Array Convolution

Okay. Now we have the OPs clarification, the output from my code consolidating equal valued intervals is:

C:\test>935755 935755.dat
[
  ["010005", "010022", 41],
  ["010023", "012359", 0],
  ["020000", "022359", 0],
  ["030000", "032359", 0],
  ["040000", "042359", 0],
  ["050000", "052359", 0],
  ["060000", "062359", 0],
  ["070000", "072359", 0],
  ["080000", "082359", 0],
  ["090000", "092359", 0],
  [100000, 102359, 0],
  [110000, 112359, 0],
  [120000, 122359, 0],
  [130000, 132359, 0],
  [140000, 142359, 0],
  [150000, 152359, 0],
  [160000, 162359, 0],
  [170000, 172359, 0],
  [180000, 182359, 0],
  [190000, 192359, 0],
  [200000, 202359, 0],
  [210000, 212359, 0],
  [220000, 222359, 0],
  [230000, 232359, 0],
  [240000, 242359, 0],
  [250000, 252359, 0],
  [260000, 262359, 0],
  [270000, 272359, 0],
  [280000, 282359, 0],
  [290000, 292359, 0],
  [300000, 302359, 0],
  [310000, 312356, 0],
  [312357, 312359, 27],
]

[download]

Do you concur?

The (now simplified) code for this is:

#! 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 = (
#    ['010000','010010',2],['010200','010210',5],['012359','020001',3]
+,
#    ['010005','010015',1],['010207','010211',4]
#);

my @data = map[ split ], <>;

my @expd = map {
    my $in = $_;
    my $s = dhm2int( $in->[ 0 ] );
    my $e = dhm2int( $in->[ 1 ] );

    my @out;
    while( int( $s / 1440 ) != int( $e / 1440 ) ) {
        my $newe = ( int( $s / 1440 ) +1 ) * 1440 -1;
        push @out, [ $s, $newe, $in->[2] ];
        $s = $newe +1;
    }
    ( @out, [ $s, $e, $in->[2] ] );
} @data;

my( @tally );
for my $e ( 0 .. $#expd ) {
    my $r = $expd[ $e ];
    for my $i ( $r->[ 0 ] .. $r->[ 1 ] ) {
        if( !defined( $tally[ $i ] ) or $tally[ $i ] > $r->[ 2 ] ) {
            $tally[ $i ] = $r->[ 2 ];
        }
    }
}

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

pp \@res;

[download]
With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
"Science is about questioning the status quo. Questioning authority".
In the absence of evidence, opinion is indistinguishable from prejudice.

Replies are listed 'Best First'.
Re^11: Date Array Convolution
by choroba (Cardinal) on Nov 08, 2011 at 23:06 UTC
    Do you concur?
    $ time perl 935755-buk.perl 935755.dat > 935755-buk.o

real    3m21.523s
user    3m19.391s
sys     0m0.365s
$ time perl 935755.perl 935755.dat > 935755.o

real    1m24.273s
user    1m23.753s
sys     0m0.051s
$ diff 935755-buk.o 935755.o
35c35
< )
---
> )
\ No newline at end of file

    [download]
    Aye.
[reply]
[d/l]
      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;

      [download]
      With the rise and rise of 'Social' network sites: 'Computers are making people easier to use everyday'
      Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
      "Science is about questioning the status quo. Questioning authority".
      In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
        Same result, your time being now pretty comparable to mine: 1m43.735s. :-)
[reply]

In Section Seekers of Perl Wisdom