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

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.
  • 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.

          • 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 user-noticeable elapsed time, but then it starts to take off.  (From the size of the numbers, it is looking like the time is somewhat less than O(n**2), but definitely greater than O(n).

            $ time ./langford.pm 9

            real    0m0.203s
            user    0m0.200s
            sys    0m0.000s
            $ time ./langford.pm 10

            real    0m1.091s
            user    0m1.088s
            sys    0m0.000s
            $ time ./langford.pm 11 | tail -2
            17791    10, 8, 5, 2, 9, 6, 2, 7, 5, 11, 8, 10, 6, 4, 9, 7, 3, 1, 4, 1, 3, 11
            17792    10, 8, 5, 3, 7, 9, 6, 3, 5, 11, 8, 10, 7, 6, 4, 9, 1, 2, 1, 4, 2, 11

            real    0m7.492s
            user    0m7.488s
            sys    0m0.012s
            $ time ./langford.pm 12 | tail -2
            108143    11, 9, 6, 4, 2, 10, 8, 2, 4, 6, 12, 9, 11, 5, 7, 8, 10, 3, 1, 5, 1, 3, 7, 12
            108144    11, 9, 6, 4, 2, 10, 8, 2, 4, 6, 12, 9, 11, 7, 5, 8, 10, 1, 3, 1, 5, 7, 3, 12

            real    0m53.187s
            user    0m53.155s
            sys    0m0.048s
            $ time ./langford.pm 13 | tail -2

            real    6m39.064s
            user    6m38.705s
            sys    0m0.044s

            It's interesting that you can get a hundred thousand solutions for k==12, and none for k==13.

            And here's my Perl 5 code:

            #!/usr/bin/perl

            use strict;
            use warnings;

            my $n = shift;

            ($n =~ /^\d+$/) && $n > 2
                or die "Usage: $0 <num>   # num > 2\n";

            my @result = ( 0 ) x (2*$n);
            my $found = 0;
            my $n2 = $n*2;

            try( 0, 1..$n );

            sub try {
                my( $pos, @nums ) = @_;

                while( $result[$pos] ) {
                    return if ++$pos == $n2;
                }

                my $tries = @nums;

                while( $tries-- ) {
                    my $guess = shift @nums;
                    my $otherpos = $pos+$guess+1;
                    return if $otherpos >= $n2;
                    unless( $result[$otherpos] ) {
                        $result[$pos] = $result[$otherpos] = $guess;
                        if( @nums ) {
                            try( $pos+1, @nums );
                        }
                        elsif( $result[0] < $result[-1] ) {
                            print ++$found, "\t", join( ', ', @result ), "\n";
                        }
                        $result[$pos] = $result[$otherpos] = 0;
                    }
                    push @nums, $guess;
                }
            }