File Coverage

blib/lib/Music/Duration/Partition.pm

Criterion	Covered	Total	%
statement	90	97	92.7
branch	18	24	75.0
condition	3	5	60.0
subroutine	18	19	94.7
pod	3	3	100.0
total	132	148	89.1

package Music::Duration::Partition;
our $AUTHORITY = 'cpan:GENE';

# ABSTRACT: Partition a musical duration into rhythmic phrases

our $VERSION = '0.0823';

use Moo;
use strictures 2;
use List::Util qw(min);
use Math::Random::Discrete ();
use MIDI::Util qw(midi_dump reverse_dump);
use Music::Duration;
use namespace::clean;

use constant TICKS => 96;


has size => (
    is      => 'ro',
    default => sub { 4 },
);


has pool => (
    is      => 'ro',
    isa     => sub { die 'Empty pool not allowed' unless ref( $_[0] ) eq 'ARRAY' && @{ $_[0] } > 0 },
    default => sub { [ keys %{ midi_dump('length') } ] },
);

has _min_size => (
    is      => 'ro',
    builder => 1,
    lazy    => 1,
);

sub _build__min_size {
    my ($self) = @_;
    my @sizes = map { $self->_duration($_) } @{ $self->pool };
    return min(@sizes);
}

has _mrd => (
    is      => 'ro',
    builder => 1,
    lazy    => 1,
);

sub _build__mrd {
    my ($self) = @_;
    die 'Sizes of weights and pool not equal'
        unless @{ $self->weights } == @{ $self->pool };
    return Math::Random::Discrete->new($self->weights, $self->pool);
}


has pool_select => (
    is      => 'rw',
    builder => 1,
    lazy    => 1,
);

sub _build_pool_select {
    my ($self) = @_;
    return sub { $self->_mrd->rand };
};


has weights => (
    is      => 'ro',
    builder => 1,
    lazy    => 1,
);

sub _build_weights {
    my ($self) = @_;
    # Equal probability for all pool members
    return [ (1) x @{ $self->pool } ];
}


has groups => (
    is      => 'ro',
    builder => 1,
    lazy    => 1,
);

sub _build_groups {
    my ($self) = @_;
    return [ (0) x @{ $self->pool } ];
}

has _pool_group => (
    is      => 'ro',
    builder => 1,
    lazy    => 1,
);

sub _build__pool_group {
    my ($self) = @_;
    my %pool_group;
    for my $i (0 .. @{ $self->pool } - 1) {
        $pool_group{ $self->pool->[$i] } = $self->groups->[$i];
    }
    return \%pool_group;
}


has remainder => (
    is      => 'ro',
    default => sub { 1 },
);


has abbreviation => (
    is      => 'ro',
    default => sub { 1 },
);


has verbose => (
    is      => 'ro',
    default => sub { 0 },
);

# hash reference of duration lengths (keyed by duration name)
has _durations => (
    is      => 'ro',
    default => sub { midi_dump('length') },
);


sub motif {
    my ($self) = @_;

    my $motif = [];

    my $format = '%.4f';

    my $sum = 0;
    my $group_num = 0;
    my $group_name = '';

    while ( $sum < $self->size ) {
        my $name = $self->pool_select->($self); # Chooses a note duration

        # Compute grouping
        if ($group_num) {
            $group_num--;
            $name = $group_name;
        }
        else {
            if ($self->_pool_group->{$name}) {
                $group_num = $self->_pool_group->{$name} - 1;
                $group_name = $name;
            }
            else {
                $group_num = 0;
                $group_name = '';
            }
        }

        my $size = $self->_duration($name); # Get the duration of the note
        my $diff = $self->size - $sum; # How much is left?

        # The difference is less than the min_size
        if (sprintf( $format, $diff ) < sprintf( $format, $self->_min_size )) {
            warn "WARNING: Leftover duration: $diff\n"
                if $self->verbose;
            my $tick_diff = TICKS * $diff;
            my $dura = 'd' . sprintf('%.0f', $tick_diff);
            if ($self->abbreviation) {
                my $length = reverse_dump('length');
                my %length = map { TICKS * $_ => $length->{$_} } keys %$length;
                $dura = $length{$tick_diff}
                    if exists $length{$tick_diff};
            }
            push @$motif, $dura
                if $self->remainder && sprintf($format, $tick_diff) > 0;
            last;
        }

        # The note duration is greater than the difference
        next
            if sprintf( $format, $size ) > sprintf( $format, $diff );

        # Increment the sum by the note duration
        $sum += $size;

        warn(__PACKAGE__,' ',__LINE__," $name, $size, $sum\n")
            if $self->verbose;

        # Add the note to the motif if the sum is less than the total duration size
        push @$motif, $name
            if $sum <= $self->size;
    }

    return $motif;
}


sub motifs {
    my ($self, $n) = @_;
    $n ||= 1;
    my @motifs = map { $self->motif } 1 .. $n;
    return @motifs;
}


sub add_to_score {
    my ($self, $score, $motif, $pitches) = @_;
    for my $i (0 .. $#$motif) {
        $score->n($motif->[$i], $pitches->[$i]);
    }
}

sub _duration {
    my ( $self, $name ) = @_;

    my $dura;

    if ($name =~ /^d(\d+)$/) {
        $dura = $1;
    }
    else {
        $dura = $self->_durations->{$name};
    }

    return $dura;
}

1;

__END__