in reply to Date Array Convolution

Update: The code is wrong. Do not use it. I am trying to write a different one.

Probably not a clever approach. The border cases might need some tweaking.

#!/usr/bin/perl use Data::Dumper; use warnings; use strict; sub combine { my %result; while (my $triple = shift) { my ($left, $right, $value) = @$triple; if (not exists $result{$left}{R} or $result{$left}{R} > $value) { $result{$left}{R} = $value; } if (not exists $result{$right}{L} or $result{$right}{L} > $value) { $result{$right}{L} = $value; } } return \%result; } # combine sub dec { my $time = shift; my ($day, $hour, $min) = $time =~ /(..)(..)(..)/; $min--; if ($min < 0) { $min = 59; $hour--; if ($hour < 0) { $hour = 23; $day--; die if ($day < 0); } } return sprintf '%02d%02d%02d', $day, $hour, $min; } # dec sub tangle { my $combined = combine(@_); my @keys = sort keys %$combined; my $value; my @result; my $overlap; for my $i (0 .. $#keys) { if (defined $value) { my $new = $combined->{$keys[$i]}{R}; my $old = $combined->{$keys[$i]}{L}; die if defined $old and $old < $value; if (defined $new) { $overlap++; if ($new < $value) { push @{ $result[-1] }, dec($keys[$i]), $value; push @result, [$keys[$i]]; $value = $new; } } else { $overlap--; if (not $overlap) { push @{ $result[-1] }, $keys[$i], $value; undef $value; } else { my $next = $combined->{$keys[$i+1]}{L}; if ($next > $value) { push @{ $result[-1] }, dec($keys[$i]), $value; push @result, [$keys[$i]]; $value = $next; } } } } else { # not defined $value $value = $combined->{$keys[$i]}{R}; die unless defined $value; push @result, [$keys[$i]]; $overlap++; } } return @result; } # tangle sub daysplit { return map { my ($start, $end, $value) = @$_; my $from = 0 + substr $start, 0, 2; my $to = 0 + substr $end, 0, 2; if ($from < $to) { my $split; my $newfrom = sprintf('%02d', $from) . '2359'; $split = [[$start, $newfrom, $value]]; push @$split, map { [sprintf('%02d', $_) . '0000', sprintf('%02d', $_) . '2359', $value] } $from + 1 .. $to - 1; my $newto = sprintf('%02d', $to) . '0000'; push @$split, [$newto, $end, $value]; @$split; } else { $_; } } @_; } # daysplit my @listone = (['010000','010010',2],['010200','010210',5],['012359',' +020001',3]); my @listtwo = (['010005','010015',1],['010207','010211',4]); my @result = daysplit(tangle(@listone, @listtwo)); print Dumper \@result;

Replies are listed 'Best First'.
Re^2: Date Array Convolution
by alanonymous (Sexton) on Nov 04, 2011 at 00:30 UTC
    **Edited**
    1) Your code is awesome, but I understand very little of it.
    2) It works almost perfectly, except in the case of overlapping windows, the times are a little off and I can't figure out why.

    For example with the input:
    my @listone = (['010000','010110',6],['010200','010210',5],['012350',' +020012',3]); my @listtwo = (['010005','010015',1],['010207','010211',4],['012355',' +020003',1]);
    Do you mind adding some comments so I can figure out how you did that?

    Thanks!
      OK, here is the new code I wrote on the underground on my way to work :-) I used OO this time. The second case is your second example input, if your expected output is different, can you show it?
      Update: I read the discussion you had with BrowserUk and tried to accommodate the code appropriately.
      Update2: zero-intervals removed from output.
        You *Sir* are also a gentleman AND a scholar! I think the output is right, but I'm having trouble understanding exactly what's going on in your code. Like I mentioned to Mr. UK, you guys are awesome at coming up with solutions, but it's hard for newbies to understand it all! I *hate* taking code without understanding it :/
Re^2: Date Array Convolution
by alanonymous (Sexton) on Nov 03, 2011 at 22:36 UTC
    I think I finally found a way to break the days apart that's a little different than yours:
    @combined = sort {$a->[0] <=> $b->[0]} (@listone,@listtwo); for ($i=0; $i<scalar(@combined); $i++) { if (substr($combined[$i][0],0,2) != substr($combined[$i][1],0,2)) + { splice(@combined,$i+1,0,[substr($combined[$i][1],0,2)."0000" +,$combined[$i][1],$combined[$i][2]]); $combined[$i][1] = substr($combined[$i][0],0,2)."2359"; } }
    I don't really understand though what you did for the day overlap piece. Do you mind adding comments or explaining the chunks? I'm still kinda new to perl :/

    Thanks for the help!
      Your code works only if the day difference is one. My code should work for two, three and more days.
        I completely agree with you that your code is much better than mine! The problem is that I made mine before I saw your post, and also, I'm new enough with perl that I don't really understand everything that's going on in yours. Do you mind adding some comments for the newbie? Thank you for the help!