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

Okay, that complicates things a little, but this seems to work:

#! 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; } sub adjacentPairs (&@) { my $code = shift; map { $code->( shift(), $_[0] ); } 1 .. @_; } #my @listone = # (['010000','010010',2],['010200','010210',5],['012359','020001',3 +]); #my @listtwo = # (['010005','010015',1],['010207','010211',4]); my @listone = (['010000','010110',6],['010200','010210',5],['012350','020012',3] +); my @listtwo = (['010005','010015',1],['010207','010211',4],['012355','020003',1] +); my @res = adjacentPairs{ defined( $_[1] ) ? do { $_[1][3] > $_[0][3] ? [ $_[0][0], int2dhm( $_[1][3] - 1 ), $_[0][2] ] : [ int2dhm( $_[1][4] + 1 ), $_[0][1], $_[0][2] ] } : [ @{ $_[0] }[ 0 .. 2 ] ] } sort { $a->[ 3 ] <=> $b->[ 3 ] || $b->[ 4 ] <=> $a->[ 4 ] } 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, [ int2dhm( $s ), int2dhm( $newe ), $in->[2], $s, $n +ewe ]; $s = $newe +1; } ( @out, [ int2dhm( $s ), $in->[1], $in->[2], $s, $e ] ); } @listone, @listtwo; pp \@res; __END__ c:\test>junk33 [ ["010000", "010004", 2], ["010005", "010015", 1], ["010200", "010206", 5], ["010207", "010211", 4], ["012359", "012359", 3], ["020000", "020001", 3], ] c:\test>junk33 [ ["010000", "010004", 6], ["010005", "010159", 1], ["010200", "010206", 5], ["010207", "012349", 4], ["012350", "012354", 3], ["012355", "012359", 1], ["020004", "020012", 3], ["020000", "020003", 1], ]

Note: The second set of results apply to the second (uncommented) set of data

One consequence is that the output is not longer in strictly sorted order. If this is a requirement a second sort will be required.


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^6: Date Array Convolution
by choroba (Cardinal) on Nov 04, 2011 at 13:03 UTC
    Where does this '010159' come from?
    0 110 200 210 2350 12 |-------------------| (6) |-----| (5) |------| (3) 5 15 207 211 2355 3 |----| (1) |----| (4) |----| (1)

      Good question!

      I was concentrating on the new requirement so much I didn't notice that I'd screwed the old one up!


      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.