Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

masak (6289)

masak
  (email not shown publicly)
http://masak.org/carl

Been programming Perl since 2001. Found Perl 6 somewhere around 2004, and fell in love. Now developing November (a Perl 6 wiki), Druid (a Perl 6 board game), pls (a Perl 6 project installer), GGE (a regex engine), and Yapsi (a Perl 6 implementation). Heavy user of and irregular committer to Rakudo.

Journal of masak (6289)

Monday May 04, 2009
05:25 PM

'Et tu, bruteforce?'

[ #38924 ]

(Alternative title: "My undying love for .kv on lists")

Knuth's 'Facsicle 0a' starts with a kind of programmer's cliffhanger:

Combinatorics is the study of the ways in which discrete objects can be arranged into various kinds of patterns. For example the objects might be 2n numbers {1,1,2,2, ..., n, n}, and we might want to place them in a row so that exactly k numbers occur between the two appearances of each digit k. When n = 3 there is essentially only one way to arrange such "Langford pairs," namely 231213 (and its left-right reversal); similarly there's also a unique solution when n = 4.

He moves on to other things without divulging what the unique solution for n = 4 might be. Reading this (on a bus carrying me between cities in Sweden), I flung open a terminal window to write a one-liner to solve the problem. Don't know if Knuth intended to have that effect on the reader, but that's what happened when I read it.

My one-liners are infamously long. Here's what I arrived at:

# Generate all possible permutations of the list @a. The list @prefix
# assists in the recursion, adding its elements before the reordered
# elements of @a.
sub all-possible-orderings(@a, @prefix=[]) {
    return [@prefix] unless @a.elems;
    return gather for @a.kv -> $k, $v {
        my @others = @a[0..^$k, $k^..^*];
        take all-possible-orderings(@others, [@prefix, $v]);
    }
}

# Returns True if and only if the list @a satisfies the
# Langford property, i.e. each pair of numbers $n has
# exactly $n other numbers between them.
sub langford(@a) {
    for 1..@a/2 -> $n {
        for @a.kv -> $k1, $v1 {
            if $v1 == $n {
                for @a[$k1^..^*].kv -> $k2, $v2 {
                    return False if $v2 == $n != $k2;
                }
            }
        }
    }
    return True;
}

.join.say for all-possible-orderings([1,1,2,2,3,3]).grep({ langford($_) }).uniq;

This code worked well for n = 3, but for n = 4 it just sat there. Kind of fitting, since the remainder of the Facsicle was about the futility of brute force, more or less. Kind of drove the point home, my PDF reader in the foreground saying things like "A single good idea can reduce the amount of computation by many orders of magnitude", while the perl6 process in a window behind it chewed up all my cycles and all my memory.

So I gave it another go.

# Generates a list of all permutations of the list @candidates
# satisfying the Langford property.
sub langford(@candidates, @slots = [0 xx 2*@candidates]) {

    return [@slots] if all @slots;

    my @found;

    for @candidates -> $c {
        for @slots[0..@slots-$c-2].kv -> $k, $v {
            if !$v {
                if !@slots[$k+$c+1] {
                    my @new-slots = @slots;
                    @new-slots[$k, $k+$c+1] = $c, $c;
                    push @found, langford( (grep { $_ != $c }, @candidates),
                                           @new-slots );
                }
                last;
            }
        }
    }

    return @found;
}

.join.say for langford 1..4;

(moritz++ for the nice line return [@slots] if all @slots; where I had previously used a grep.)

Notice how this solution, besides being faster, is also shorter, simpler, and more fun at parties. It does the n = 4 case in a jiffy, and the n = 7 and n = 8 cases with some hesitation. It could probably easily go higher than that without blowing the stack, but time starts to become the limiting factor at this point.

Anyway, a fun afternoon experiment. It's 2009, and I'm solving combinatorics puzzles in Perl 6. Cool!

(Oh, and it's 23421314, in case you were wondering too.)

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • given his track record http://en.wikipedia.org/wiki/Concrete_Mathematics [wikipedia.org], I suspect Knuth intended either that (brute force coding) or a search for an elegant yet constructive proof.
    --
    Bill
    # I had a sig when sigs were cool
    use Sig;
  • Use a function that takes a position and a set of as-yet-unplaced numbers. The position is the first slot that might be free. The function finds the first slot that really is free, and then for each unplaced number tries to place it (also trying to place its pair k+1 positions later). If there are additional unplaced numbers recurse, else you have a solution. (To eliminate the reversed pairs, only print the result if the first number is lower than the last.) You have to remove the the numbers that were

    • Use a function that takes a position and a set of as-yet-unplaced numbers. The position is the first slot that might be free. The function finds the first slot that really is free, and then for each unplaced number tries to place it (also trying to place its pair k+1 positions later). If there are additional unplaced numbers recurse, else you have a solution.

      You've just described my second, non-bruteforce solution given in the post. Did you read it?

      (To eliminate the reversed pairs, only print the result if the first number is lower than the last.)

      Nice idea. Didn't think of that.

      I implemented that on the train last night (but then didn't bring it with me today). It found the unique solutions for 3 and 4, found that there were no solutions for 5 and 6, and found a dozen or two (I didn't count them) solutions for 7 - all of these cases came back with no noticeable delay.

      Then I conclude that your algorithm was not in Perl 6. :)

      • [...]

        You've just described my second, non-bruteforce solution given in the post. Did you read it?

        Well, I looked at it, but didn't figure out what it was doing.

        [...] - all of these cases came back with no noticeable delay.

        Then I conclude that your algorithm was not in Perl 6. :)

        Nope Perl 5 (and that's probably why I didn't figure out what your solution was doing :-)

        • [...]

          You've just described my second, non-bruteforce solution given in the post. Did you read it?

          Well, I looked at it, but didn't figure out what it was doing.

          [...] - all of these cases came back with no noticeable delay.

          Then I conclude that your algorithm was not in Perl 6. :)

          Nope Perl 5 (and that's probably why I didn't figure out what your solution was doing :-)

          If you find the tuits, it would be interesting to hear what you conclude from a comparison of our two approaches.

          Of course, if some particular piece of strange syntax blocks such an endeavor, I'd be very happy to explain the syntax rather than have you trawl the synopses for enlightenment.

          • [...]

            You've just described my second, non-bruteforce solution given in the post. Did you read it?

            Well, I looked at it, but didn't figure out what it was doing.

            [...] - all of these cases came back with no noticeable delay.

            Then I conclude that your algorithm was not in Perl 6. :)

            Nope Perl 5 (and that's probably why I didn't figure out what your solution was doing :-)

            If you find the tuits, it would be interesting to hear what you conclude from a comparison of our two approaches.

            Of course, if some particular piece of strange syntax blocks such an endeavor, I'd be very happy to explain the syntax rather than have you trawl the synopses for enlightenment.

            The tuits will take a couple of days. I'll post my perl5 code then too for comparison.

          • Your solution does a lot of array copy/filter'ing that mine avoids.  That's not a fault with Perl6, though. :-)

            Also, I think yours is still algorithmically slower than mine.  You try every number in every place.  I try every number in the first place, then trying the remaining numbers in the remaining places (not all places).

            So, the comparison here is not between Perl5 and Perl6, but coding with always using array ops, and sometimes using individual elements.

            I have to go to 9 and 10 to get a