Archive for October, 2010

ABC Update

October 23, 2010

I’ve been slowly poking away at the ABC module without reporting on it here, as the changes have been pretty straightforward. All of the goals at the end of my First Sheet Music post have now been achieved. Here’s the latest version of “The Star of Rakudo” PDF. If you compare it to the output of my old sheet music generator, you’ll see every musical element except the time signature is now correctly rendered by the combination of the Perl 6 ABC code and Lilypond. (In addition, I’ve also added support for rests and triplets, which are now found in the module’s version of the Star of Rakudo ABC file as an example.)

Where to go from here?

1) I guess I ought to fix the time signature thing. That should be trivial.

2) Support for ABC files whose base note duration is something other than an eighth note. (Right now we’ve just hardcoded things to assume eighth notes are the base unit of time.)

3) Broken rhythms.

4) In-line time signature and key signature changes.

5) Handling more than one ABC tune at a time in the input.

I don’t see any major challenges here, other than finding the time to work on this project!

Update: Later in the same day, I’ve already got #1 and #5 working, but I just realized I left out one important (and possibly tricky) one:

6) Handling first and second endings.

Fibonacci and Primes

October 20, 2010

The middle challenge was to find the first prime Fibonacci number greater than 227000, add one to it, and then sum the prime numbers which were its factors. Here’s my first implementation:

sub is-prime($a) {
    return Bool::True if $a == 2;
    ! [||] $a <<%%<< (2, 3, *+2 ... * > $a.sqrt);
}

my @fib := (1, 1, *+* ... *);

my $cutoff = 227000;
my $least-prime = 0;
for @fib -> $f {
    next if $f <= $cutoff;
    next unless is-prime($f);
    $least-prime = $f;
    last;
}

my $x = $least-prime + 1;
say [+] (2, 3, *+2 ... * > $x.sqrt).grep({ $x %% $^a && is-prime($a) });

Despite what seems like an obvious inefficiency (approximating the prime numbers with the odd numbers), this is pretty snappy, executing in 12.5 seconds.

I was planning to go on and talk about my new Math::Prime module here, but looking at this code, I think it can be expressed rather more nicely with a tweak or two here. Let’s see.


sub is-prime($a) {
    return Bool::True if $a == 2;
    ! [||] $a <<%%<< (2, 3, *+2 ... * > $a.sqrt);
}

my @fib := (1, 1, *+* ... *);
my $cutoff = 227000;
my $least-prime = @fib.first({ $_ > $cutoff && is-prime($_) });
my $x = $least-prime + 1;
say [+] (2, 3, *+2 ... * > $x.sqrt).grep({ $x %% $^a && is-prime($a) });

So that’s what the first method is good for!

I did indeed write Math::Prime just so I could use it here. It’s not a huge change from the previous version, really:

use Math::Prime;

my @fib := (1, 1, *+* ... *);
my $cutoff = 227000;
my $least-prime = @fib.first({ $_ > $cutoff && is-prime($_) });
my $x = $least-prime + 1;
say [+] (primes() ... * > $x.sqrt).grep({ $x %% $^a });

Unfortunately, Math::Prime isn’t optimized yet, and so this version, while a bit nicer, is actually slower than the previous version.

Update: With Moritz’s help I did some optimizations to Math::Prime, and the script using it is now very significantly faster than the others.

Summing Subsets

October 9, 2010

So, the third challenge was to count the number of subsets of a set of numbers such that the largest number in the subset is the sum of the rest of the numbers in the subset. My first attempt was very straightforward: create all the subsets and check to see if they have the desired property:

my @a = 3, 4, 9, 14, 15, 19, 28, 37, 47, 50, 54, 56, 59, 61, 70, 73, 78, 81, 92,
 95, 97, 99;

my $hits = 0;

for 1..(2 ** +@a) -> $key {
    my @b = gather for 0..+@a -> $i { take @a[$i] if $key +& (2 ** $i); }
    my $test = @b.pop;
    next if $test != [+] @b;
    $hits++;
    say (@b, $test).join(' ');
}

say "$hits hits";

I think this works correctly, but it will be a long time before we know — as I type this, it’s been running for ten hours on my fastest computer, and I don’t anticipate it finishing any time soon.

My second attempt relies on recursion, the fact the list is sorted, and skipping fruitless branches to get the job done much faster — 47 seconds, to be precise.

sub CountSumSets($target, @a) {
    my $sets = 0;
    for ^ +@a -> $i {
        if @a[$i] < $target {
            $sets += CountSumSets($target - @a[$i], @a[($i + 1) .. (@a - 1)]);
        } elsif @a[$i] == $target {
            $sets += 1;
        }
    }
    $sets;
}


my @a = 3, 4, 9, 14, 15, 19, 28, 37, 47, 50, 54, 56, 59, 61, 70, 73, 78, 81, 92, 95, 97, 99;
@a .= reverse;

my $hits = 0;

for ^ +@a -> $i {
    $hits += CountSumSets(@a[$i], @a[($i + 1) .. (@a - 1)]);
}

say $hits;

Longest palindrome

October 9, 2010

Via Hacker News, I found the Greplin Programming Challenge, and couldn’t resist trying it in Perl 6. If you’re the sort of person who enjoys that sort of thing, I highly encourage you to stop reading here and go try it yourself!

I’m going to blog about all three challenges one-by-one. I suppose the third will be the most interesting, if for no other reason than my current implementation looks like it will take ~32 hours to run, so I’m probably going to need to find a more clever solution.

Basically, the first challenge is to find the longest palindrome in a string without spaces. As stated, I thought the challenge implied it was case-sensitive; obviously it’s easiest enough to add a call to lc to get a case-insensitive version.

I was pretty sure a naive version would bring Rakudo to its knees, so I tried to be slightly clever. My solution is still O(N^2), but N is the number of occurrences of a given letter rather than the full length of the string, so that’s fairly reasonable.

sub longest-palindrome($string) {
    my @c = $string.comb(/./);
    my %hc;
    for ^ +@c -> $i {
        if %hc{@c[$i]} {
            %hc{@c[$i]}.push($i);
        } else {
            %hc{@c[$i]} = [$i];
        }
    }

    my @candidates := gather for %hc.keys.sort -> $c {
        say "Checking $c";

        my $list = %hc{$c};
        say :$list.perl;
        for $list.list -> $i1 {
            for $list.reverse -> $i2 {
                last if $i2 <= $i1;
                my $j1 = $i1;
                my $j2 = $i2;
                my $candidate = Bool::True;
                while ++$j1 < --$j2 {
                    if @c[$j1] ne @c[$j2] {
                        $candidate = Bool::False;
                        last;
                    }
                }
                if $candidate {
                    say @c[$i1..$i2];
                    take @c[$i1..$i2].join('');
                }
            }
        }
    };

    @candidates.sort({$^a.chars <=> $^b.chars}).perl.say;
}

Basically, my notion was to store all the occurrences of each letter in a hash of arrays, then pair up every two occurrences of the same letter and see if they are a palindrome. This probably isn’t the most elegant solution, nor the fastest, but it was fast enough to get solve the challenge problem in a minute or two, and easy enough to code I could do it in under an hour at three in the morning.

Interestingly, I think there might be a way to solve this using regular expressions…

Update: Moritz has a solution which blows this one out of the water, both much faster and more elegant. (The key idea was using the regex engine to find the center of potential palindromes.) I’ll let him tell you about it

Taking a Rest

October 4, 2010

Once I was reasonably happy with ABC::Duration and ABC::Note, I went ahead and added ABC::Rest, which was truly easy thanks to the magic of code reuse. It actually turned out to be quite a struggle to implement, but that was only because I accidentally typed is $.type rather than has $.type and spent a couple hours trying to sort out what the LTA error message meant.

class ABC::Rest does ABC::Duration {
    has $.type;

    method new($type, ABC::Duration $duration) {
        self.bless(*, :$type, :ticks($duration.ticks));
    }

    method Str() {
        $.type ~ self.duration-to-str;
    }
}

There are several sorts of rests in ABC, which is why ABC::Rest has a $type attribute. In practice, I’ve only implemented “z” rests so far, as they are the basic type.

Rests were already in the grammar, and adding an action to support them was dead easy:

    method rest($/) {
        make ABC::Rest.new(~$<rest_type>, $<note_length>.ast);
    }

After a trivial refactor to make the Lilypond duration handling code easily available, it was just took one line to add rests to the Lilypond output:

when “rest” { print ” r{ DurationToLilypond($context, $element.value) } ” }

That’s for the output section of the code. No changes were required to make rests work in the “figure out the overall duration” section of the code, because it looks for elements which do ABC::Duration, and so it automatically found the rests and correctly handled them.

To me, this looks like a solid win for treating duration as a role.

Hesitant Steps Forward

October 1, 2010

So, I just dived in and started trying to implement duration as a role.

role ABC::Duration {
    has $.ticks;

    our multi sub duration-from-parse($top) is export {
        ABC::Duration.new(:ticks($top.Int || 1));
    }

    our multi sub duration-from-parse($top, $bottom) is export {
        if +($top // 0) == 0 && +($bottom // 0) == 0 {
            ABC::Duration.new(:ticks(1/2));
        } else {
            ABC::Duration.new(:ticks(($top.Int || 1) / ($bottom.Int || 1)));
        }
    }

    our method Str() {
        given $.ticks {
            when 1 { "---"; } # for debugging, should be ""
            when 1/2 { "/"; }
            when Int { .Str; }
            when Rat { .perl; }
            die "Duration must be Int or Rat, but it's { .WHAT }";
        }
    }
}

The corresponding action for an explicit note length is

    method note_length($/) {
        if $<note_length_denominator> {
            make duration-from-parse($<top> ?? $<top>[0] !! "", $<note_length_denominator>[0]<bottom>[0]);
        } else {
            make duration-from-parse($<top> ?? $<top>[0] !! "");
        }
    }

I messed around a bunch trying to make "e" does Duration work as a type, but eventually gave up and just coded an ABC::Note type:

class ABC::Note does ABC::Duration {
    has $.pitch;
    has $.is-tie;

    method new($pitch, ABC::Duration $duration, $is-tie) {
        say :$duration.perl;
        self.bless(*, :$pitch, :ticks($duration.ticks), :$is-tie);
    }
}

with corresponding action

    method mnote($/) {
        make ABC::Note.new(~$<pitch>,
                           $<note_length> ?? $<note_length>[0].ast !! ABC::Duration.new(1),
                           $<tie> eq '-');
    }

So… that seems to work okay so far. But it does raise some issues for me.

1. I’m finding this $<top> ?? $<top>[0] !! "" pattern to be very repetitive. Surely there must be a better way to do it? (errr… wait a minute, could that be just $<top>[0] // ""?)

2. I don’t mind the proliferation of small classes in my code, that corresponds nicely to what we are modeling. But I am starting to mind the corresponding proliferation of small source files. Is there a better way to organize things?

… and that’s all I can remember at the moment. I think I’ll wander off and have breakfast.


Follow

Get every new post delivered to your Inbox.