File Coverage

blib/lib/Algorithm/TimelinePacking.pm

Criterion	Covered	Total	%
statement	47	47	100.0
branch	6	8	75.0
condition	7	9	77.7
subroutine	7	7	100.0
pod	1	1	100.0
total	68	72	94.4

package Algorithm::TimelinePacking;

use strict;
use warnings;

use Moo;
use Types::Standard qw(Int Maybe);
use POSIX qw(floor);
use List::Util qw(max shuffle);

our $VERSION = '0.01';

# minimum space (in units, i.e. most frequently pixels) between 2 consecutive
# items on a line
has space => (
    is      => 'rw',
    isa     => Int->where('$_ >= 0'),
    default => 0,
);

# convert all epochs to end at this maximum. undef means no constraint
has width => (
    is      => 'rw',
    isa     => Maybe[ Int->where('$_ >= 0') ],
    default => undef,
);

sub arrange_slices {
    my $self   = shift;
    my $slices = shift;

    # sort the slices by ascending start timestamp, i.e leftmost slice will be
    # on the highest line. Also make the whole series start at 0, not the
    # actual timestamp.
    @$slices = sort { $a->[0] <=> $b->[0] || $a->[1] <=> $b->[1] } @$slices;
    my $earliest = $slices->[0][0];
    @$slices = map { $_->[0] -= $earliest, $_->[1] -= $earliest; $_ } @$slices;
    my $latest = max map { $_->[1] } @$slices;

    if ($self->width && $latest > 0) {
        my $factor = $self->width / $latest;
        # rework the epochs so they fit within width
        for (@$slices) {
            $_->[0] = floor($_->[0] *= $factor);
            $_->[1] = floor($_->[1] *= $factor);
            $_->[1]++ if $_->[1] == $_->[0]; # no invisibles
        }
    }
    elsif ($self->width && $latest == 0) {
        # all slices are zero-duration points; give them minimum width
        $_->[1] = 1 for @$slices;
    }

    my $lines = [ [] ];

    # Track where each line ends. Initialize line 0 with a negative value
    # so the first slice always fits. Without this, if space=10 and first
    # slice starts at 0, the check (0 + 10 <= 0) would fail and create an
    # unnecessary extra line. The -space value makes (−10 + 10 <= 0) pass.
    my $ends = { 0 => -$self->space };

    # for every slice, try to put it in on the line that has the leftmost end
    while ( my $slice = shift @$slices ) {

        # find which line has the leftmost end that allows placement of our
        # slice (line must end before slice starts, with required spacing)
        my ($line_index) = grep { $ends->{$_} + $self->space <= $slice->[0] }
            sort { $ends->{$a} <=> $ends->{$b} } keys %$ends;

        # if no suitable line was found, create a new one
        $line_index //= $#$lines + 1;

        # add the slice to the right line, and update the end point for that
        # one
        push @{ $lines->[$line_index] }, $slice;
        $ends->{$line_index} = $slice->[1];
    }
    # randomizing the ordering gives a more balanced look
    @$lines = shuffle @$lines;
    return $lines, $latest;
}

1;

__END__