Re: Markov Diddly

++benn. Now here is my adaptation that uses MIDI::Simple for creating a MIDI of it ;)

#!/usr/bin/perl

###########################################
# Variable Length Markov Diddly. 
###########################################

use strict;
use constant LENGTH => 4;                            # length of patte
+rn key
use MIDI::Simple;
my %duration = (
  2 => 'qn',
  4 => 'hn',
  8 => 'wn',
  12 => 'dwn',
);

new_score;
set_tempo 500000;  # 1 qn => .5 seconds (500,000 microseconds)
patch_change 1, 77;  # Patch 76 = recorder, 77 = pan flute, 80 = whist
+le, 81 = Ocarina

noop "c1", "fff", "o3";  # Setup

my %probs;                                            # probabilities 
+of next note

while (<DATA>) {                                    # read the existin
+g tunes...
    chomp;
    my @line = split /,/;
    my @notes = ("START") x (LENGTH);                # cyclic buffer
    while (@line) {
        shift (@notes);
        push @notes, shift(@line).",".shift(@line); # "note,length"
        $probs{key(@notes)}{$notes[$#notes]}++;
    }
    shift (@notes);
    $probs{key(@notes)}{"END"}++;
}

my @notes = ("START") x LENGTH;
do {
    shift(@notes);
    my %next = %{$probs{key(@notes)}};                # array of probs
    my @next = map {($_) x $next{$_}} keys %next;    # 1 entry per 'pr
+ob'
    push @notes, $next[int(rand(@next))];
    my ($note, $dur);
    unless ($notes[$#notes] eq "END") {
    print "$notes[$#notes] ";
      ($note, $dur) = split',',$notes[$#notes];
      ++$note; # increment once
      $note = uc(++$note); # increment again and then upcase it!
      $note = $MIDI::note2number{$note};
    eval(n $duration{$dur}, $note);
    }
    
} while ($notes[$#notes] ne "END");


write_score 'markov-diddly.mid';

 
sub key {return join("",@_[0..LENGTH-2]);}            # make space-sep
+arated key

# a bunch of common session tunes (plus one of mine <g>)
 
__DATA__
e2,4,e2,2,b2,2,e2,2,b2,2,e2,2,e2,2,b2,2,a2,2,fs2,2,d2,2,e2,4,e2,2,b2,4
+,cs3,2,d3,2,cs3,2,b2,2,a2,2,fs2,2,d2,2,e2,4,e2,2,b2,2,e2,2,b2,2,e2,2,
+e2,2,b2,2,a2,2,fs2,2,d2,2,g2,4,g2,2,fs2,2,g2,2,a2,2,b2,2,a2,2,g2,2,fs
+2,2,e2,2,d2,2
d2,2,g2,2,g2,2,b2,2,g2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,g2,2,e3,2,g3,2,
+e3,2,d3,2,b2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,e2,2,d2,2,g2,2,g2,2,b2,2
+,g2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,g2,2,e3,2,g3,2,e3,2,d3,2,b2,2,g2,
+2,a2,2,g2,2,fs2,2,g2,6
d2,4,d2,2,a2,6,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,d2,4,d2,2,a2,6,b2,2,a2,2,
+g2,2,e2,2,g2,2,e2,2,d2,4,d2,2,a2,6,b2,2,a2,2,g2,2,a2,2,b2,2,c3,2,d2,2
+,c3,2,b2,2,c3,2,b2,2,a2,2,b2,2,a2,2,g2,2,e2,2,g2,2,e2,2
d3,2,e3,2,d3,2,b2,4,g2,2,a2,4,g2,2,e2,4,d2,2,g2,4,g2,2,g2,2,a2,2,b2,2,
+d3,4,b2,2,a2,6,d3,2,e3,2,d3,2,b2,4,g3,2,fs2,4,e3,2,c3,4,e3,2,d3,2,e3,
+2,d3,2,c3,2,b2,2,a2,2,g2,12
b2,2,g2,2,g2,2,d2,2,g2,2,g2,2,b2,2,g2,2,b2,2,d3,2,c3,2,b2,2,c3,2,a2,2,
+a2,2,fs2,2,a2,2,a2,2,c3,2,a2,2,c3,2,e3,2,d3,2,c3,2,b2,2,g2,2,g2,2,d2,
+2,g2,2,g2,2,b2,2,g2,2,b2,2,d3,2,c3,2,b2,2,c3,2,b2,2,c3,2,a2,2,d3,2,c3
+,2,b2,2,g2,2,g2,2,g2,2,d3,2,c3,2
fs2,4,b2,2,b2,2,cs3,2,d3,2,cs3,4,a2,2,a2,2,b2,2,cs3,2,d3,4,b2,2,b2,2,c
+s3,2,d3,2,e3,2,fs3,2,e3,2,d3,2,cs3,2,b2,2,fs2,4,b2,2,b2,2,cs3,2,d3,2,
+cs3,4,a2,2,a2,2,b2,2,cs3,2,d3,2,cs3,2,d3,2,e3,2,d3,2,e3,2,fs3,2,b2,2,
+b2,2,b2,6
a2,2,fs2,2,a2,2,a2,2,fs2,2,a2,2,b2,2,g2,2,b2,2,b2,2,g2,2,b2,2,a2,2,fs2
+,2,a2,2,a2,2,d3,2,e3,2,fs3,2,e3,2,d3,3,b2,2,d3,2,b2,2,a2,2,fs2,2,a2,2
+,a2,2,fs2,2,a2,2,b2,2,g2,2,b2,2,b2,2,g2,2,b2,2,d3,2,e3,2,fs3,2,a3,2,f
+s3,2,e3,2,fs3,2,b2,2,b2,3,b2,2,d3,2,b2,2
a2,2,d2,2,d2,2,b2,2,d2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,
+g2,2,fs2,2,g2,2,fs2,2,g2,2,e2,2,fs2,2,g2,2,a2,2,d2,2,d2,2,b2,2,d2,2,d
+2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,g2,2,fs2,2,g2,12
e2,2,fs2,2,e2,2,b2,4,b2,2,b2,2,a2,2,fs2,2,d3,6,e2,2,fs2,2,e2,2,b2,4,b2
+,2,b2,2,a2,2,fs2,2,fs2,4,e2,2,e2,2,fs2,2,e2,2,b2,4,b2,2,b2,2,a2,2,fs2
+,2,d3,6,b2,2,cs3,2,d3,2,e3,4,b2,2,b2,2,a2,2,fs2,2,fs2,4,e2,2
d2,4,a2,2,fs2,4,a2,2,d2,4,a2,2,fs2,4,a2,2,d3,4,e3,2,fs3,4,e3,2,d3,4,cs
+3,2,b2,4,a2,2,e3,6,fs3,6,g3,6,fs3,6,e3,4,d3,2,cs3,4,b2,2,a2,2,b2,2,a2
+,2,g2,2,fs2,2,e2,2
d2,4,e2,2,fs2,4,g2,2,a2,4,b2,2,a2,4,fs2,2,a2,4,b2,2,a2,4,fs2,2,a2,4,b2
+,2,a2,4,fs2,2,d2,4,e2,2,fs2,4,g2,2,a2,4,b2,2,a2,4,d3,2,cs3,4,b2,2,a2,
+4,fs2,2,d2,12
g2,2,g2,2,g2,2,g2,6,g2,2,g2,2,g2,2,g2,4,d3,2,b2,4,g2,2,b2,4,d3,2,g3,4,
+d3,2,b2,4,g2,2,d2,2,d2,2,d2,2,d2,6,d2,2,d2,2,d2,2,d2,4,a2,2,fs2,4,d2,
+2,fs2,4,a2,2,c3,4,a2,2,fs2,4,d2,2
a2,6,a2,6,a2,2,fs2,2,d3,2,a2,2,fs2,2,d2,2,g2,6,g2,6,g2,2,e2,2,fs2,2,g3
+,2,fs2,2,e2,2,a2,6,a2,6,a2,2,fs2,2,d3,2,a2,2,fs2,2,d2,2,e2,2,fs2,2,g2
+,2,fs2,2,g2,2,e2,2,d2,12
a2,2,d2,2,d2,2,b2,2,d2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,
+g2,2,fs2,2,g2,2,fs2,2,g2,2,e2,2,fs2,2,g2,2,a2,2,d2,2,d2,2,b2,2,d2,2,d
+2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,g2,2,fs2,2,g2,12
[download]

Comment on Re: Markov Diddly Download Code

Replies are listed 'Best First'.
Re: Re: Markov Diddly by benn (Vicar) on Apr 10, 2003 at 16:45 UTC
Coo - ++Mr. Muskrat - flattered by the fact that somebody cares, I thought I'd better make it a bit more useful :) Here's an OO version that allows you to mix-and-match 'diddly-streams' - the example code at the bottom tells the whole story. I've also fixed a couple of typos in the tune data. package MarkovDiddly; use strict; ########################################### # Variable Length Markov Diddly Stream ########################################### my @tunes = (# a bunch of common tunes "e2,4,e2,2,b2,2,e2,2,b2,2,e2,2,e2,2,b2,2,a2,2,fs2,2,d2,2,e2,4,e2,2 +,b2,4,cs3,2,d3,2,cs3,2,b2,2,a2,2,fs2,2,d2,2,e2,4,e2,2,b2,2,e2,2,b2,2, +e2,2,e2,2,b2,2,a2,2,fs2,2,d2,2,g2,4,g2,2,fs2,2,g2,2,a2,2,b2,2,a2,2,g2 +,2,fs2,2,e2,2,d2,2", "d2,2,g2,2,g2,2,b2,2,g2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,g2,2,e3,2, +g3,2,e3,2,d3,2,b2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,e2,2,d2,2,g2,2,g2,2 +,b2,2,g2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,g2,2,e3,2,g3,2,e3,2,d3,2,b2, +2,g2,2,a2,2,g2,2,fs2,2,g2,6", "d2,4,d2,2,a2,6,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,d2,4,d2,2,a2,6,b2,2, +a2,2,g2,2,e2,2,g2,2,e2,2,d2,4,d2,2,a2,6,b2,2,a2,2,g2,2,a2,2,b2,2,c3,2 +,d2,2,c3,2,b2,2,c3,2,b2,2,a2,2,b2,2,a2,2,g2,2,e2,2,g2,2,e2,2", "d3,2,e3,2,d3,2,b2,4,g2,2,a2,4,g2,2,e2,4,d2,2,g2,4,g2,2,g2,2,a2,2, +b2,2,d3,4,b2,2,a2,6,d3,2,e3,2,d3,2,b2,4,g3,2,fs2,4,e3,2,c3,4,e3,2,d3, +2,e3,2,d3,2,c3,2,b2,2,a2,2,g2,12", "b2,2,g2,2,g2,2,d2,2,g2,2,g2,2,b2,2,g2,2,b2,2,d3,2,c3,2,b2,2,c3,2, +a2,2,a2,2,fs2,2,a2,2,a2,2,c3,2,a2,2,c3,2,e3,2,d3,2,c3,2,b2,2,g2,2,g2, +2,d2,2,g2,2,g2,2,b2,2,g2,2,b2,2,d3,2,c3,2,b2,2,c3,2,b2,2,c3,2,a2,2,d3 +,2,c3,2,b2,2,g2,2,g2,2,g2,2,d3,2,c3,2", "fs2,4,b2,2,b2,2,cs3,2,d3,2,cs3,4,a2,2,a2,2,b2,2,cs3,2,d3,4,b2,2,b +2,2,cs3,2,d3,2,e3,2,fs3,2,e3,2,d3,2,cs3,2,b2,2,fs2,4,b2,2,b2,2,cs3,2, +d3,2,cs3,4,a2,2,a2,2,b2,2,cs3,2,d3,2,cs3,2,d3,2,e3,2,d3,2,e3,2,fs3,2, +b2,2,b2,2,b2,6", "a2,2,fs2,2,a2,2,a2,2,fs2,2,a2,2,b2,2,g2,2,b2,2,b2,2,g2,2,b2,2,a2, +2,fs2,2,a2,2,a2,2,d3,2,e3,2,fs3,2,e3,2,d3,2,b2,2,d3,2,b2,2,a2,2,fs2,2 +,a2,2,a2,2,fs2,2,a2,2,b2,2,g2,2,b2,2,b2,2,g2,2,b2,2,d3,2,e3,2,fs3,2,a +3,2,fs3,2,e3,2,fs3,2,b2,2,b2,2,b2,2,d3,2,b2,2", "a2,2,d2,2,d2,2,b2,2,d2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2, +a2,2,g2,2,fs2,2,g2,2,fs2,2,g2,2,e2,2,fs2,2,g2,2,a2,2,d2,2,d2,2,b2,2,d +2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,g2,2,fs2,2,g2,12", "e2,2,fs2,2,e2,2,b2,4,b2,2,b2,2,a2,2,fs2,2,d3,6,e2,2,fs2,2,e2,2,b2 +,4,b2,2,b2,2,a2,2,fs2,2,fs2,4,e2,2,e2,2,fs2,2,e2,2,b2,4,b2,2,b2,2,a2, +2,fs2,2,d3,6,b2,2,cs3,2,d3,2,e3,4,b2,2,b2,2,a2,2,fs2,2,fs2,4,e2,2", "d2,4,a2,2,fs2,4,a2,2,d2,4,a2,2,fs2,4,a2,2,d3,4,e3,2,fs3,4,e3,2,d3 +,4,cs3,2,b2,4,a2,2,e3,6,fs3,6,g3,6,fs3,6,e3,4,d3,2,cs3,4,b2,2,a2,2,b2 +,2,a2,2,g2,2,fs2,2,e2,2", "d2,4,e2,2,fs2,4,g2,2,a2,4,b2,2,a2,4,fs2,2,a2,4,b2,2,a2,4,fs2,2,a2 +,4,b2,2,a2,4,fs2,2,d2,4,e2,2,fs2,4,g2,2,a2,4,b2,2,a2,4,d3,2,cs3,4,b2, +2,a2,4,fs2,2,d2,12", "g2,2,g2,2,g2,2,g2,6,g2,2,g2,2,g2,2,g2,4,d3,2,b2,4,g2,2,b2,4,d3,2, +g3,4,d3,2,b2,4,g2,2,d2,2,d2,2,d2,2,d2,6,d2,2,d2,2,d2,2,d2,4,a2,2,fs2, +4,d2,2,fs2,4,a2,2,c3,4,a2,2,fs2,4,d2,2", "a2,6,a2,6,a2,2,fs2,2,d3,2,a2,2,fs2,2,d2,2,g2,6,g2,6,g2,2,e2,2,fs2 +,2,g3,2,fs2,2,e2,2,a2,6,a2,6,a2,2,fs2,2,d3,2,a2,2,fs2,2,d2,2,e2,2,fs2 +,2,g2,2,fs2,2,g2,2,e2,2,d2,12", "a2,2,d2,2,d2,2,b2,2,d2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2, +a2,2,g2,2,fs2,2,g2,2,fs2,2,g2,2,e2,2,fs2,2,g2,2,a2,2,d2,2,d2,2,b2,2,d +2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,g2,2,fs2,2,g2,12", ); sub new { my $class = shift(); my $length = shift() \|\| 4; # a good ave +rage my %self = ('length'=>$length); foreach (@tunes) { # read the e +xisting tunes... chomp; my @line = split /,/; my @notes = ("START") x $length; # cyclic buffe +r of notes my @pitches = ("START") x $length; # cyclic buf +fer of pitches my @durs = ("START") x $length; # cyclic bu +ffer of durations while (@line) { shift (@notes);shift (@pitches);shift (@durs); my ($pitch,$dur) = (shift(@line),shift(@line)); push @notes, "$pitch,$dur"; push @pitches,$pitch; push @durs,$dur; $self{notes}{key($length,@notes)}{$notes[$#notes]}++; $self{pitches}{key($length,@pitches)}{$pitches[$#pitches]} +++; $self{durs}{key($length,@durs)}{$durs[$#durs]}++; } shift (@notes);shift (@pitches);shift (@durs); $self{notes}{key($length,@notes)}{"END"}++; $self{pitches}{key($length,@pitches)}{"END"}++; $self{durs}{key($length,@durs)}{"END"}++; } $self{nbuffer} = [("START") x $length]; $self{pbuffer} = [("START") x $length]; $self{dbuffer} = [("START") x $length]; bless \%self,$class; } # get a full sequence to end sub sequence { my ($self,$buffer,$probs) = @_; my @seq; do {push @seq,$self->get_next(1,$buffer,$probs);} while ($seq[$#se +q] ne "END"); $self->set_buffer($buffer); pop @seq; #remove 'END' tag @seq; } sub get_tune { sequence(shift(),"nbuffer","notes");} sub get_pitches { sequence(shift(),"pbuffer","pitches");} sub get_durations { sequence(shift(),"dbuffer","durs");} # receive a buffer & a bunch of probabilities, # return an item (and rotate the buffer) # only allow possibility of 'END' token if requested sub get_next { my ($self,$end,$buffer,$probs) = @_; $self->set_buffer($buffer) unless (@{$self->{$buffer}}); my @buffer = @{$self->{$buffer}}; shift(@buffer); my %next = %{$self->{$probs}{key($self->{length},@buffer)}}; + my @next = map {($_) x $next{$_}} keys %next; # 1 entry per 'pr +ob' my $n = $next[int(rand(@next))]; unless ($end) { unless (grep {$_ ne "END"} @next) { # only 1 option left, $self->set_buffer($buffer); # so go to beginnin +g return $self->get_next($end,$buffer,$probs); } while ($n eq 'END') {$n = $next[int(rand(@next))]}; } push @buffer, $n; $self->set_buffer($buffer,@buffer); return $buffer[$#buffer]; } # 'stream' functions - get_next_xxx(allow_end_token) sub get_next_note {get_next(shift(),shift(),"nbuffer","notes");} sub get_next_pitch {get_next(shift(),shift(),"pbuffer","pitches");} sub get_next_duration {get_next(shift(),shift(),"dbuffer","durs");} # set the intitial states sub set_notes {set_buffer(shift,"nbuffer",@_);} sub set_pitches {set_buffer(shift,"pbuffer",@_);} sub set_durations {set_buffer(shift,"dbuffer",@_);} sub set_buffer { my ($self,$buffer,@buffer) = @_; shift(@buffer) while (@buffer > $self->{length}); unshift(@buffer,"START") while (@buffer < $self->{length}); $self->{$buffer} = \@buffer; } sub key {my $l=shift();my @arr = @_;return join(" ",@arr[0..$l - 2]);} + 1; [download] later... package main; use strict; use MarkovDiddly; my $t6 = MarkovDiddly->new(6); # will closely an resemble e +xisting tune print "tune (6): ",join(" ",$t6->get_tune()),"\n\n"; print "pitches (6): ",join(" ",$t6->get_pitches()),"\n\n"; print "durations (6): ",join(" ",$t6->get_durations()),"\n\n"; my $t2 = MarkovDiddly->new(2); # will be more random print "tune (2): ",join(" ",$t2->get_tune()),"\n\n"; # grab a load of predictable notes with more random durations $t6->set_pitches(qw(d2 g2 g2 b2 g2 g2)); my @tune = map {$t6->get_next_pitch().",".$t2->get_next_duration()." " +} (0..30); print "mixture (6/2): ",join(",",@tune),"\n"; exit; [download] Cheers, Ben	[reply] [d/l] [select]

Replies are listed 'Best First'.

Re: Re: Markov Diddly
by benn (Vicar) on Apr 10, 2003 at 16:45 UTC

Mr. Muskrat

package MarkovDiddly;

use strict;

###########################################
# Variable Length Markov Diddly Stream
###########################################

my @tunes = (# a bunch of common tunes
    "e2,4,e2,2,b2,2,e2,2,b2,2,e2,2,e2,2,b2,2,a2,2,fs2,2,d2,2,e2,4,e2,2
+,b2,4,cs3,2,d3,2,cs3,2,b2,2,a2,2,fs2,2,d2,2,e2,4,e2,2,b2,2,e2,2,b2,2,
+e2,2,e2,2,b2,2,a2,2,fs2,2,d2,2,g2,4,g2,2,fs2,2,g2,2,a2,2,b2,2,a2,2,g2
+,2,fs2,2,e2,2,d2,2",
    "d2,2,g2,2,g2,2,b2,2,g2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,g2,2,e3,2,
+g3,2,e3,2,d3,2,b2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,e2,2,d2,2,g2,2,g2,2
+,b2,2,g2,2,g2,2,a2,2,g2,2,a2,2,b2,2,g2,2,g2,2,e3,2,g3,2,e3,2,d3,2,b2,
+2,g2,2,a2,2,g2,2,fs2,2,g2,6",
    "d2,4,d2,2,a2,6,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,d2,4,d2,2,a2,6,b2,2,
+a2,2,g2,2,e2,2,g2,2,e2,2,d2,4,d2,2,a2,6,b2,2,a2,2,g2,2,a2,2,b2,2,c3,2
+,d2,2,c3,2,b2,2,c3,2,b2,2,a2,2,b2,2,a2,2,g2,2,e2,2,g2,2,e2,2",
    "d3,2,e3,2,d3,2,b2,4,g2,2,a2,4,g2,2,e2,4,d2,2,g2,4,g2,2,g2,2,a2,2,
+b2,2,d3,4,b2,2,a2,6,d3,2,e3,2,d3,2,b2,4,g3,2,fs2,4,e3,2,c3,4,e3,2,d3,
+2,e3,2,d3,2,c3,2,b2,2,a2,2,g2,12",
    "b2,2,g2,2,g2,2,d2,2,g2,2,g2,2,b2,2,g2,2,b2,2,d3,2,c3,2,b2,2,c3,2,
+a2,2,a2,2,fs2,2,a2,2,a2,2,c3,2,a2,2,c3,2,e3,2,d3,2,c3,2,b2,2,g2,2,g2,
+2,d2,2,g2,2,g2,2,b2,2,g2,2,b2,2,d3,2,c3,2,b2,2,c3,2,b2,2,c3,2,a2,2,d3
+,2,c3,2,b2,2,g2,2,g2,2,g2,2,d3,2,c3,2",
    "fs2,4,b2,2,b2,2,cs3,2,d3,2,cs3,4,a2,2,a2,2,b2,2,cs3,2,d3,4,b2,2,b
+2,2,cs3,2,d3,2,e3,2,fs3,2,e3,2,d3,2,cs3,2,b2,2,fs2,4,b2,2,b2,2,cs3,2,
+d3,2,cs3,4,a2,2,a2,2,b2,2,cs3,2,d3,2,cs3,2,d3,2,e3,2,d3,2,e3,2,fs3,2,
+b2,2,b2,2,b2,6",
    "a2,2,fs2,2,a2,2,a2,2,fs2,2,a2,2,b2,2,g2,2,b2,2,b2,2,g2,2,b2,2,a2,
+2,fs2,2,a2,2,a2,2,d3,2,e3,2,fs3,2,e3,2,d3,2,b2,2,d3,2,b2,2,a2,2,fs2,2
+,a2,2,a2,2,fs2,2,a2,2,b2,2,g2,2,b2,2,b2,2,g2,2,b2,2,d3,2,e3,2,fs3,2,a
+3,2,fs3,2,e3,2,fs3,2,b2,2,b2,2,b2,2,d3,2,b2,2",
    "a2,2,d2,2,d2,2,b2,2,d2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,
+a2,2,g2,2,fs2,2,g2,2,fs2,2,g2,2,e2,2,fs2,2,g2,2,a2,2,d2,2,d2,2,b2,2,d
+2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,g2,2,fs2,2,g2,12",
    "e2,2,fs2,2,e2,2,b2,4,b2,2,b2,2,a2,2,fs2,2,d3,6,e2,2,fs2,2,e2,2,b2
+,4,b2,2,b2,2,a2,2,fs2,2,fs2,4,e2,2,e2,2,fs2,2,e2,2,b2,4,b2,2,b2,2,a2,
+2,fs2,2,d3,6,b2,2,cs3,2,d3,2,e3,4,b2,2,b2,2,a2,2,fs2,2,fs2,4,e2,2",
    "d2,4,a2,2,fs2,4,a2,2,d2,4,a2,2,fs2,4,a2,2,d3,4,e3,2,fs3,4,e3,2,d3
+,4,cs3,2,b2,4,a2,2,e3,6,fs3,6,g3,6,fs3,6,e3,4,d3,2,cs3,4,b2,2,a2,2,b2
+,2,a2,2,g2,2,fs2,2,e2,2",
    "d2,4,e2,2,fs2,4,g2,2,a2,4,b2,2,a2,4,fs2,2,a2,4,b2,2,a2,4,fs2,2,a2
+,4,b2,2,a2,4,fs2,2,d2,4,e2,2,fs2,4,g2,2,a2,4,b2,2,a2,4,d3,2,cs3,4,b2,
+2,a2,4,fs2,2,d2,12",
    "g2,2,g2,2,g2,2,g2,6,g2,2,g2,2,g2,2,g2,4,d3,2,b2,4,g2,2,b2,4,d3,2,
+g3,4,d3,2,b2,4,g2,2,d2,2,d2,2,d2,2,d2,6,d2,2,d2,2,d2,2,d2,4,a2,2,fs2,
+4,d2,2,fs2,4,a2,2,c3,4,a2,2,fs2,4,d2,2",
    "a2,6,a2,6,a2,2,fs2,2,d3,2,a2,2,fs2,2,d2,2,g2,6,g2,6,g2,2,e2,2,fs2
+,2,g3,2,fs2,2,e2,2,a2,6,a2,6,a2,2,fs2,2,d3,2,a2,2,fs2,2,d2,2,e2,2,fs2
+,2,g2,2,fs2,2,g2,2,e2,2,d2,12",
    "a2,2,d2,2,d2,2,b2,2,d2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,
+a2,2,g2,2,fs2,2,g2,2,fs2,2,g2,2,e2,2,fs2,2,g2,2,a2,2,d2,2,d2,2,b2,2,d
+2,2,d2,2,c3,6,c3,2,b2,2,a2,2,g2,2,a2,2,b2,2,a2,2,g2,2,fs2,2,g2,12",
);


sub new {    
    my $class = shift();
    my $length = shift() || 4;                            # a good ave
+rage
    my %self = ('length'=>$length);
    foreach (@tunes) {                                    # read the e
+xisting tunes...
        chomp;
        my @line = split /,/;
        my @notes = ("START") x $length;                # cyclic buffe
+r of notes
        my @pitches = ("START") x $length;                # cyclic buf
+fer of pitches
        my @durs = ("START") x $length;                    # cyclic bu
+ffer of durations
        while (@line) {
            shift (@notes);shift (@pitches);shift (@durs);
            my ($pitch,$dur) = (shift(@line),shift(@line));
            push @notes, "$pitch,$dur";
            push @pitches,$pitch;
            push @durs,$dur;
            $self{notes}{key($length,@notes)}{$notes[$#notes]}++;
            $self{pitches}{key($length,@pitches)}{$pitches[$#pitches]}
+++;
            $self{durs}{key($length,@durs)}{$durs[$#durs]}++;
        }
        shift (@notes);shift (@pitches);shift (@durs);
        $self{notes}{key($length,@notes)}{"END"}++;
        $self{pitches}{key($length,@pitches)}{"END"}++;
        $self{durs}{key($length,@durs)}{"END"}++;
    }
    $self{nbuffer} = [("START") x $length];
    $self{pbuffer} = [("START") x $length];
    $self{dbuffer} = [("START") x $length];
    bless \%self,$class;
}

# get a full sequence to end
sub sequence {
    my ($self,$buffer,$probs) = @_;
    my @seq;
    do {push @seq,$self->get_next(1,$buffer,$probs);} while ($seq[$#se
+q] ne "END");
    $self->set_buffer($buffer);
    pop @seq;    #remove 'END' tag
    @seq;
}

sub get_tune { sequence(shift(),"nbuffer","notes");}
sub get_pitches { sequence(shift(),"pbuffer","pitches");}
sub get_durations { sequence(shift(),"dbuffer","durs");}

# receive a buffer & a bunch of probabilities, 
# return an item (and rotate the buffer)
# only allow possibility of 'END' token if requested
sub get_next {                                            
    my ($self,$end,$buffer,$probs) = @_;
    $self->set_buffer($buffer) unless (@{$self->{$buffer}});
    my @buffer = @{$self->{$buffer}};
    shift(@buffer);
    my %next = %{$self->{$probs}{key($self->{length},@buffer)}};      
+  
    my @next = map {($_) x $next{$_}} keys %next;    # 1 entry per 'pr
+ob'
    my $n = $next[int(rand(@next))];
    unless ($end) {
        unless (grep {$_ ne "END"} @next) {    # only 1 option left,
            $self->set_buffer($buffer);            # so go to beginnin
+g
            return $self->get_next($end,$buffer,$probs);
        }
        while ($n eq 'END') {$n = $next[int(rand(@next))]};
    }
    push @buffer, $n;
    $self->set_buffer($buffer,@buffer);
    return $buffer[$#buffer];
}

# 'stream' functions - get_next_xxx(allow_end_token)
sub get_next_note {get_next(shift(),shift(),"nbuffer","notes");}
sub get_next_pitch {get_next(shift(),shift(),"pbuffer","pitches");}
sub get_next_duration {get_next(shift(),shift(),"dbuffer","durs");}

# set the intitial states
sub set_notes {set_buffer(shift,"nbuffer",@_);}
sub set_pitches {set_buffer(shift,"pbuffer",@_);}
sub set_durations {set_buffer(shift,"dbuffer",@_);}
sub set_buffer {
    my ($self,$buffer,@buffer) = @_;
    shift(@buffer) while (@buffer > $self->{length});
    unshift(@buffer,"START") while (@buffer < $self->{length});
    $self->{$buffer} = \@buffer;
}

sub key {my $l=shift();my @arr = @_;return join(" ",@arr[0..$l - 2]);}
+            
1;
[download]

package main;

use strict;
use MarkovDiddly;

my $t6 = MarkovDiddly->new(6);            # will closely an resemble e
+xisting tune
print "tune      (6): ",join(" ",$t6->get_tune()),"\n\n";
print "pitches   (6): ",join(" ",$t6->get_pitches()),"\n\n";
print "durations (6): ",join(" ",$t6->get_durations()),"\n\n";

my $t2 = MarkovDiddly->new(2);            # will be more random
print "tune      (2): ",join(" ",$t2->get_tune()),"\n\n";

# grab a load of predictable notes with more random durations
$t6->set_pitches(qw(d2 g2 g2 b2 g2 g2));
my @tune = map {$t6->get_next_pitch().",".$t2->get_next_duration()." "
+} (0..30);

print "mixture (6/2): ",join(",",@tune),"\n";
exit;
[download]

[reply]
[d/l]
[select]