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;