Last of the Careless Men

Arising from Slumber

2010-05-10T19:29:00.000-07:00

Sorry for falling off the world of Iron Man; life has been busy.

Seeing the new proto web page got me thinking I should try to bring Vector and ABC forward into the world of the current Rakudo. Okay, make clean and make work fine for Vector. make test fails every test.

So I started in with 01-basics.t. It seems to be having trouble with the custom Unicode operators. Then I remembered seeing something on #perl6 about using our with custom operators. So I added it to both the dot product operators (one of them the Texas version, "dot"). And got the following error:

error:imcc:syntax error, unexpected '\n'
in file 'EVAL_5' line -1061556260

Perl 6 experts, help?

Apologies and Vector Again

2010-03-21T18:23:00.000-07:00

In my last post I griped a bit about the lack of progress on several of the issues that have been bothering me. Well, it turns out there is a sad explanation for why things have been slow. I came into the Perl 6 sphere after the previous cancer bout referred to here, so this was a complete surprise for me. Of course Patrick's wife's health is vastly more important than getting my toy program working. I wish them both all the best.

In the meanwhile, while that stuff hasn't been fixed, there's apparently been a huge wave of progress with the metaops in the last week -- enough so that I thought it might be worth trying Vector again. And, well... It blew up compiling Vector.pm with a pretty obscure error message. Pretty easy to guess the source of the problem, though:


> my @a = 1..3; my @b = 3..5; say @a >>*<< @b
3815
> my @a = 1..3; my @b = 3..5; say @a »*« @b
Confused at line 1, near "say @a \x{c2}\x{bb}*"

So Texas hyper-ops work, but the proper ones do not. Well, that's an easy enough change.

Hmmm... next issue: is also is history. It's augment now. That's easy enough. And then you get Can't augment class Vector without 'use MONKEY_TYPING'. Which is also easy to fix.

Next error, though is


error:imcc:syntax error, unexpected '\n'
 in file 'EVAL_5' line 58
Contextual $*PKGDECL not found

Ummm... I've got nothing. Any one have an idea what this might mean?

Progress and Congress

2010-03-11T14:04:00.000-08:00

So, it's was interesting to see the relative receptions of my last two posts. Laziness, the Catch caused a massive flurry on discussion on #perl6, and eventual plans for how to overhaul Perl 6 and Rakudo to deal with it. As far as I know, though, there's been no development in this area in Rakudo, so the scary bug is still very much present.

On the other hand, the Lazy Sieve of Eratosthenes gather / take bug is generally acknowledged, but doesn't have any momentum towards a patch at all, as far as I can see from #perl6.

On the gripping hand, at least a few of the file operators (another issue with the E03 update) now work, thanks to lue++.

It does seem like a fantastic amount of progress is being made on Rakudo at the moment. I just hope these issues get addressed before Rakudo Star.

Lazy Sieve of Eratosthenes, sidetracked

2010-03-03T07:03:00.000-08:00

A Hacker News article about the Sieve of Eratosthenes got me thinking about how to do a lazy, infinite Sieve in Perl 6. (I didn't read the whole article, because I wanted to produce my own implementation first!) Unfortunately, my attempt to do so turned up what seems to be a very major bug lurking in Rakudo's gather / take.

Basically, my notion was this. The Sieve essentially consists of crossing off multiples from a list each time you find a new prime. So what if instead of taking the list to be a fixed limited, fixed array of numbers, you made it an actual infinite lazy list? All you need is a function which, given two infinite lists of numbers, takes the least element at the front of the lists and returns that. Then you when find a new prime, you take your existing list and use that function to merge in the list of multiples of the new prime.

So I started to code this up, and instantly ran into weirdness.

sub sorted-infinite-sequence-merge(Iterator $a-iterator, Iterator $b-iterator)
{
    my $a = $a-iterator.get;
    my $b = $b-iterator.get;

    gather loop {
        my $next = $a min $b;
        # say "$a, $b, $next";
        take $next;
        $a = $a-iterator.get if $a == $next;
        $b = $b-iterator.get if $b == $next;
    }
}

sorted-infinite-sequence-merge((1..100).iterator.map({$_*3}), (1..100).iterator.map({$_*4})).batch(20).perl.say;
sorted-infinite-sequence-merge((3, 6 ... *), (4, 8 ... *)).batch(20).perl.say

That code generates the following two lists:


(3, 4, 6, 8, 9, 12, 15, 16, 18, 20, 21, 24, 27, 28, 30, 32, 33, 36, 39, 40)
(4, 8, 12, 16, 20, 24, 28, 32, 36, 40, 44, 48, 52, 56, 60, 64, 68, 72, 76, 80)

As you can see, the first list is clearly correct. The second list (which calls the same merge function, but using source lists generated via series instead of Range) is clearly incorrect. I believe this must represent some sort of gather/take bug triggered by nested gather/take operations.

Help?

E03: Laziness: The Catch

2010-02-27T15:53:00.000-08:00

So, jnthn++ fixed the Nominal type check failed for parameter '@a'; expected Positional but got GatherIterator instead issue. Errr, sort of. Here's my sum sub:


sub sum(@a) {
    +@a ?? @a.reduce({ $^a + $^b }) !! 0;
}

Now it does get called properly if you say sum(@costs.grep({$_ >= 1000})). But even though it appears to be a very simple function, it doesn't work when called this way! The problem, as far as I can tell, is that @a may look like a Seq or an Array, it's still actually an iterator. That means the first time you use it for something like, say, +@a, it is completely consumed! Then the next time you access it, there's nothing left. This is definitely not what is expected...

Update: Just realized that without "Perl 6", Ironman didn't pick up the previous post or this one. Time to edit...

E03 in Master

2010-02-27T05:10:00.000-08:00

So, I thought porting my E03 script to run on the current Rakudo master would make a good topic for a post. So, what did I have to change?

1. The code wouldn't parse with the metaoperators in it. So they had to go. Sob!

2. Symbol '$is_active_bit' not predeclared. Okay, replace constant with my.

3. No applicable candidates found to dispatch to for 'subst'. Well, that never actually worked properly in alpha, either. Easy enough to replace this with map and a new sub.

4. Method 'e' not found for invocant of class 'Str'. Ack. I just commented out these calls (I presumed :s wouldn't work either).

5. := binding of variables not yet implemented. Switching this to = --- errr --- breaks the code. Guess I'll have to fix that in a minute.

6. Method 'count' not found for invocant of class 'Perl6MultiSub'. Blast. This was triggered by my new code reduce(&infix:<+>). Easy enough to change it to reduce({ $^a + $^b }).

7. Cannot reduce() empty list. Arrrgh! Turns out duplicating what [+] does is harder than it looks. I added a sub sum to cleanly check for the empty list.

8. Nominal type check failed for parameter '@a'; expected Positional but got GatherIterator instead. Oh, no. This is some sort of internal issue showing through, and I have no idea how to fix it.

Guess I will stop there for now, because I don't know how to go further.

sub add_trailing_slash_if_needed($path) {
    $path ~~ / \/ $ / ?? $path !! $path ~ '/';
}

sub load_data($filename, $version = 1, *@dirpath is copy) {
    @dirpath = './', 'peter' unless +@dirpath;
    @dirpath .= map({ add_trailing_slash_if_needed($_) });
    say @dirpath.join("\n");

    my %data;
    for @dirpath -> $prefix {
        my $filepath = $prefix ~ $filename;

        # if ($filepath ~~ :e and 100 < ($filepath ~~ :s) <= 1e6) 
        {
            say "Trying to open $filepath";
            my $fh = open($filepath, :r)
                    or die "Something screwy with $filepath: $!";
            my ($name, $vers, $status, $costs) = $fh.lines(4);
            next if $vers < $version;
            $costs = [split /\s+/, $costs];
            %data{$filepath} = {};
            %data{$filepath}<name vers stat costs rest> =
                            ($name, $vers, $status, $costs, $fh.slurp);
            say "$filepath done";
            $fh.close;
        }
    }
    return %data;
}

sub save_data(%data) {
    for %data.kv -> $filepath, $data {
        say "saving $filepath";
        my $fh = open($filepath, :w)
                or die "Something screwy with $filepath: $!";
        $fh.print: ($data.<name vers stat>, ~($data.<costs>), $data.<rest>).join("\n");
        $fh.close;
    }
}

# I've no idea what this sub was supposed to do, so let's stick with something really
# simple for the moment.
sub amortize($a) {
    $a;
}

sub sum(@a) {
    +@a ?? @a.reduce({ $^a + $^b }) !! 0;
}

my %data = load_data(filename=>'weblog', version=>1);
my $is_active_bit = 0x0080;
for %data.kv -> $file, $data {
    say "$file contains data on { $data<name> }";
    $data<stat> +^= $is_active_bit;

    # my @costs := $data<costs>;
    my @costs = $data<costs>;
    my $inflation = 0;
    $inflation = prompt 'Inflation rate: '
        until $inflation > 0;
        
    # @costs = (@costs >>*>> $inflation).sort({ amortize($_) }); 
    @costs = @costs.map({ $_ * $inflation }).sort({ amortize($_) }); 
    
    # say "Total expenditure: { [+] @costs }";
    # say "Major expenditure: { [+] @costs.grep({$_ >= 1000}) }";
    # say "Minor expenditure: { [+] @costs.grep({$_ < 1000}) }";
    
    say "Total expenditure: { sum(@costs) }";
    say "Major expenditure: { sum(@costs.grep({$_ >= 1000})) }";
    say "Minor expenditure: { sum (@costs.grep({$_ < 1000})) }";
    say "Odd expenditures: { @costs.map(-> $a, $b { $a }) }"; 
}

# save_data(%data, log => {name=>'metalog', vers=>1, costs=>[], stat=>0});
save_data(%data);

Update: Adding the words "Perl 6" in text so Ironman picks it up. Sigh.

E03 Second Stab

2010-02-20T04:52:00.001-08:00

As usual, masak++ has some brilliant stuff in his take on the E03 challenge, which I am shamelessly borrowing for my second version. On the other hand, I think he has done himself a disservice by not making sure his code actually works in Rakudo, as I see several dodgy spots and an entire missing function in his version.

So, some notes on masak's code:
1) His default value for @dirpath is wonky. First, he seems to be assigning @std_dirpath to @last_dirpath if the former is undefined. Second, neither of those variables is actually declared. Third, he's left off the '.' case, which is the one that actually works.

2) On the plus side, he has a working regular expression for the subst, and includes the assignment operator I forgot (in my comment version). On the minus side, the right hand side of the substitution is bad -- it works in theory, but does not work in practice in Rakudo alpha (nor master, so far as I know).

3) I'm amused that he used comb instead of the original's split. Both lines have the exact same effect, so far as I know. Arguably his has a little more style than mine.

4) I'm interested that he didn't notice that %data{$filepath}{"filepath"} = $filepath is kind of redundant.

5) Kudos for remembering how to declare a constant. But without the seek method, @StartOfFile is never actually used in the code.

6) His save_data is kind of drastically more complicated than mine, because he didn't just read the rest of the file in load_data and store it. He also uses lines instead of slurp, which makes writing out the data a bit more complicated as well. (Are those .list statements really necessary?)

7) He relies on the E03's explanation that a Str converted to Num will return NaN if it is not a valid number. That's certainly not true of Rakudo alpha. I'm not clear if it's true in the Perl 6 spec or not. (Of course, I skipped that bit altogether...)

So here's my second version. I cribbed a few things from masak's version, and added an arbitrary second default directory so I could make sure that it handled having more than one file.

sub load_data($filename, $version = 1, *@dirpath is copy) {
    @dirpath = './', 'peter/' unless +@dirpath;
    @dirpath>>.=subst(/(<-[/]>)$/, {"$1/"}); # doesn't actually work in Rakudo alpha
    say @dirpath.join("\n");

    my %data;
    for @dirpath -> $prefix {
        my $filepath = $prefix ~ $filename;

        if ($filepath ~~ :e and 100 < ($filepath ~~ :s) <= 1e6) {
            say "Trying to open $filepath";
            my $fh = open($filepath, :r)
                    or die "Something screwy with $filepath: $!";
            my ($name, $vers, $status, $costs) = $fh.lines(4);
            next if $vers < $version;
            $costs = [split /\s+/, $costs];
            %data{$filepath} = {};
            %data{$filepath}<name vers stat costs rest> =
                            ($name, $vers, $status, $costs, $fh.slurp);
            say "$filepath done";
            $fh.close;
        }
    }
    return %data;
}

sub save_data(%data) {
    for %data.kv -> $filepath, $data {
        say "saving $filepath";
        my $fh = open($filepath, :w)
                or die "Something screwy with $filepath: $!";
        $fh.print: ($data.<name vers stat>, ~($data.<costs>), $data.<rest>).join("\n");
        $fh.close;
    }
}

# I've no idea what this sub was supposed to do, so let's stick with something really
# simple for the moment.
sub amortize($a) {
    $a;
}

my %data = load_data(filename=>'weblog', version=>1);
constant $is_active_bit = 0x0080;
for %data.kv -> $file, $data {
    say "$file contains data on { $data<name> }";
    $data<stat> +^= $is_active_bit;

    my @costs := $data<costs>;
    my $inflation = 0;
    $inflation = prompt 'Inflation rate: '
        until $inflation > 0;
        
    @costs = (@costs >>*>> $inflation).sort({ amortize($_) }); 

    say "Total expenditure: { [+] @costs }";
    say "Major expenditure: { [+] @costs.grep({$_ >= 1000}) }";
    say "Minor expenditure: { [+] @costs.grep({$_ < 1000}) }";
    say "Odd expenditures: { @costs.map(-> $a, $b { $a }) }"; 
}

# save_data(%data, log => {name=>'metalog', vers=>1, costs=>[], stat=>0});
save_data(%data);

E03 First Stab

2010-02-19T07:12:00.000-08:00

Well, this one is weird. The original program strikes me as almost non-sensical, and is missing a key subroutine, amortize. It also features a lot of Perl 6 wildly changed since it was written. Still, here's a stab at what I think it is trying to do.

sub load_data($filename, $version = 1, *@dirpath is copy) {
    @dirpath = './' unless +@dirpath;
    # @dirpath>>.subst(/c/, {$1/});

    my %data;
    for @dirpath -> $prefix {
        my $filepath = $prefix ~ $filename;

        if ($filepath ~~ :e and 100 < ($filepath ~~ :s) <= 1e6) {
            say "Trying to open $filepath";
            my $fh = open($filepath, :r)
                    or die "Something screwy with $filepath: $!";
            my ($name, $vers, $status, $costs) = $fh.lines(4);
            next if $vers < $version;
            $costs = [split /\s+/, $costs];
            %data{$filepath} = {};
            %data{$filepath}<name vers stat costs rest> =
                            ($name, $vers, $status, $costs, $fh.slurp);
            say "$filepath done";
            $fh.close;
        }
    }
    return %data;
}

sub save_data(%data) {
    for %data.kv -> $filepath, $data {
        say "saving $filepath";
        my $fh = open($filepath, :w)
                or die "Something screwy with $filepath: $!";
        $fh.print: ($data.<name vers stat>, ~($data.<costs>), $data.<rest>).join("\n");
        $fh.close;
    }
}

# I've no idea what this sub was supposed to do, so let's stick with something really
# simple for the moment.
sub amortize($a) {
    $a;
}

my %data = load_data(filename=>'weblog', version=>1);
my $is_active_bit = 0x0080;
for %data.kv -> $file, $data {
    say "$file contains data on { $data<name> }";
    $data<stat> +^= $is_active_bit;

    my @costs := $data<costs>;
    my $inflation;
    # while my $inflation = prompt('Inflation rate: ') 
    # print "Inflation rate: " and $inflation = +<>
    #     until $inflation != NaN;
    $inflation = 1.2;
        
    @costs = (@costs >>*>> $inflation).sort({ amortize($_) }); 

    say "Total expenditure: { [+] @costs }";
    say "Major expenditure: { [+] @costs.grep({$_ >= 1000}) }";
    say "Minor expenditure: { [+] @costs.grep({$_ < 1000}) }";
    say "Odd expenditures: { @costs.map(-> $a, $b { $a }) }"; 
}

# save_data(%data, log => {name=>'metalog', vers=>1, costs=>[], stat=>0});
save_data(%data);

Some random notes:
1) The original code references @last_dirpath and @std_dirpath but nowhere are they defined, nor would they ever get used. I have simply taken them out.

2) The original code used a hyper-smartmatch with a s// substitution. To the best of my knowledge, that's never worked in Rakudo... um, almost said master, but I guess it's called "alpha" now. I tried replacing it with a hyper-.subst, but I couldn't get that to parse, either. I just skipped over this bit.

3) The original tried to create a read/write filehandle, stash it after reading, store it, and re-write the file entirely using seek and truncate. Neither of those functions exist in alpha as far as I can tell, so I just rewrote it to read the entire file when loading, and then open a new file in write mode when saving. This seems more sensible anyway, and has the benefit of working.

4) The original used ofs to set the output field separator. That's deprecated, so I just used a simple join statement to do the same thing.

5) I couldn't figure out how to get the code to get inflation from a user prompt, so I just hard-coded inflation to be... um... 20%. That seems kind of high now that I think about it. (And what is it with these old example programs and reading data from a prompt? That's something I've never wanted to do in more than a decade of Perl 5 programming...)

6) The four-line hyper-times, map, sort, map operation becomes a simple one-liner in modern Perl 6.

7) For some reason, the "Total expenditure" line prints the individual contents of @costs rather than the sum. No clue what's going on there.

8) Simple greps instead of the original's custom filters.

9) Use a simple map to get every other cost, because 1, 3 ... * doesn't work in alpha.

And that's it, I think. It's kind of weird and ugly, but I think it does do what it's supposed to. (I mean, it does do something, and I think that what it does is what the original code intended. But given the oddness of the original, who knows?)

I look forward to seeing what masak does with this one...

E03 Challenge

2010-02-13T05:13:00.000-08:00

So, masak issued a challenge in the comments of my last post, and I'd like to throw it open to everyone. Just like we both updated E02 for modern Perl 6, we are going to try to independently update E03 and compare results on Friday, February 19th. This one looks significantly tougher and more interesting than the last, so I'm looking forward to see what other people can come up with!

Binary Tree Complete

2010-02-11T04:05:00.001-08:00

masak responded to my last post with a very nice post and script of his own. His code implemented the two features I left out from the original, and added several other very nice touches. I've updated my own script, stealing liberally from his and adding a few wrinkles of my own. I think this is about as far as a script which tries to stick pretty close to the original can go -- but then, I think there is still a lot of room for improvement by moving away from the original and fully embracing Perl 6.

So here's my new script. (Apologies for not posting it in-line here, but something in it breaks my copy of Syntax::Highlight::Perl6 and I don't have time to sort out how to fix it.) A quick overview of the changes:

1. I've incorporated masak's role Found verbatim. This implements a big piece of the functionality of the original that I left out in my previous attempt. (Personally, I think this is a rather silly use of roles, but that's not masak's fault, he's just matching the original script here.)

2. I tried to take masak's revamped show function to its logical conclusion. He changed it to return nodes in the iteration with take, so that you have to call gather before calling it. To my taste this combines brilliance with wrongness. I took his code, reversed his left and right so things came out in the right order, renamed show to traverse, and -- here is the key, IMO -- created a new function, collect which does gather and then calls traverse. I think this is going to be a really common idiom for iterating over recursive data structures in Perl 6.

3. That has the side effect of making printing the tree very elegant: say "Pre order: { collect(%root, pre-order) }";.

4. I grabbed masak's use of prompt verbatim, too. What a nifty little function!

5. I added a say at the end of the loop, so you get a proper newline and message indicating that the program has ended successfully.

6. I switch to %tree throughout, at masak's suggestion, and also switched Hash.new to {}. masak++

I think next I'll take a stab at rewriting this using a class instead of a hash. And I see there has been crazy progress on ng lately, so with any luck it will be ready to handle the ABC project after that...

Binary Tree, Almost Complete Script

2010-02-04T04:08:00.000-08:00

So, I played around with the binary tree script a bit more after posting yesterday. It was mostly very straightforward once I figured out how to make it work with "is rw". Here's what I've got now:

# bintree - binary tree demo program 
# adapted from "Perl Cookbook", Recipe 11.15
# converted to modern Perl 6 by SF
use v6;

my %root;
for (1..1000).pick(20) {
    insert(%root, $_);
}

enum TraversalMode <pre in post>;

print "Pre order:  "; show(%root, TraversalMode::pre);  print "\n";
print "In order:   "; show(%root, TraversalMode::in);   print "\n";
print "Post order: "; show(%root, TraversalMode::post); print "\n";

#        $ARGS prompts("Search? ");

for @*ARGS {
    if (my $node = search(%root, $_)) {
        say "Found $_ at { $node.perl }: { $node<VALUE> }";
        # say "(again!)" if $node<VALUE>.Found > 1;
    }
    else {
        say "No $_ in tree";
    }
}

#########################################
sub insert(Hash $tree is rw, Int $val) {
    unless $tree {
        $tree<LEFT>   = Hash.new;
        $tree<RIGHT>  = Hash.new;
        $tree<VALUE>  = $val ; # but Found(0);
        return;
    }
    if    ($tree<VALUE> > $val) { insert($tree<LEFT>,  $val) }
    elsif ($tree<VALUE> < $val) { insert($tree<RIGHT>, $val) }
    else                        { warn "dup insert of $val\n" }
}

sub show(%tree, $mode) {
    return unless %tree;
    show(%tree<LEFT>, $mode) unless $mode == TraversalMode::post;
    show(%tree<RIGHT>,$mode)     if $mode == TraversalMode::pre;
    print %tree<VALUE>, " ";
    show(%tree<LEFT>, $mode)     if $mode == TraversalMode::post;
    show(%tree<RIGHT>,$mode) unless $mode == TraversalMode::pre;
}
     
sub search ($tree is rw, $value) {
    return unless $tree;
    return search($tree{$value < $tree<VALUE> ?? "LEFT" !! "RIGHT"}, $value)
        unless $tree<VALUE> == $value;
    # $tree<VALUE> but Found($tree<VALUE>.Found+1);
    return $tree;
}

Let me highlight the big differences between this and the Exegesis 2 version:

1) Using pick instead of rand. It's not shorter, but IMO pick is definitely more idiomatic. pick is also more correct, in some sense: the original code clearly did not want duplicate numbers, warning the user when they happened. With pick that never happens.

2) enum instead of trying to emulate the idea with is constant = (0..2).

3) Oh yes, using %root instead of $root.

4) Apparently $ARGS prompts("Search? "); was meant to create a prompt to get input from the user if there's nothing on the command line? I've no idea if that facility still exists in Perl 6, or was ever implemented in Rakudo.

5) Also skipped the Found role. I'm not sure how the old code expected it work without defining Found. I think they were trying to prove a point about roles, because the whole idea would be more easily implemented using another field in the hash.

6) In insert, instead of sticking undef in the left and right fields, I actually create empty Hash objects. As you can see in my last post, I originally created undefined Hash objects, but this worked better for me. In practice, it might be better to leave these out entirely until they are needed, but this matches the logic of the old version.

7) In show, I've converted it to use sub arguments rather than all that ugly @_ stuff. I've no idea why the original code didn't do that in the first place, unless it was to show that @_ still worked.

8) In search, I've changed it from a boolean logical expression to a simple ternary ?? !!.

I guess I should look at coding up a Found role, and then trying to use it correctly. Thought honestly, I'm more inclined to completely rewrite this as a binary tree class, which I think would do wonders for the code even as it wandered far away from the shape of the original.

Binary Tree

2010-02-03T11:33:00.000-08:00

So, while reading over #perl6 today, I noticed comments about how out-of-date Exegesis 2's first example was. Even the updates to it are out of date! I thought it would be fun and simple to update it to working modern Perl 6, as embodied in Rakudo master. (As ng has still not landed.)

Well, it seemed like a good idea when I started. However, I've run into an odd issue. Here's my simplified which doesn't work:

# bintree - binary tree demo program 
# adapted from "Perl Cookbook", Recipe 11.15
# converted to modern Perl 6 by SF
use v6;

my (%root, $n);
for (1..1000).pick(2) {
    say "Inserting $_";
    insert(%root, $_);
    say %root.perl;
}

say %root.keys;
say "Doom";

#########################################
sub insert(Hash $tree is rw, Int $val) {
    unless $tree {
        my %node;
        %node<LEFT>   = Hash;
        %node<RIGHT>  = Hash;
        %node<VALUE>  = $val ; # but Found(0);
        say %node.perl;
        $tree = %node;
        say $tree.perl;
        return;
    }
    if    ($tree<VALUE> > $val) { insert($tree<LEFT>,  $val) }
    elsif ($tree<VALUE> < $val) { insert($tree<RIGHT>, $val) }
    else                        { warn "dup insert of $val\n" }
}

And here's sample output:


Inserting 640
{"VALUE" => 640, "RIGHT" => Hash, "LEFT" => Hash}
{"VALUE" => 640, "RIGHT" => Hash, "LEFT" => Hash}
{}
Inserting 461
{"VALUE" => 461, "RIGHT" => Hash, "LEFT" => Hash}
{"VALUE" => 461, "RIGHT" => Hash, "LEFT" => Hash}
{}

If you match that back up with the says in the code, you'll see that a value is assigned to $tree in insert, but that value does not make it back to the point where insert is called, despite $tree is rw. I've no idea why this should be the case, the same sort of code seems to work quite well in the REPL. Does anyone have an idea? Am I doing something stupid here, or did I just find a bug in a very-soon-to-be-obsolete version of Rakudo?

Update: Not sure if this is just something I don't understand or a rakudobug. It turns out that the problem is the line $tree = %node. If I use equals to assign something to $tree, that doesn't get passed back out. On the other hand, if I add hash keys directly to $tree, they are passed out just like I would expect.

Holding Pattern Continued

2010-01-28T22:38:00.000-08:00

Well, a week has gone by, and Rakudo's ng branch is definitely not ready for prime time yet. It's completely understandable, but it does put a bit of a kink in my plan to start working on getting actions attached to the Perl 6 ABC grammar using ng.

Okay, then, I guess the thing to do is to find a goal for the project that can be done now. And hey, there it is! I will attempt to get my hands on some examples of Irish traditional music (again, as colomon suggested) and make sure they work in our current parser. In turn, that will require a decent way of checking whether an entire tune has been read into the grammar or not. That sounds like a solid goal for the next week...

Holding Pattern

2010-01-21T18:46:00.000-08:00

Well, I meant to get to adding actions to my grammar. But I have a great excuse for not making progress. At the moment, there is a big push underway in Rakudo development to replace the current master branch with the ng branch. As I understand it, ng implements actions a bit differently than master -- it is more true to the Perl 6 spec. But right now, ng isn't ready to use, and there's not much point in targeting an out-of-date implementation that is going to go away in the next couple of weeks. So I'm putting this on hold until ng is in place.

If you're following along at home, I did go ahead and add grace notes, chords, nth endings, and rolls and staccato markings. It's so straightforward it's not really describing how I did it, but it is uploaded to github if you'd like to try it. I don't know if it will properly support Irish music yet, as a commenter requested last time, but it ought to be closer, anyway.

Putting it together

2010-01-14T08:16:00.000-08:00

Just to get more dramatic results, here's script to check if an ABC tune can be played on a one-row button accordion in G. It's pretty easy to put together given what we've got so far:

use v6;

BEGIN { push @*INC, "lib" }
use ABC;

my @matches = $*IN.slurp.comb(m/ <ABC::tune> /, :match);

my %dg_notes = {
    'g' => 1,
    'a' => 1,
    'b' => 1,
    'c' => 1,
    'd' => 1,
    'e' => 1,
    '^f' => 1
}

for @matches {
    my %header = header_hash(.<ABC::tune><header>);
    say %header<T> ~ ":";

    my @notes = gather for .<ABC::tune><music><line_of_music> -> $line
    {
        for $line<bar> -> $bar
        {
            for $bar<element>
            {
                when .<broken_rhythm> { take .<broken_rhythm><note>[0]; take .<broken_rhythm><note>[1]; }
                when .<note>          { take .<note>; }
            }
        }
    }

    my %key_signature = key_signature(%header<K>);

    my @trouble = @notes.map({apply_key_signature(%key_signature, .<pitch>)}).grep({!%dg_notes.exists(lc($_))});
    say @trouble.perl;
}

Basically, we set up @matches with all the tunes in the file, and %dg_notes with all the notes that can be played (though it's actually just the key of G for now). Then for each tune, we loop through and collect all the notes, factored into the appropriate key signature. Then we just grep against the notes that are allowed to make a list of the notes not present on a G accordion. Here are the results on my sample file:


Cuckold Come Out o' the Amrey:
["^c", "^c", "^c", "^c", "^c", "^c", "^c", "^c", "=f", "^c", "^c", "^c", "^c"]
Elsie Marley:
["=F", "=f"]
Peacock Followed the Hen. JWDM.07:
[]

So in this case, "Cuckold" has a bunch of c-sharps and an f-natural, "Elsie Marley" has a couple of f-naturals, and "Peacock" is solidly playable on a G accordion.

While this approach has been fun, I think it's time to dig in use Perl 6 grammar actions to build a smarter data structure for ABC tunes. Should be exciting...

Extracting the Tunes from a File

2010-01-06T12:26:00.000-08:00

Just a quick post today. While reworking my test script for the DG accordion testing program, I decided it would be better if the script could accept an ABC file with multiple tunes in it. After about ten minutes of fiddling around, I came up with this:


my @matches = $*IN.slurp.comb(m/ <ABC::tune> /, :match);

Actually, that's a lie. I just came up with that a second ago, when I said to myself, "Wait a minute, maybe slurp works on $*IN?" Previously I was using lines and join to get the same effect.

The scary thing is, that's just the cleanest way I've been able to find to do it in Rakudo. In ideal Perl 6, I believe you could just say


my @matches = slurp.comb(m/ <ABC::tune> /, :match);

I believe in ideal Perl 6 that would be lazy, too, using the Cat class internally to get a lazy string.

Anyway, that gives you an array of Match objects, one for each ABC tune in the file. But there is one big gotcha with this formulation: if something happens to abort parsing the ABC::tune early (say it hits an ABC directive we haven't implemented yet), comb will merrily skip the rest of the tune without any warning. So this is probably a less than ideal approach in the long run. But my attempts to make a regex for the entire file have failed so far, and this works quite nicely on my sample data.

Key signatures

2009-12-30T17:56:00.000-08:00

After making my last post, I was brimming over with confidence. Obviously I'd done all the hard bits, and it was just a matter of putting the pieces together, right?

Wrong. Perl 6 makes parsing the ABC data so darned easy that the next bit seems completely unreasonable. At least, I haven't figured out a way to make it elegant yet. Figuring out which sharps or flats are in a key signature is tricky stuff, and as far as I can figure, Perl 6 doesn't really have any clever tools to make it easier.

sub key_signature($key_signature_name)
{
    my %keys = (
        'C' => 0,
        'G' => 1,
        'D' => 2,
        'A' => 3,
        'E' => 4,
        'B' => 5,
        'F#' => 6,
        'C#' => 7,
        'F' => -1,
        'Bb' => -2,
        'Eb' => -3,
        'Ab' => -4,
        'Db' => -5,
        'Gb' => -6,
        'Cb' => -7
    );
    
    my $match = $key_signature_name ~~ m/ <ABC::basenote> ('#' | 'b')? \h* (\w*) /;
    die "Illegal key signature\n" unless $match ~~ Match;
    my $lookup = [~] $match<ABC::basenote>.uc, $match[0];
    my $sharps = %keys{$lookup};
    
    if ($match[1].defined) {
        given ~($match[1]) {
            when ""     { }
            when /^maj/ { }
            when /^ion/ { }
            when /^mix/ { $sharps -= 1; }
            when /^dor/ { $sharps -= 2; }
            when /^m/   { $sharps -= 3; }
            when /^aeo/ { $sharps -= 3; }
            when /^phr/ { $sharps -= 4; }
            when /^loc/ { $sharps -= 5; }
            when /^lyd/ { $sharps += 1; }
            default     { die "Unknown mode {$match[1]} requested"; }
        }
    }
    
    my @sharp_notes = <F C G D A E B>;
    my %hash;
    
    given $sharps {
        when 1..7   { for ^$sharps -> $i { %hash{@sharp_notes[$i]} = "^"; } }
        when -7..-1 { for ^(-$sharps) -> $i { %hash{@sharp_notes[6-$i]} = "_"; } }
    }

    return %hash;
}

Basically, we do a match to rip the key signature name into its component pieces. The classic Highland piping key of "Amix", for instance, needs to be recognized as "A", no sharp or flat, "mix"olydian. We use the first two bits to lookup the corresponding major key signature, then use the last bit as a modifier. When we're done, we have the number of sharps or (if negative) flats. We then use that count to figure out which notes need to be sharp or flat.

It doesn't sound that bad, but it was pretty tricky to implement. It also (likely) has some holes in it. For example, the ugly key signture of C-flat minor (4 flats and 3 double flats!) will fail. Of course, any sane person would write that as B minor (two sharps). Also, the ABC spec allows you to explicitly specify exceptions to the normal key signature rules. I haven't even tried to implement that yet.

This is definitely one of those cases were any suggested improvements will be very welcome.

Getting all the notes

2009-12-28T19:11:00.000-08:00

I hope everyone had lovely holidays! I've spent a bit of time while away fiddling with my idea for a script to determine if a given tune can be played on a D/G button accordion. I've hit on a bit of a snag, as the code to determine what sharps or flats are in a given key signature is more complicated than I was thinking. It will probably take me a few more days to sort that out, but in the meantime, here is my first stab at extracting all the pitches from an ABC tune:

my $match = $abc ~~ m/ <ABC::tune> /;

die "Tune not matched\n" unless $match ~~ Match;

my @notes = gather for $match<ABC::tune><music><line_of_music> -> $line
{
    for $line<bar> -> $bar
    {
        for $bar<element>
        {
            when .<broken_rhythm> { take .<broken_rhythm><note>[0]; take .<broken_rhythm><note>[1]; }
            when .<note>          { take .<note>; }
        }
    }
}

@notes.map({.<pitch>.say});

I'm suspecting there is a lovely Perl 6 idiom I don't quite have yet to squish all the for statements into a series of maps, but this works fine for the time being.

Got It!

2009-12-20T12:05:00.000-08:00

I've now got a simple working ABC tune parser. (Well, working in at least so far as it passed all the tests I've thought up so far.) Once I cracked the whitespace issue, the remaining piece fell into shape quickly. Figuring out that \h and \v were useful for horizontal and vertical whitepsace also helped. Here's the grammar I'm using now:

use v6;

grammar ABC
{
    regex header_field_name { \w }
    regex header_field_data { \N* }
    regex header_field { ^^ <header_field_name> ':' \s* <header_field_data> $$ }
    regex header { [<header_field> \v]+ }

    regex basenote { <[a..g]+[A..G]> }
    regex octave { \'+ | \,+ }
    regex accidental { '^' | '^^' | '_' | '__' | '=' }
    regex pitch { <accidental>? <basenote> <octave>? }

    regex tie { '-' }
    regex note_length { [\d* ['/' \d*]? ] | '/' }
    regex note { <pitch> <note_length>? <tie>? }
    
    regex rest_type { <[x..z]> }
    regex rest { <rest_type> <note_length>? }
    
    regex gracing { '+' <alpha>+ '+' }
    
    regex spacing { \h+ }
    
    regex broken_rhythm_bracket { ['<'+ | '>'+] }
    regex broken_rhythm { <note> <g1=gracing>* <broken_rhythm_bracket> <g2=gracing>* <note> }
    
    regex element { <broken_rhythm> | <note> | <rest> | <gracing> | <spacing> }
    
    regex barline { ':|:' | '|:' | '|' | ':|' | '::' }
    
    regex bar { <element>+ <barline>? }
        
    regex line_of_music { <barline>? <bar>+ }
    
    regex music { [<line_of_music> \s*\v?]+ }
    
    regex tune { <header> <music> }
}

This will successfully parse the sample ABC I gave in my first post on this topic.

Where to go from here? 1) I'd like to write a simple script that can put the grammar to work as is. I'm thinking maybe a script which can test if a tune is playable on a D/G accordion. 2) So far, the grammar only supports a subset of ABC. Off the top of my head, it doesn't support chords (either as labels above the music or as more than one notehead at once) and it doesn't support in-line key changes or time changes. I'm guessing these will be fairly easy to add. 3) I'd like to be able to map the parse to actual Perl 6 classes to make the ABCs easier to manipulate. 4) I'd like to be able to use those classes to write out ABCs.

So much to do!

Infinite Loops

2009-12-20T06:07:00.001-08:00

Well, I tried reformulating the line of music regex, and have what I think is a nice version, with one major catch. Here's the new regexes:

    regex element { <broken_rhythm> | <note> | <rest> | <gracing> }
    
    regex barline { ':|:' | '|:' | '|' | ':|' | '::' }
    
    regex bar { <element>+ <barline>? }
        
    regex line_of_music { <barline> $$ | <barline>? <element>+ $$ }

As is, this passes without issues:

{
    my $match = "g>ecgece/f/g/e/|" ~~ m/ <ABC::bar> /;
    isa_ok $match, Match, 'bar recognized';
    is $match<ABC::bar>, "g>ecgece/f/g/e/|", "Entire bar was matched";
    is $match<ABC::bar><element>.map(~*), "g>e c g e c e/ f/ g/ e/", "Each element was matched";
    is $match<ABC::bar><barline>, "|", "Barline was matched";
}

I think that's a suitably elegant test.

There's only one problem here. Real ABC allows for spaces between elements, which makes the ABC format much more legible. (I would like this code in the long run to be able to take an ABC tune, process it, and write it back out again, so ideally the code needs to carefully note the whitespace so it can be output again later.) But when I try to add <ws>+ alternative to the element regex, and try to parse a bar of music with a space or two in it, it appears to just hang.

This one has me utterly stumped; do any of the Perl 6 regex experts out there have a clue what could be going on?

Update: Still unable to make <ws> work for me, but had great luck with just using good old \s. So the code works now, but I'd still love an explanation...

Update to the Update: Argh, bar works but line_of_music still hangs. Dang it, I feel like I'm sooooooo close to getting this thing working....

Update^3: Ah, I simply had a completely broken line_of_music. I've got a simpler one working now.

Moritz++

2009-12-18T18:10:00.000-08:00

Going over the #perl6 backlog today, I noticed that Moritz had two suggestions for me based on my last post. The first was a nice suggestions to use given in my tests:

{
    my $match = "d'+p+<<<+accent+_B" ~~ m/ <ABC::broken_rhythm> /;
    isa_ok $match, Match, '"d+p+<<<+accent+_B" is a broken rhythm';
    given $match<ABC::broken_rhythm>
    {
        is .<note>[0]<pitch><basenote>, "d", 'first note is d';
        is .<note>[0]<pitch><octave>, "'", 'first note has an octave tick';
        is .<note>[0]<pitch><accidental>, "", 'first note has no accidental';
        is .<note>[0]<note_length>, "", 'first note has no length';
        is .<g1>[0], "+p+", 'first gracing is +p+';
        is .<broken_rhythm_bracket>, "<<<", 'angle is <<<';
        is .<g2>[0], "+accent+", 'second gracing is +accent+';
        is .<note>[1]<pitch><basenote>, "B", 'second note is B';
        is .<note>[1]<pitch><octave>, "", 'second note has no octave';
        is .<note>[1]<pitch><accidental>, "_", 'second note is flat';
        is .<note>[1]<note_length>, "", 'second note has no length';
    }
}

This is far from the amazing new testing form I was hoping to find, but it sure is a big improvement over what I had. If I don't think of something else better, I will go back and redo all of the longer test cases this way.

He also said about the barline regex, "Looks like it would need LTM to work." I believe he's talking about longest-token matching, but I don't fully understand the issues, I fear. I did finally write tests for this case:

for ':|:', '|:', '|', ':|', '::'  
{
    my $match = $_ ~~ m/ <ABC::barline> /;
    isa_ok $match, Match, "barline $_ recognized";
    is $match<ABC::barline>, $_, "barline $_ is correct";

And they didn't work -- sometimes it would match the first barline it recognized rather than the longest. Moritz also suggested, "Reordering the longest alternatives to the front would help," so I did, and then all the tests passed. I hope that means the problems are actually gone, and not just that I've managed to hide them for the moment.

Anyway, big kudos for Moritz! Thanks to him, it definitely feels like I am getting closer here. Now if I can just figure out the proper way to ask for an entire line of ABC music in Perl 6, I will be there!

Now With Grammar And Tests

2009-12-17T05:01:00.000-08:00

I've made a huge amount of progress with the ABC project in the last 36 hours. At this point I think I've just got a few more rules to write and debug before we are able to completely parse the sample ABC tune I posted several days ago. (Naturally they'll be the trickiest, I imagine.)

grammar ABC
{
    regex header_field_name { \w }
    regex header_field_data { \N* }
    regex header_field { ^^ <header_field_name> ':' \s* <header_field_data> $$ }
    regex header { [<header_field> \n]+ }

    regex basenote { <[a..g]+[A..G]> }
    regex octave { \'+ | \,+ }
    regex accidental { '^' | '^^' | '_' | '__' | '=' }
    regex pitch { <accidental>? <basenote> <octave>? }

    regex tie { '-' }
    regex note_length { [\d* ['/' \d*]? ] | '/' }
    regex note { <pitch> <note_length>? <tie>? }
    
    regex rest_type { <[x..z]> }
    regex rest { <rest_type> <note_length>? }
    
    regex gracing { '+' <alpha>+ '+' }
    
    regex broken_rhythm_bracket { ['<'+ | '>'+] }
    regex broken_rhythm { <note> <g1=gracing>* <broken_rhythm_bracket> <g2=gracing>* <note> }
    
    regex element { <note> | <broken_rhythm> | <rest> | <gracing> }
    
    regex barline { '|' | ':|' | '|:' | ':|:' | '::' }
    
    regex line_of_music { <barline> | [<barline>? <element>+ [<barline> <element>+]* <barline>?] }
}

Much, much nicer than just having "abc_" at the beginning of every regex name. And wow, compared to any other parsing tool I've ever used, this is really, really easy. This comes very close to matching the ABC BNF, though I've simplified a lot, and changed !trill! to +trill+ (etc) to match the version of ABC present in this file.

So far the only downside I've found is that it is ugly to test:

{
    my $match = "d'+p+<<<+accent+_B" ~~ m/ <ABC::broken_rhythm> /;
    isa_ok $match, Match, '"d+p+<<<+accent+_B" is a broken rhythm';
    is $match<ABC::broken_rhythm><note>[0]<pitch><basenote>, "d", 'first note is d';
    is $match<ABC::broken_rhythm><note>[0]<pitch><octave>, "'", 'first note has an octave tick';
    is $match<ABC::broken_rhythm><note>[0]<pitch><accidental>, "", 'first note has no accidental';
    is $match<ABC::broken_rhythm><note>[0]<note_length>, "", 'first note has no length';
    is $match<ABC::broken_rhythm><g1>[0], "+p+", 'first gracing is +p+';
    is $match<ABC::broken_rhythm><broken_rhythm_bracket>, "<<<", 'angle is <<<';
    is $match<ABC::broken_rhythm><g2>[0], "+accent+", 'second gracing is +accent+';
    is $match<ABC::broken_rhythm><note>[1]<pitch><basenote>, "B", 'second note is B';
    is $match<ABC::broken_rhythm><note>[1]<pitch><octave>, "", 'second note has no octave';
    is $match<ABC::broken_rhythm><note>[1]<pitch><accidental>, "_", 'second note is flat';
    is $match<ABC::broken_rhythm><note>[1]<note_length>, "", 'second note has no length';
}

On the plus side, this does show how to get at the parsed bits. On the downside, it's not really good at testing what is not present in the match, and it seems like any refactoring to the grammar will lead to massive changes in the tests. I'm guessing there will be a better way of testing this in the future... or there already is and I just don't know about it.

At this point, it seems to me the biggest obstacle is figuring out how to formulate line_of_music so that it actually returns its results in a usable matter. The thing is, the interleaved order of the barlines and the elements is very important to make sense of the music. The way I'm doing it now will return an array of barlines and an array of elements, with no idea how those two arrays interact....

Ack: Forgot to include mention of the word Perl here so it would get picked up by Ironman.

Regexes are Wow

2009-12-16T05:52:00.000-08:00

I've just spent the last little bit playing around with adding more regexes, and I think I'm in love. It feels both easier to use than Perl 5 regular expressions and vastly more powerful. Here's the latest batch I just added:

regex abc_basenote { <[a..g]+[A..G]> }
regex abc_octave { \'+ | \,+ }
regex abc_accidental { '^' | '^^' | '_' | '__' | '=' }
regex abc_pitch { <abc_accidental>? <abc_basenote> <abc_octave>? }

regex abc_tie { '-' }
regex abc_note_length { [\d* ['/' \d*] ] | '/' }
regex abc_note { <abc_pitch> <abc_note_length>? <abc_tie>? }

The only difficulty I had here was not realizing at first that abc_basenote needed angle brackets around the character class specification. That caused me a few minutes of confusion, because I was trying to jump to (informally) testing more complex things built up around it, and so it wasn't immediately obvious that the base note regex was simply not working.

But hey, I know how that works now, and wow! The rest of it was dead easy and expressive to boot. And using .perl to dump the match structure is awesome.

There are two things to ponder here, however. First, having abc_ at the beginning of every regex is an obvious wart. I think I can get around that by putting these in a grammar? Must investigate.

The second is that at this point, I've got enough structure to what I'm doing that I really need a test suite. I suppose if I package the regexes in a grammar, then I can use it from another file, and test that? Must experiment.

Getting Started with ABC

2009-12-16T00:59:00.000-08:00

So, in classic style, I've started off this project by just flailing around a bit. My first thought was to try TDD. But I very quickly realized I didn't have the first clue what the interface being tested should look like. So I dashed off the roughest idea for some classes. But I don't know how they are best filled. So I am reversing course, and will start by playing around with regexes a bit, trying to learn how the new facilities in Perl 6 work.

So my real starting point is pulling up The Book and reading up on regexes. No pretense I understand what's going on, let me just document what happens as I go along. BTW, this project is at github.

So, my first attempt looked like this:

use v6;

my $abc = q¬´X:64
T:Cuckold Come Out o' the Amrey
S:Northumbrian Minstrelsy
M:4/4
L:1/8
K:D
A/B/c/A/ +trill+c>d e>deg | GG +trill+B>c d/B/A/G/ B/c/d/B/ |
A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 ::
g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ | 
g/f/e/d/ c/d/e/f/ gc e/f/g/e/ | dB/A/ gB +trill+A2 +trill+e2 :|¬ª;

regex abc-header-field { ^^ \w ':' .* $$ }
regex abc-header { <abc-header-field>+ }

if $abc ~~ m/ <abc-header-field> /
{
    say $<abc-header-field>;

Note how I'm trying to get with the program and use dashes in my Perl 6 identifiers! Unfortunately, this doesn't actually work in this case:


Confused at line 15, near "abc-header"
in Main (file , line )

I played around a bit, and finally ended up changing the dashes to underscores. Changed that way it runs, but say $<abc_header_field>; prints out the entire string rather than just the first header field I had expected.

Aha! Apparently the .* $$ sequence in abc_header_field doesn't give you every up to the end of the line, as I'd expected. Instead it matches all characters (including newlines) up until it hits the end of the file, then backtracks until it finds the last end-of-line. Good to know. Changing it to \N* $$ works nicely.

Now I tried making it match abc_header instead of abc_header_field. No joy, we still just get the first header line. Why? Because we aren't matching the newlines between header lines! So tweak abc_header to account for the newlines, and bingo!

regex abc_header_field { ^^ \w ':' \N* $$ }
regex abc_header { [<abc_header_field> \n]+ }

if $abc ~~ m/ <abc_header> /
{
    for $<abc_header><abc_header_field> -> $line
    {
        say "header: $line";
    }

And here are the new results:


header: X:64
header: T:Cuckold Come Out o' the Amrey
header: S:Northumbrian Minstrelsy
header: M:4/4
header: L:1/8
header: K:D

Wow. After a couple of false starts, I've got some simple, powerful code there. I think I like these regexes...

Updated: Ugh, some weird formatting issues with the Perl 6 syntax highlighter. Too tired to mess around with now. Rest assured that there is a closing curly bracket in each example code.

Intro to ABC

2009-12-11T17:26:00.000-08:00

So, the ABC format is a simple ASCII format designed primarily to make it easy to work with single line musical notation. It's great for, say, traditional dance tunes, like this tune from Northumberland.


X:64
T:Cuckold Come Out o' the Amrey
S:Northumbrian Minstrelsy
M:4/4
L:1/8
K:D
A/B/c/A/ +trill+c>d e>deg | GG +trill+B>c d/B/A/G/ B/c/d/B/ |
A/B/c/A/ c>d e>deg | dB/A/ gB +trill+A2 +trill+e2 ::
g>ecg ec e/f/g/e/ | d/c/B/A/ Gd BG B/c/d/B/ | 
g/f/e/d/ c/d/e/f/ gc e/f/g/e/ | dB/A/ gB +trill+A2 +trill+e2 :|

My favorite ABC program renders that like this (click on it for a high resolution version):

So, my goal here is to write a Perl 6 module that can read and understand this format, maybe do some light processing, and output it again. I'm hoping a grammar will make this pretty easy and straightforward, but I'm fairly ignorant of them so far. It will be an adventure!

I guess my first step is to set up a class to represent a tune, and then write some tests for it. Next time...

NUBS and Polynomials, with graphic

2009-12-09T20:04:00.000-08:00

As has happened before, while putting the finishing touches on the code for this post, I suddenly realized I needed to rewrite the code before I could be happy with it. So this post will be devoid of Perl 6 code, and just discuss what is going on in the (now-improved) graphic.

The basic idea I'm illustrating here is that a NUBS curve is basically a convenient way of merging a series of partial polynomial curves. In this graphic, the NUBS curve is in black. The polynomials are in red, green, and blue.

If you start where the red doesn't overlap the black, and then follow it to the black and follow the black beyond that, you can trace the curve and get an idea of what is going on. Basically, the black NUBS curve follows one section of the red polynomial, then smoothly switches to a section of the green polynomial, and finally switches to a section of the blue polynomial. It is piecewise polynomial, in other words, with smooth transitions. (It is possible to generate unsmooth transitions too with a NUBS, or even out-and-out discontinuities, but generally this is not wanted.)

The other great thing about NUBS is how natural they are to specify, because their control points conform roughly to the shape of the curve, and modifying them changes the curve in a fairly natural fashion. I don't have time to go into great depth here, but here's a quick comparison. First, here's the code to specify the curve in the picture:


my @control_points = (Vector.new(-1, -2),
                      Vector.new(1, 0),
                      Vector.new(1, 1),
                      Vector.new(0, 1),
                      Vector.new(1, 2),
                      Vector.new(1, 2),
                      Vector.new(1, 2));
my @knots = (-1, -1, -1, -1, 1, 2, 2, 3, 3, 3, 3);
my Nubs $nubs = Nubs.new(3, KnotVector.new(@knots), @control_points);

Then here's the red polynomial:


(0.194444444444444, 0.111111111111111) x^3 
+ (-0.916666666666667, -0.666666666666667) x^2 
+ (0.583333333333333, 1.33333333333333) x^1 
+ (0.694444444444444, 0.111111111111111) x^0

Actually, that's a fairly clean polynomial in this case, but even so, it's hard to work with. The bit we're interested in is parameterized from -1 to 1, so for instance, to find the starting point we need to evaluate the polynomial at x = -1:


- (0.194444444444444, 0.111111111111111)
+ (-0.916666666666667, -0.666666666666667) 
- (0.583333333333333, 1.33333333333333) 
+ (0.694444444444444, 0.111111111111111)
= (-1, -2)

Whereas the starting point of the NUBS version is just the first control point.

Ack. I could go on, but I fear I've exhausted the patience of the Perl readers out there. And I feel like I'm constantly butting up against the limits of Rakudo with this project, so I think I'll put it aside for a few months and tackle something else. Maybe try to whip up a grammar for ABC files, or something like that. Then return to Vector when after Rakudo has had a chance to mature a bit more...

Ack in TextMate

2009-12-03T18:25:00.000-08:00

For a while now I've known about ack, the slick grep substitute written in Perl. And I've known that the multi-file search function in TextMate was lousy, slow and memory-eating.

What I didn't know was that there was an Ack bundle for TextMate. It is a dream come true as far as I'm concerned. Okay, I've only briefly played with it, but it's screamingly fast and produces good-looking results. If there's a better add-on for TextMate, I don't know about it.

Good Thing Perl is Dead

2009-12-02T05:51:00.000-08:00

PerlPilot comments that the "Perl is dead" meme annoys him. Personally, considering the apparent exponential growth in Perl-related Advent calendars this year, I think it's a good thing Perl is dead. If this is dead, a living Perl community would probably overload the Internet with Advent calendar traffic...

Wiktory!

2009-11-27T14:35:00.000-08:00

Rakudo has been fixed, and the code I've been trying to get work for a month works beautifully now! If I understand the fix properly, the problem was in Rat addition's call to Rat.new. The code was very dumb, so it always tried set the denominator of the new Rat to the product of the denominators of the two numbers being added. Rakudo's Ints are really Int32 right now (more or less), so if that product was equal to or greater than 2**31, it was autoconverted to Num. But the Rat.new which takes positional arguments takes Ints, so it wouldn't dispatch to that. Instead it would try to dispatch to the default autogenerated named argument form of Rat.new. But that only takes the implicit self parameter, and we were sending it self, Int, Num -- thus the "too many positional arguments: 3 passed, 1 expected" error!

Rakudo now autoconverts this case (424/61731 + 832/61731) to Num to avoid the overflow in the denominator. Obviously this is less than ideal -- a denominator of 61731 would work fine for this sum -- but it does work. And how! Gone are the mysterious crashes and errors. With the number of samples cranked up, the curves look beautiful.

Now I just need to do a bit of polishing to the output and figure out how to post it to the blog. I'm definitely feeling I've accomplished something cool in Perl 6....

PS Aha! Preview graphic, I'll explain what it means next time.

Aha!

2009-11-26T16:09:00.000-08:00

A post-Thanksgiving dinner $work debugging session left me with some spare time to poke at my SVG.pm bug: that is, the "too many positional arguments: 3 passed, 1 expected" error I got when I tried to crank up the number of samples I was taking of the curve. I finally added enough says to track the error down to the simplest of operations: @N[$i] += $temp;, where $temp was 0.00686851014887172. This wasn't one of my fancy overloaded operators, it was a basic Perl 6 numeric operator. What could go wrong?

Well, I added a bunch more stuff to the say. And it turns out we are adding two Rats, 424/61731 and 832/61731. What could go wrong?


> say 424/61731 +  832/61731
too many positional arguments: 3 passed, 1 expected

If you look into infix:<+>(Rat, Rat), it just does a naive fractional add, relying on Rat.new to reduce the fraction. The problem here is that means the denominator of our new fraction starts its life as 61731 * 61731.


> say (61731 * 61731) div 246924
No applicable candidates found to dispatch to for 'infix:div'

I'm not sure what the best approach to fixing this is. Obviously I can change my code to do Nums. But I think the first step is to file a Rakudo bug.

Euler #4

2009-11-22T18:58:00.000-08:00

draegtun had a nice post on Project Euler #4. The goal is to find the largest palindromic product of two three digit numbers, and he lists solutions in Clojure and Python and a bunch in Perl 5. There is also a Perl 6 version by trenton in euler_bench on github.

I thought I'd try my hand at a more idiomatic Perl 6 version. Here's my first attempt:

((100..999) X (100..999)).map({$^a * $^b}).grep({$_ eq $_.flip}).max.say

Unfortunately, the usual caveats apply. This blows up the current Rakudo, no doubt because without lazy lists it tries to construct a huge list entirely in memory and then collapses. Rakudo ng has lazy lists, but it doesn't have grep or max yet. So for now, this is purely a hypothetical implementation.

However, with any luck, Rakudo ng will handle this by the end of the week...

Rakudo ng has a good excuse

2009-11-19T07:06:00.000-08:00

jnthn has an interesting post on the progress and problems of Rakudo's ng branch. Looking over some of the spectest files, it seems to me that ng has a good excuse for not handling many spectest files yet. By my rough count, at least 50% of the spectest files have a "rakudo skip" directive in them, ie a test Rakduo cannot handle. Because they have no equivalent "ng skip" directive set up, ng must handle every single case that Rakduo's master branch does to qualify it for inclusion in ng's spectest. If Rakudo master similarly had no skip directive, more than half of the spectest would be eliminated! So it's not surprising that ng is having growing pains on this front.

Personally, I'm quite impressed by the progress on ng. I cannot wait until I can use Perl 6's laziness -- that's a killer feature ng already has that Rakudo master lacks.