Perl Weekly Challenge Part 8

Tags:

Perfect Numbers

So if nothing else the challenges are helping me learn new bits of number theory. For this we're looking for Perfect Numbers which are numbers where the sum of their proper divisors equals the number itself.

I'll admit my first attempt at this involved me reading that, not reading the rest of the wiki page and making a couple of simple functions :

sub proper-divisors ( Int $p ) is pure {
    (1..^$p).grep( $p %% * );   
}

sub is-perfect ( Int $p ) is pure {
    $p == [+] proper-divisors( $p );
}

Once you've got those is simply a case of checking numbers until you get 5 where is-perfect is True. Which technically works. But it takes a while. A very long while to get to number 4 (8128) and I then stopped the script and looked at the wiki page.

Time for a new plan because I'd be dead of old age before we hit the next value.

Once again I scanned the code and whipped up a nice little function.

sub perfect-from-prime( Int $p where *.is-prime ) is pure {
    return (2**($p-1)) * ((2**$p) -1 ); 
}

So with this in place the code to get the list of prefect numbers is now simple.

.say for (1..*).grep( *.is-prime ).map( { perfect-from-prime( $_ ) } )[^5];

... I'll break that down.

.say for # Call the .say method on each item in the given list 
(1..*). # An infinite range starting at one. This will be evaluated lazily
grep( *.is-prime ). # Only include prime numbers
map( { perfect-from-prime( $_ ) } ) # Get the perfect number for the prime
[^5] # Get the range of items from this list starting at 0 and up to but not including 5

Which is nice. But as the eagle eyed amoung you will note .... utterly wrong. Because perfect numbers are not generated from primes but from Mersine primes. Did I mention I'm not a mathematician.

Anyway once I worked that out the fix was simple enough. Add a new function called is-mersine. This is a simple enough thing. If you call it with a prime number ($p) where ((2**$p)-1).is-prime is true then it's True. For any other value it's False. So you could do this with a ternary operator (or just by returning $p.is-prime && ((2**$p)-1).is-prime ) but I felt like pushing the boat out...

multi sub is-mersine( Int $ ) is pure { False; }

multi sub is-mersine( Int $p where ((2**$p)-1).is-prime ) is pure { True; }

Because I love multi subs an abusing signatures. In this case I'm not checking for primeness because I'm nothing if not consistent as I know I'm going to only pass it primes... Of course here's the final code I submitted.

#!/usr/bin/env perl6

use v6;

sub perfect-from-prime( Int $p where { $p.is-prime && is-mersine( $p ) } ) is pure {
    return (2**($p-1)) * ((2**$p) -1 ); 
}

multi sub is-mersine( Int $ ) is pure { False; }

multi sub is-mersine( Int $p where ((2**$p)-1).is-prime ) is pure { True; }

#| Help
multi sub MAIN ( Bool :h($help) where *.so ) {
    say $*USAGE;
}

#| Give the first X perfect integers
multi sub MAIN ( 
    Int $x = 5 #= Number of perfect integers to return (default 5)
) { 
    .say for (0..*).grep( *.is-prime ).grep( { is-mersine( $_ ) } ).map( { perfect-from-prime($_) } )[^$x];
}

Note my wonderful consistency if is-mersine not checking for primality but perfect-from-prime is. I dunno, I guess it made sense to me at the time. Anyway this was fun, enough maths, time for some text munging.

Centering Text

So this challenge asks for a function to add spaces to a list of strings to center them. In order to do this you are going to need to know the length of the longest string. So you're going to need to loop over the list a couple of times. Once to get the length and a second to add the spaces.

Of course I found a weird way to do it :

sub center ( *@lines, :$len = max( @lines.map( *.codes ) ) ) {
    @lines.map( { "{ ' ' x ( ( $len - $_.codes ) div 2 )}$_" } );
}

So here I have a function that takes any number of positional arguments and put them in an array *@lines. I also accept an optional named parameter :$len that by default is set to the max value of getting the length of each item in @lines (yes, the one defined in the signature).

Then we use a map to create out new strings. At this point I use the upgraded string interpolation powers of Perl6 to just embed my spacing code in here ' ' x ( ( $len - $_.codes ) div 2) gives us the difference between the max length and the current string halved (rounded down) then we just use the x string repition operator.

Of course by itself that's a bit dull so lets wrap that in a MAIN block and then... run it like so cat ch-2.p6 | perl6 ch-2.p6 which gives us. 

                        #!/usr/bin/perl6

                            #! Help
    multi sub MAIN ( :help($h) where *.so ) { say $*USAGE; }

            #| Reads a list of strings from STDIN 
                    #| Outputs them centered
                    multi sub MAIN () {
                .say for center( $*IN.lines );
                                }

sub center ( *@lines, :$len = max( @lines.map( *.codes ) ) ) {
    @lines.map( { "{ ' ' x ( ( $len - $_.codes ) div 2 )}$_" } );
                                }

Isn't it pretty? The centering is a bit off of course as some of the lines start with spaces. I could probably strip those out first. But this is neat. So lets go with it.

Pages

Other Places