## Ryan Thompson › Perl Weekly Review #164

Tuesday, Jun 28, 2022| Tags: perl

Continues from previous week.

Ryan Thompson with you this week. I’m back doing reviews temporarily to help Colin out, so expect to see both of us in the weeks to come!

Welcome to the Perl review for Week 164 of the Weekly Challenge! For a quick overview, go through the original tasks and recap of the weekly challenge.

## Getting in Touch

Email › Email me (Ryan) with any feedback about this review.

GitHub › Submit a pull request for any issues you may find with this page.

Twitter › Join the discussion on Twitter!

We’d greatly appreciate any feedback you’d like to give.

# Task #1 - Prime Palindrome

## Original description

Write a script to find all prime numbers less than 1000, which are also palindromes in base 10. Palindromic numbers are numbers whose digits are the same in reverse. For example, 313 is a palindromic prime, but 337 is not, even though 733 (337 reversed) is also prime.

## Commentary

We’ve looked at prime numbers and palindromes separately on several occasions, so these concepts aren’t new to most team members in the Challenge. Most people seemed to converge on the idea that if they can generate (or test) prime numbers, it’s then a simple matter to test whether each prime is also a palindrome. That being said, we’ll see a few variations on this theme!

When it came to testing for palindromes, there was a clear winner, at least in terms of popularity. The builtin `reverse` function will reverse a string, when called in scalar context. If a string (including a number being represented as a string) is equal to itself in reverse, it’s a palindrome.

That’s certainly not the only way to do it, though, so keep your eye out for a few unique approaches.

## Stats

• Number of submissions: 31

• Total SLOC: 885

• Average SLOC: 28

Adam Russell’s solution uses `Math::Primality`‘s `is_prime()` function to test for primes. To test for a palindrome, Adam uses a variation on the scalar `reverse` method. When called in list context, `reverse` reverses the elements of that list, as one might expect. So, Adam first `split`s the string into a character list, then `reverse`s that list, then `join`s it back together. :

``````sub palindrome_primes_under{
my(\$n) = shift;
my @palindrome_primes;
{
\$n--;
unshift @palindrome_primes, \$n if(is_prime(\$n) && join("", reverse(split(//, \$n))) == \$n);
redo if \$n > 1;
}
return @palindrome_primes;
}
``````

Adam also provided a Prolog solution, which he blogged about as well:

BlogPerl

BlogProlog

## Alexander Pankoff

Alexander Pankoff’s solution looks a lot like Adam’s, but Alexander uses his own modules he’s built up from previous challenges.

``````use My::Prime::Util qw(is_prime);
use My::String::Util qw(is_palindromic);

run() unless caller();

sub run() {
say join( "\n", grep { is_palindromic(\$_) && is_prime(\$_) } 0 .. 1000 );
}
``````

You’ll notice the basic check is there: if a number is palindromic and prime, it’s a winner!

## Arne Sommer

Arne Sommer’s solution relies on `Math::Prime::Util` and scalar `reverse` for the palindromic check:

``````for my \$current (1 .. \$limit -1)
{
next unless is_prime(\$current);
next unless \$current eq reverse(\$current);

push(@result, \$current);
}
``````

## Athanasius

Athanasius’s solution starts off with a POD comment outlining some observations, and the overall algorithm they will employ.

Here’s the high level logic:

``````    my \$primes = get_primes();
my @pr_pals;

for my \$prime (@\$primes)
{
push @pr_pals, \$prime if is_palindrome( \$prime );
}
``````

The `get_primes()` sub uses a Sieve of Eratosthenes to generate a list of prime numbers. However, there’s a twist! Athanasius quotes David Wasserman in OEIS A002385:

Every palindrome with an even number of digits is divisible by 11, so 11 is the only member of the sequence with an even number of digits.

``````    @primes = grep { \$_ == 11 || length != 2 } @primes;
``````

From there, `@pr_pals` will hold the result. Athanasius then loops over the list of `@\$primes` and includes every such prime that also `is_palindrome()`, similar to logic we’ve seen from other solutions.

The `is_palindrome()` function is very explicit in its check of each pair of digits:

``````sub is_palindrome {
my (\$n)     = @_;
my  @digits = split '', \$n;

for my \$i (0 .. int( scalar( @digits ) / 2))
{
return 0 unless \$digits[ \$i ] == \$digits[ \$#digits - \$i ];
}

return 1;
}
``````

I really like the amount of thought Athanasius has put into this solution.

## Cheok-Yin Fung

Cheok-Yin Fung’s solution is a refreshingly cheeky one-liner:

``````map {  print "\$_\n" if (1 x \$_) !~ /^1?\$|^(11+?)\1+\$/ && \$_ eq scalar reverse \$_ } 1..1000
``````

Looking a little closer at that regex, it looks familiar to me, and Cheok-Yin immediately confirms my suspicion with the following comment: “using Abigail’s regex to test for prime numbers”. If you’ve never seen this bit of obfuscated Perl lore, you’re in for a treat. Here’s a detailed analysis.

So that’s the prime number test handled. Cheok-Yin then uses the `scalar reverse` check for palindromes.

## Colin Crain

Colin Crain’s solution starts with a suitably svelte Sieve of Eratosthenes:

``````sub sieve (\$limit) {
my @s = (1) x \$limit;
@s[0,1] = (0,0);
for my \$f (2..sqrt(\$limit)) {
\$s[\$f * \$_] = 0 for \$f..\$limit/\$f;
}
return grep { \$s[\$_] } (0..\$limit);
}
``````

This `sieve` function returns a list of primes up to a maximum of `\$limit`. Colin then feeds that list through a `grep` regex to filter out anything that isn’t also a palindrome:

``````say \$_ for grep { /^(.*).?(??{reverse(\$1)})\$/ } sieve(\$input);
``````

The regex is interesting in that it matches part of the string, and then insists that the remainder of the string must match `??{reverse(\$1)}` (in other words, the second half must be the reverse of the first half). There’s an optional character in the middle, for the case of odd-length numbers.

The `??{ code }` syntax is called a postponed regular subexpression. This is a fancy way of saying, “Perl will run your code, and then feed it back in to the regex engine as a new subexpression,” so the code’s output can contain a pattern.

It’s a clever way of doing things, for sure. The backtracking Perl will perform means `reverse(\$1)` will be called n/2 times, where n is the length of the string. I don’t care, though. It’s fun, and I like it.

## Dave Jacoby

Dave Jacoby’s solution uses a home-grown `is_prime()` function that uses trial division:

``````sub is_prime (\$n) {
return 0 if \$n == 0;
return 0 if \$n == 1;
for ( 2 .. sqrt \$n ) { return 0 unless \$n % \$_ }
return 1;
}
``````

Dave then loops over integers between 1 and 1000, printing out those that pass an `is_prime()` check and a `reverse` palindrome check:

``````say join "\n",
grep { \$_ eq reverse \$_ }
grep { is_prime(\$_) }
1 .. 1000;
``````

Dave’s blog is—as always—a good read. In it, he also provides a one-liner with `Math::Prime::Util`:

``````perl -MMath::Prime::Util=is_prime -e 'print join "\n", grep { \$_ eq reverse \$_} grep { is_prime(\$_) } 1..1000'
``````

Ali Moradi’s solution is another good example of a trial division `is_prime()` function and string reverse palindrome check:

``````sub is_prime{
my (\$n) = @_;
if (\$n <= 1) { return 0; }
foreach(2..sqrt(\$n)) {
return 0 if \$n % \$_ == 0;
}
return 1;
}

foreach(1..1000){
print "\$_ " if (\$_ == reverse \$_) && (is_prime(\$_));
}
``````

## Duncan C. White

Duncan C. White’s solution uses his own `MakePrimes` module, which is a standard sieve. It is code he has re-used in the Challenge at least 14 times, with the first instance I could find being all the way back in week 22! The palindrome check is our old friend, `\$x eq reverse(\$x)`:

``````use lib qw(.);
use Function::Parameters;
use MakePrimes;

my \$n = shift;

fun ispalindrome( \$x )
{
return \$x eq reverse(\$x) ? 1 : 0;
}

my @primes = primes_upto( \$n );

say "Palindromic primes up to \$n";
say for grep { ispalindrome(\$_) } @primes;
``````

## E. Choroba

E. Choroba’s solution uses `Math::Prime::Util`‘s `forprimes` subroutine to efficiently loop through a list of primes. That subroutine accepts a code block that is run for every prime in the specified range. Choroba `push`es the number to a result list if that number passes the familiar `\$_ == reverse` palindrome test:

``````use Math::Prime::Util qw{ forprimes is_prime };

sub prime_palindrome {
my @pp;
forprimes { push @pp, \$_ if \$_ == reverse } 999;
return \@pp
}
``````

## Jaldhar H. Vyas

Jaldhar H. Vyas’s solution starts off with an `isPrime()` function that uses trial division. Jaldhar then loops over all numbers from 1..1000 and returns those that are prime and palindromic:

``````say join q{ }, grep { isPrime(\$_) && \$_ == reverse \$_ } 1 .. 1000;
``````

## James Marquis

James Marquis’s solution is interesting in that it works in several discrete stages. Here is the initialization:

``````use Math::Prime::Util  qw(:all);
my @start = ();
my @start2 = ();
my @start3 = ();
my @factors = ();
@start = (10..\$ARGV[0]);
print "You entered \$ARGV[0]\n"; # Shown at the end as well
@start2 = grep /\b[1379]\d*[1379]\$/, @start;
@start3 = grep {\$_  if is_prime(\$_)} @start2;
``````

Already here, we can see `@start` is populated with all 2+ digit numbers in range. `@start2` is a simple filter that takes advantage of the fact that prime numbers (other than 2) end in 1, 3, 7, or 9 (and if they’re palindromic, they must begin with one of these numbers as well). James could have included a stronger test here, to ensure the first digit matched the last, but it’s not really necessary at this stage. Finally, `@start3` filters for prime numbers, using `Math::Prime::Util`.

Next up, James loops over `@start3`:

``````foreach (@start3){
print "\$_\n" if  is_prime(\$_);
my \$rev = reverse \$_;

@factors = factor(\$rev);
print"Reverse of \$_ is \$rev has factors @factors .\n" unless is_prime(\$rev);
}

print "The range requested was  10 to \$ARGV[0].\n";
``````

While James hasn’t filtered out non-palindromes here, he was on the right track with `reverse`.

## James Smith

James Smith’s solution uses `Math::Prime::Util` for primality testing, and `reverse` to check for palindromes, with a twist:

``````my (\$p,\$lim,@pal)=(1,shift//1e3);

(\$p ^ reverse \$p) || (push @pal,\$p) while (\$p=next_prime \$p) < \$lim;
``````

There is a fair bit of potential confusion for the unwary, packed into that second line.

Even though James uses `reverse` to reverse the string, Perl will treat the result as a number for the `^` operator, meaning, we’re seeing a bitwise XOR here. When A and B are equal, A ^ B == 0 (false), and when A and B differ, A ^ B != 0 (true).

The `||` (or) logic is tricky as well. At first glance, you might think the `push(...) while` loop is always run, but it isn’t, because the `||` operator short circuits when the left hand side is true. Therefore, when A ^ B is true (that is, when the numbers are not equal), the right hand side (the `push`) is not run. Or with fewer double negatives: the number is `push`ed to the results only when it is equal to its reverse (a palindrome).

These sorts of hacks always bring a smile to my face in the Weekly Challenge context, as they would be right at home in code golf or obfuscation challenges.

## Jorg Sommrey

Jorg Sommrey’s solution uses `Math::Prime::Util`'s `todigits` and `fromdigits` functions, which are efficient alternatives to the usual `split` and `join`, and they support arbitrary bases, too. I often overlook these functions myself, so this is a great reminder!

Jorg also uses `Syntax::Keyword::Gather` as a Perl 5 implementation of Raku’s `gather` / `take` keywords, which in this case replace the typical `push @result, \$p` gather step.

The actual loop here uses the `prime_iterator` function, so every time `\$p = \$pi->()` is called, `\$p` is the next prime.

Finally, we see a variant of the usual `reverse` method. However, this is where `fromdigits` and `todigits` come into the picture, to compare in any `\$base`.

Without further ado, here is Jorg’s main `prime_palindrome()` sub:

``````use Math::Prime::Util qw(fromdigits todigits prime_iterator);
use Syntax::Keyword::Gather;

# Collect all prime palindrome numbers in base \$base not larger than \$n
sub prime_palindrome (\$n, \$base) {
gather {
my \$pi = prime_iterator;
while ((my \$p = \$pi->()) <= \$n) {
take \$p if \$p == fromdigits [reverse todigits \$p, \$base], \$base;
}
}
}
``````

## Julien Fiegehenn

Julien Fiegehenn’s solution starts off with a hard-coded array of `@primes` below 1000. We’ve already done so much work with prime numbers I think we can take for granted Julien knows at least a few ways to generate such a list.

The loop that generates the prime palindromes will look familiar:

``````foreach my \$number (@primes) {
say \$number if \$number eq reverse \$number;
}
``````

## Kjetil Skotheim

Kjetil Skotheim’s solution splits out the prime and palindrome functionality into two subs, which work with regexes (or regexen, if you like):

``````sub is_palindromic { local \$_ = shift//\$_;        /^((.)(?1)\2|.?)\$/ }
sub is_prime       { local \$_ = 1 x (shift//\$_); !/^1?\$|^(11+?)\1+\$/ }
``````

You’ll recognize Abigail’s prime number regex from earlier. The palindrome regex is identical to one posted to Stack Overflow.

Notice how it uses a recursive subpattern `(?1)` followed by the `\2` which matches the whole recursive part. The recursion itself will ensure the subpattern is reversed.

``````print join' ', grep is_palindromic && is_prime, 1..999;
print "\n";
``````

Running this solution on primes below 1000 is quick, but asking it to find the next set (below 100000; there are no palindromic primes between 1000..10000) spins up my fans for 19 seconds.

## Laurent Rosenfeld

Laurent Rosenfeld’s solution returns us to some semblance of normalcy with a familiar `is_prime` and `reverse` solution:

``````say map "\$_ ", grep { is_prime \$_} grep {\$_ == reverse \$_} 1..999;
``````

## Lubos Kolouch

Lubos Kolouch’s solution uses `Math::Prime::Util` to generate primes, and defines an `is_palindrome` function for the palindrome testing:

``````sub is_palindrome {
my \$what = shift;

return \$what eq reverse \$what;
}
``````

## Luiz Felipe

Luiz Felipe’s solution gives us a character-by-character `is_palindrome`:

``````sub is_palindrome {
my (@number, \$reverse);

@number = split //, shift;
\$reverse = "";

for (my \$i = \$#number; \$i >= 0; \$i--) {
\$reverse = \$reverse . \$number[\$i];
}

return \$reverse eq join '', @number;
}
``````

Luiz’s `is_prime` works by trial division:

``````sub is_prime {
my (\$number);

\$number = shift;

return 0 if \$number == 0 or \$number == 1;

for (my \$i = 2; \$i <= \$number / 2; \$i++) {
return 0 if (\$number % \$i == 0);
}

return 1;
}
``````

## Matthew Neleigh

Matthew Neleigh’s solution generates primes with a Sieve of Eratosthenes. Interestingly, however, instead of returning an array or hash, Matthew returns a string, with the nth character being set to 1 if and only if n is prime.

Matthew notes this is done to save memory versus using an array. Indeed, using `Devel::Size`, I found that an array of ones and zeroes takes up about 66x more memory than the equivalent string. One could take this even further with a bit map, and cut that size in half by skipping even numbers (which are always composite, except for the number 2).

The `find_palindromic_primes()` sub uses the `\$primes` result from the sieve to generate a list of `@palindromic_primes`. Beware, `\$primes` is both the input (desired count of primes), and is then reused to store the results from the sieve:

``````sub find_palindromic_primes{
my \$primes = int(shift());

return(undef)
if(\$primes < 2);

my @palindromic_primes = ();

# Gather a quantity of prime numbers
\$primes = sieve_of_eratosthenes(\$primes);

# Loop from 2 onward...
for my \$i (2 .. (length(\$\$primes) - 1)){
if(substr(\$\$primes, \$i, 1)){
# \$i is prime; see if it's a palindrome and
# if so, store it in the list
push(@palindromic_primes, \$i)
if(reverse(split("", \$i)) == \$i);
}
}

return(@palindromic_primes);

}
``````

The palindrome test has a little bit of subtlety with list and scalar context: `reverse(split("", \$i))` splits the number and then reverses the list of digits. However, since that result is immediately being used for a scalar comparison, this puts it back into scalar context, returning a string.

The `sieve_of_eratosthenes` function returns a scalar ref rather than the scalar itself. There is no space or time efficiency for doing so, but perhaps Luiz had another motivation for using a ref here.

## Mohammad S Anwar

Mohammad S Anwar’s solution contains a nicely compact trial divison `is_prime()` function:

``````sub is_prime {
my (\$n) = @_;

return 0 if (\$n == 1);

do { return 0 unless (\$n % \$_) } for (2 .. sqrt \$n);

return 1;
}
``````

The important line in his `prime_palindrome()` function is as follows:

``````        my \$_i = (reverse \$i) + 0;
next unless is_prime(\$i) and is_prime(\$_i);
``````

Can you see a difference here, compared to other solutions? Mohammad isn’t generating prime palindromes, he’s generating emirps!

What the heck is an “emirp”? An emirp (prime spelled backwards) is a number that gives a different prime when the digits are reversed. Technically, 11 isn’t an emirp, because the reverse gives you the same prime.

## Niels van Dijke

Niels van Dijke’s solution uses `Math::Prime::XS` for a compact one-liner:

``````say join ', ', grep { \$_ == reverse \$_ } primes(1000);
``````

## Pete Houston

Pete Houston’s solution uses `Math::Prime::Util` and scalar `reverse`:

``````my @pp;

for my \$n (2 .. \$max) {
next unless \$n eq reverse \$n;
push @pp, \$n if \$n eq reverse \$n && is_prime (\$n);
}

print "@pp\n";
``````

This code does not return the correct output. We instead get a single number: 2. Can you spot why?

The `next unless ...` line is a red herring. That line is unnecessary, but it’s not what is messing up our output. No, it’s the following line. You’d be forgiven for thinking the order of operations in that `if` condition would be equivalent to `(\$n eq reverse \$n) && (is_prime(\$n))`, but in fact it is evaluated as `\$n eq reverse(\$n && is_prime(\$n))`!

The number 2 is the only number that passes, because `is_prime()` returns 2 if the number is definitely prime, so `2 eq reverse(2 && 2)` is true. (`is_prime()` returns 1 if a number is probably prime, which can only happen for numbers larger than 2^64).

Adding some brackets fixes the error: `\$n eq reverse(\$n) && is_prime(\$n)`. Another way to go about it is to use the loose `and`: `\$n eq reverse \$n and is_prime(\$n)`. No doubt Pete knows this and merely made a last minute adjustment that slipped through testing. I’ve definitely been there!

## Peter Campbell Smith

Peter Campbell Smith’s solution uses a nested loop to combine the logic of his trial division prime check, with the scalar `reverse` palindrome check:

``````my (%primes, \$j, \$p, \$results, \$reverse);

# discover primes
%primes = ();
OUTER: for \$j (2 ... 1000) {

# not prime if \$j divisible by a lesser prime
for \$p (keys %primes) {
next OUTER if \$j % \$p == 0;
}

# found a prime, check for palindromicity
\$primes{\$j} = 1;
\$reverse = '';
\$reverse = \$reverse . \$1 while \$j =~ m|(.)|g;
\$results .= qq[\$j, ] if \$j == reverse(\$j);
}
say qq[\nThe following are palindromic primes:\n] . substr(\$results, 0, -2);
``````

## PokGoPun

PokGoPun’s solution checks for palindromes in a different way (whitespace and comments added by me):

``````        my \$i = int(length(\$_)/2);
\$pld{\$_}++ if \$i==0
|| \$i > 0
&& \$_ =~ /^(
\d{\$i})     # \$1: First half of number
\d?         #     Middle digit if odd length
(\d{\$i}     # \$2: Second half of number
)\$/x && \$1 eq join "", reverse split //, \$2;
``````

So the regex effectively splits the number into halves (throwing away the middle digit, if there is one), and then the first half is compared to the `reverse` of the second half. Interesting.

The primality testing is done with a sieve. Instead of building up a list of primes, they `delete` any composites they find from the list of palindromes found from the previous step. Here is the sieve:

``````    foreach (2..sqrt(\$n)){
my \$i = \$_**2;
{
last if \$i > \$n;
delete \$pld{\$i};
\$i += \$_;
redo;
}
}
``````

Do you see that nested block? The `redo` will actually return to the top of that block, rather than the top of the `foreach` block! As the `redo` perldoc puts it, “a block by itself is semantically identical to a loop that executes once. Thus redo inside such a block will effectively turn it into a looping construct.” The same goes for `last`, `next`, etc. Neat, eh?

## Flavio Poletti

Flavio Poletti’s solution uses a prime number algorithm credited to Wikipedia:

``````sub is_prime { # https://en.wikipedia.org/wiki/Primality_test
return if \$_[0] < 2;
return 1 if \$_[0] <= 3;
return unless (\$_[0] % 2) && (\$_[0] % 3);
for (my \$i = 6 - 1; \$i * \$i <= \$_[0]; \$i += 6) {
return unless (\$_[0] % \$i) && (\$_[0] % (\$i + 2));
}
return 1;
}
``````

This works by ruling out some low hanging fruit, such as 0, 1, 2, 3, and multiples of 2 and 3. It then performs the so-called “6k ± 1” test to reduce the number of operations, compared to trial division.

As a side note, I wholeheartedly encourage code re-use, so I very much appreciate when people cite their sources like this, when their work is taken or derived from someone else’s.

The `is_palindrome()` check uses scalar `reverse`, as we’re very familiar with by now.

``````say join ' ', grep {is_prime(\$_) && is_palindrome(\$_)} 2 .. \$max;

sub is_palindrome (\$n) { \$n eq reverse \$n }
``````

## Robert DiCicco

Robert DiCicco’s solution uses `is_prime` and scalar `reverse`:

``````for (my \$n = 1; \$n < 1000; \$n++){
if (is_prime(\$n)) {
\$prime_rev = reverse(\$n);
if ((is_prime(\$prime_rev)) && (\$n == \$prime_rev)){
print "\$n ";
}
}
}
``````

## Roger Bell West

Roger Bell West’s solution has an interesting take on the palindrome test:

``````sub isnumpal {
my \$c0 = shift;
my \$c = \$c0;
my \$j = 0;
while (\$c > 0) {
\$j = 10 * \$j + \$c % 10;
\$c = int(\$c/10);
}
return (\$c0 == \$j);
}
``````

Rather than using `reverse` or other such string manipulation, Roger has gone at it numerically, stripping off each trailing digit with `\$c % 10` before removing it with `\$c = int(\$c / 10)`. `\$j` is built up one digit at a time. If `\$j` is equal to the initial input, it’s a palindrome. This method would be well suited for languages like C, which would then avoid the need for number conversions like `snprintf()` or the non-standard but common `itoa()`.

## Ryan Thompson

My solution uses a sieve to generate all primes under the maximum, and `scalar reverse` to check for palindromes:

``````say for grep { \$_ eq scalar reverse \$_ } primes_under( pop // 1000 );

sub primes_under {
my \$limit = shift;
my @comp; # Composite numbers (non-primes)

for my \$n (2..\$limit) {
next if \$comp[\$n];
\$comp[\$_] = 1 for map { \$n * \$_ } 2..\$limit/\$n;
}

2, grep { !\$comp[\$_] } 3..\$limit;
}
``````

## Ulrich Rieke

Ulrich Rieke’s solution has an `isPrime()` checker that uses trial division:

``````sub isPrime {
my \$number = shift ;
if ( \$number == 1 ) {
return 0 ;
}
elsif ( \$number == 2 ) {
return 1 ;
}
else {
my \$root = ceil( sqrt( \$number ) ) ;
for my \$i ( 2 .. \$root ) {
if ( \$number % \$i == 0 ) {
return 0 ;
}
}
return 1 ;
}
}
``````

Ulrich’s `isPalindrome()` uses `split//` and `reverse` in list context, `join`'d back together:

``````sub isPalindrome {
my \$number = shift ;
my @digits = split( // , \$number ) ;
return join( '' , reverse @digits ) eq \$number ;
}

say join( ',' , grep { isPrime( \$_ ) && isPalindrome( \$_ ) } (2 .. 999)) ;
``````

## W. Luis Mochan

W. Luis Mochan’s solution uses `primes` from `Math::Prime::Util` along with scalar `reverse`:

``````use Math::Prime::Util qw(primes);
say "Output: ", join ", ", grep {\$_ eq reverse} @{primes(1000)};
``````

# Task #2 - Happy Numbers

Happy Numbers are found with the following method: Starting with a positive integer, n, replace that number by the sum of the squares of its digits, and repeat that process until the number equals 1 (n is happy), or it reaches a cycle that does not equal 1 (n is unhappy). The example provided is perhaps more instructive:

``````19 => 1^2 + 9^2
=> 1   + 81
=> 82 => 8^2 + 2^2
=> 64  + 4
=> 68 => 6^2 + 8^2
=> 36  + 64
=> 100 => 1^2 + 0^2 + 0^2
=> 1 + 0 + 0
=> 1
``````

Therefore, 19 is a happy number (in base 10).

## Discussion

There are a few different solution options. The problem lends itself very well to a recursive solution, but an iterative solution will do just as well, and that’s the direction most people went.

Some people, like myself, opted for a straightforward and concise approach to calculating whether a particular number is happy or not. Others threw some more robust techniques at it, such as memoization, pre-computing, and snazzy formatting.

Somewhat surprisingly (to me, at least), the average length of solution was almost double that of task 1, even with a fair number of people including their own primality test or sieve in task 1. So let’s dive into these task 2 solutions and see what’s going on!

## Stats

• Number of submissions: 28

• Total SLOC: 1433

• Average SLOC: 51

Adam Russell’s solution starts us off happily enough:

``````sub happy{
my \$n = shift;
my @seen;
my \$pdi = sub{
my \$n = shift;
my \$total = 0;
{
\$total += (\$n % 10)**2;
\$n = int(\$n / 10);
redo if \$n > 0;
}
return \$total;
};
{
push @seen, \$n;
\$n = \$pdi->(\$n);
redo if \$n > 1 && (grep {\$_ == \$n} @seen) == 0;
}
return boolean(\$n == 1);
}
``````

This sub returns a true value if `\$n` is happy. Adam uses an anonymous sub, `\$pdi`—for Perfect Digit Invariant—to calculate the total sum of squares of digits for a given number. As with task #1, Adam uses `redo` inside of a bare BLOCK to exit the loop early. Another way to write that block would be:

``````        do {
\$total += (\$n % 10)**2;
\$n = int(\$n / 10);
} while \$n > 0;
``````

However, Adam’s blog post lets us know he is perfectly aware of his penchant for `redo`, which made three appearances in his solutions this week:

I have become incorrigible in my use of redo! The novelty just hasn’t worn off I suppose.

Adam, I always enjoy pointing interesting language features out, so be as incorrigible as you like!

Back to the `happy` function, we have another loop:

``````    {
push @seen, \$n;
\$n = \$pdi->(\$n);
redo if \$n > 1 && (grep {\$_ == \$n} @seen) == 0;
}
``````

The above block is another `redo` loop that continues looping over all sums of square digits starting from the original `\$n`, until `\$n == 1` or `\$n` is in `@seen`.

Adam then simply loops until he’s found `N` happy numbers:

``````MAIN:{
my \$i = 0;
my @happy;
{
\$i++;
push @happy, \$i if happy(\$i);
redo if @happy < N;
}
print join(", ", @happy) . "\n";
}
``````

BlogRabbitFarm (Perl)

BlogRabbitFarm (Prolog)

## Alexander Pankoff

Alexander Pankoff’s solution starts off with the following high level logic:

``````sub happy_numbers(\$n) {
my @happy_numbers = ();
for ( my \$i = 0 ; @happy_numbers < \$n ; \$i++ ) {
push @happy_numbers, \$i if is_happy_number(\$i);
}

return @happy_numbers;
}
``````

As we are asked to find the first eight happy numbers, Alexander simply loops over all numbers until `@happy_numbers` contains `\$n == 8` elements.

The `is_happy_number()` function returns true iff `\$n` is a happy number:

``````sub is_happy_number(\$n) {
my %seen;

while ( \$n != 1 ) {
return 0 if \$seen{\$n};
\$seen{\$n} = 1;
\$n = sum0( map { \$_**2 } split( m//, \$n ) );
}

return 1;
}
``````

Alexander detects loops with a `%seen` hash. Hashes are a good choice, here, since the distribution of seen values will be quite sparse, and hashes give constant time performance in Perl.

The `while` loop keeps replacing `\$n` with the sum of the squares of its digits, until `\$n == 1`. If `\$seen{\$n}` is true, Alexander `returns` to bail out. All in all, this is an efficient, clean way to go about it!

## Arne Sommer

Arne Sommer’s solution starts us off with a sum-of-digit-squares sub:

``````sub happy (\$number) {
return sum( map { \$_**2 } split( //, \$number ) );
}
``````

The remaining code loops until the number of elements in `@result` is the `\$limit`:

``````my @result;
my \$number = 0;

while ( ++\$number ) {
my \$n = \$number;
my \$i = \$delta;

while ( \$n != 1 && \$i > 0 ) {
\$n = happy(\$n);
\$i--;
}

if (\$verbose) {
\$n == 1
? say ": \$number is happy (in " . ( 100 - \$i ) . " step(s))"
: say ": \$number is not happy";
}

push( @result, \$number ) if \$n == 1;

last if @result == \$limit;
}
``````

## Athanasius

Athanasius’s solution starts off by defining a `\$CYCLE` set (via `Set::Tiny`):

``````use Const::Fast;
use Set::Tiny;

const my \$CYCLE  => Set::Tiny->new( qw[ 4 16 37 58 89 145 42 20 ] );
``````

In a code comment, Athanasius references the Wikipedia article’s observation that all base-10 numbers either terminate at 1, or end in the above cycle. Thus, if any of those numbers are seen, we can immediately conclude the number is unhappy. And that’s just what Athanasius does:

``````for ( my \$n = 1 ; scalar @happy < \$TARGET ; ++\$n ) {
my ( \$done, \$last ) = ( 0, \$n );

until (\$done) {
my \$next = sum_of_squares(\$last);

if ( \$next == 1 )               # n is happy
{
push @happy, \$n;
\$done = 1;
}
elsif ( \$CYCLE->has(\$next) )    # n is unhappy
{
\$done = 1;
}

\$last = \$next;
}
}

printf "The first %d 10-Happy Numbers:\n%s\n", \$TARGET, join ', ', @happy;
``````

I’m glad Athanasius showcased this optimization, so I could talk about it.

## Cheok-Yin Fung

Cheok-Yin Fung counts her way to happiness:

``````my \$happiness = \$ARGV[0] || 8;
my \$counter = 0;
my \$n = 1;

while ( \$counter < \$happiness ) {
if (verify_happy(\$n)) {
\$counter++;
say \$n;
}
\$n++;
}
``````

If only life were that simple!

The real heavy lifting is done by the `verify_happy` function:

``````sub verify_happy {
my \$number = \$_[0];
my @arr;
while (\$number > 999) {
@arr = split "", \$number;
\$number = sum map {\$_**2} @arr;
}

my @appeared = (\$number);
my \$loop_control = 244;  # 243 = 9**2 + 9**2 + 9**2
do {
return 1 if \$number == 1;
@arr = split "", \$number;
\$number = sum map {\$_**2} @arr;
return 0 if any {\$number == \$_} @appeared;
push @appeared, \$number;
\$loop_control--;
} while (\$loop_control>0);
return 0;
}
``````

That top while loop only runs for numbers greater than 999, to pre-run the sum of digit squares part of the algorithm until the number is three digits or less. You might worry this might result in an infinite loop if a cycle is detected before then, but Athanasius’s solution highlights why that can never happen.

The second loop repeatedly calculates the sum of square digits and returns 1 if `\$n == 1` or 0 if we’ve seen the number before. The `\$loop_control` variable, I confess, is a bit of a mystery. My educated guess is that it looks like a bit of defensive programming to prevent an infinite loop if we detect neither a cycle nor a 1, which is not possible.

## Colin Crain

Colin Crain’s solution loops until eight numbers have passed the `happy()` test:

``````sub happy (\$num) {
my %seen = ( \$num => 1 );

while ( \$num != 1 ) {
\$num = sum map { \$_ ** 2 } split //, \$num;
return 0 if \$seen{\$num};
\$seen{\$num} = 1;
}
return \$num;
}
``````

Using a hash for `%seen` values gives Colin an O(1) (constant time) lookup.

## Dave Jacoby

Dave Jacoby’s solution similarly loops eight times:

``````my @happy;
while ( scalar @happy < 8 ) {
state \$c = 0;
\$c++;
push @happy, \$c if is_happy(\$c);
}
say join ", ", @happy;
exit;
``````

Dave’s `is_happy()` has a slight tweak that I quite like:

``````sub is_happy( \$n ) {
my \$m = \$n;
my %done;
while ( !\$done{\$m} ) {
\$done{\$m}++;
\$m = sum0 map { \$_**2 } split //, \$m;
}
return \$m == 1 ? 1 : 0;
}
``````

Dave was able to turn both exit conditions into a single check against `%done`, knowing that once we get to 1, that value will repeat. The turnbuckle `return` does explicitly check for 1.

Ali Moradi’s solution gives us another variation, with `sum0`. `sum0` is used when you need your sum to have a default value (zero) in the case an empty list is passed in. Whatever alternate universe Ali is in where a number can have zero digits, sounds very interesting indeed! Seriously, though, `sum0` is a good utility to tuck away in your brain, as there are a lot of situations where having a default sum (instead of `undef`) is a good thing.

``````#!/usr/bin/env perl
use strict;
use warnings;
use List::Util qw(sum0);

sub is_happy{
my (\$n) = @_;
my %seen;
while(1){
\$n = sum0(map {\$_ ** 2} split //, \$n);
return 1 if \$n == 1;
return 0 if \$seen{\$n}++;
}
}
``````

By now we’re really starting to see some patterns and similar code.

## Duncan C. White

Duncan C. White’s solution coincidentally also uses `sum0`:

``````use Function::Parameters;

fun ishappy( \$x )
{
my %seen;
while( \$x > 1 )
{
return 0 if \$seen{\$x}++;
#say "debug: x=\$x" if \$debug;
\$x = sum0( map { \$_ * \$_ } split(//,\$x) );
}
return 1;
}
``````

## E. Choroba

E. Choroba’s solution gives us something a little bit different. Choroba does use a hash, eschews core `List::Util`'s `sum` in favor of a `for` loop, but structures the whole thing in a `happy_numbers()` function that returns an array ref of the first `\$tally` happy numbers:

``````sub happy_numbers {
my (\$tally) = @_;
my @happy_numbers;
my \$number = 1;

CANDIDATE:
while (@happy_numbers < \$tally) {
my \$replace = \$number;
my %loop;
my \$sum;
do {
\$sum = 0;
\$sum += \$_ * \$_ for split //, \$replace;
\$replace = \$sum;
next CANDIDATE if \$loop{\$sum}++;

} until 1 == \$sum;

push @happy_numbers, \$number;

} continue {
++\$number;
}

return \@happy_numbers
}
``````

## Jaldhar H. Vyas

Jaldhar H. Vyas’s solution also chooses not to use `List::Util`, writing his own pure Perl `sum` function:

``````sub sum {
my (\$arr) = @_;
my \$total = 0;

for my \$elem (@{\$arr}) {
\$total += \$elem;
}

return \$total;
}
``````

Why not, eh?

The `isHappy()` function relies on the fact that base-10 happy numbers always have a cycle length of 8:

``````sub isHappy {
my (\$i) = @_;
my \$tries = 0;
my \$s = \$i;

while (\$s != 1) {
if (\$tries == 8) {
return undef;
}
\$s = sum([map { \$_ ** 2 } split //, \$s]);
\$tries++;
}

return 1;
}
``````

## James Smith

James Smith’s solution is over 200 lines, contains a test suite, benchmarking, and several variations, progressively more complex. It’s worth looking at, and checking out his blog, as it’s a wonderful journey through his approach to this problem. I’ll highlight James’s precache version:

``````sub is_happy_precache {
state @happy;
my ( \$L, \$N, \$t, @ret, %seen ) = ( 1_640, \$_[0] );

unless (@happy) {
@happy = ( 0, 1 );
O: for my \$N ( 2 .. \$L ) {
my \$n = \$N;
%seen = ();
while ( \$n > 1 ) {
last if defined \$happy[\$n] && \$happy[\$n] == 1;
if ( defined \$happy[\$n] || \$seen{\$n} ) {
\$happy[\$_] = 0 for keys %seen;
next O;
}
\$seen{ \$t = \$n } = 1, \$n = 0;
do { \$n += ( \$t % 10 )**2 } while \$t = int( \$t / 10 );
}
\$happy[\$_] = 1 for \$N, keys %seen;
}
}

if ( \$N > \$L ) {    ## If not in cached array we compute
my \$n = \$N, \$N = 0;    ## the sum of digits squared....
do { \$N += ( \$n % 10 )**2 } while \$n = int( \$n / 10 );
}
\$happy[\$N];                ## And look up value in the cache..
}
``````

Right off the bat, notice the `state` variable, which will persist between calls of `is_happy_precache()`.

``````    state @happy;
my ( \$L, \$N, \$t, @ret, %seen ) = ( 1_640, \$_[0] );
``````

The next line front-loads a few of the declarations needed, while sneaking in the argument, `\$N`.

• `\$L = 1640` appears to be the limit that James has imposed on his routine.
• `\$N` is of course the number we want to compute the happiness of.
• `\$t` appears to be a temporary variable, or maybe “total”? In any case, it’s used only inside the `while` loop.
• `@ret` is unused, probably a vestigal bit from his other variations.
• `%seen` is our list of seen values, which is reset every time through the outer `for my \$N` loop

That `for my \$N` loop, you’ll note, gives us a different lexically scoped `\$N`.

The bulk of the function is the `unless (@happy) { ... }` loop, which is only run the first time `is_happy_precache()` is called. This loop goes through every number and determines if it’s happy or sad. James gets to take advantage of prior knowledge by setting `\$happy[\$_]` zero for every `%seen` number, if a cycle is detected, since they will all lead to the same cycle. On subsequent iterations through the loop, if `\$happy[\$n]` is defined, it is no longer necessary to do the successive sum of square digits calculations.

Finally, James has a check if `\$N > \$L`, which enables the function to compute values beyond its hard-coded limit, and then simply returns `\$happy[\$N]`.

James’s benchmarks suggest this method is over five times faster than `is_happy(1_000_000)`, at the cost of more memory and a penalty to the first call. These are tradeoffs we often have to decide on in software development.

## Jorg Sommrey

Jorg Sommrey’s solution takes it to the next level by supporting arbitrary bases. Here is his function, which returns a generator for b-happy numbers (happy numbers in base b):

``````# Generalizing the task to b-happy numbers in any base.
#
# Build a generator for b-happy numbers.
sub happy_gen (\$base) {
my %happy;
generator {
for (my \$n = 1;; \$n++) {
# Return cached results.
if (exists \$happy{\$n}) {
yield \$n if \$happy{\$n};
next;
}
# Get the digit square sum sequence for \$n in base \$base up to
# the first known happy or unhappy number.
my \$seen = dsss(\$n, \$base, \%happy);
# Is \$n a b-happy number?
my \$happy = \$seen->{1};
# Cache the new found numbers as happy or unhappy.
@happy{keys %\$seen} = (\$happy) x keys %\$seen;

yield \$n if \$happy;
}
}
}
``````

That `generator { ... }`, by the way, comes from `Coro::Generator`. Here it’s working as an iterator, which returns the next b-happy number on every call, like this:

``````my  \$it = happy_gen(10);
say \$it->() for 1..5; # First 5 10-happy numbers
``````

Jorg also takes a caching approach, but does not need to precompute anything:

``````# Cache the new found numbers as happy or unhappy.
@happy{keys %\$seen} = (\$happy) x keys %\$seen;
``````

This hash slice syntax makes for very concise and expressive code.

The `dsss()` sub builds up the digit square sum sequence for a number `\$n` in an arbitrary `\$base`. Here the result is fed back into the `\$happy` hashref that is given as an argument, allowing the caller to benefit from all of the other happy (or sad) numbers found along the way.

``````# Build a digit square sum sequence for \$n in base \$base with cached
# results in the hash ref \$happy
sub dsss (\$n, \$base, \$happy) {
my %seen;
# Test and set \$n as seen.
while (!\$seen{\$n}++) {
if (exists \$happy->{\$n}) {
# Add one as hash key to signal that a b-happy number has
# been found.
\$seen{1} = 1 if \$happy->{\$n};
return \%seen;
}
# Get the next number as the digit square sum of the current
# number.
\$n = vecreduce {\$a + \$b**2} 0, todigits \$n, \$base;
}
# Return the seen numbers as hash keys.
\%seen;
}
``````

Instead of bringing in `sum`, Jorg shows us the `vecreduce` subroutine from `Math::Prime::Util`. It works just like you’d expect from other reduce implementations, such as the one that you get from the core `List::Util` module. `reduce` is extremely versatile.

## Julien Fiegehenn

Julien Fiegehenn’s solution is a return to the familiar format of using a `%seen` hash and `sum`ming the squares of the digits:

``````sub happy_number {
my \$number = my \$start = shift;

my %seen;
until ( \$number == 1 ) {
my \$new_number = sum map { \$_**2 } split //, \$number;
return if \$seen{\$new_number}++;
\$number = \$new_number;
}

return 1;
}
``````

## Kjetil Skotheim

Kjetil Skotheim’s solution gives us a recursive implementation, rather than an iterative one:

``````sub is_happy {
my \$n = shift;
my ( %seen, \$happy );
\$happy = sub {
my \$n = shift;
\$n == 1     ? 1
: \$seen{\$n}++ ? 0
:               &\$happy( sum( map \$_**2, \$n =~ /\d/g ) );
};
&\$happy(\$n);
}
``````

The `\$happy` sub is a closure around `%seen`. The sub itself is a single conditional statement that returns 1 or 0 for the base cases (happy or `%seen`), and recurses on the sum of squares of digits otherwise.

This is logically equivalent to the iterative format we’ve seen several times already. In fact, in some languages (Perl being a perhaps slightly unfortunate exception), since the recursive step happens at the end (or tail) of the function, the compiler will optimize this so-called tail call into a `goto`, making it exactly equivalent to an iterative version. For various reasons, Perl doesn’t do tail call optimization. You can kind of fake it with `goto &NAME`, but it’s not exactly an optimization.

## Laurent Rosenfeld

Laurent Rosenfeld’s solution is another great example of the hash of `%seen` values, and simple, clear code to calculate the digit square sum:

``````sub is_happy {
my \$n = shift;
my %seen;
while (1) {
return 1 if \$n == 1;
return 0 if exists \$seen{\$n};
\$seen{\$n} = 1;
my \$sum = 0;
\$sum += \$_ for map \$_ ** 2, split //, \$n;
\$n = \$sum;
}
}
``````

## Lubos Kolouch

Lubos Kolouch’s solution includes simple summation code, and is otherwise very similar to other solutions:

``````sub is_happy {
my \$what = shift;

my %results_cache;

while (1) {
my \$result = 0;
for my \$num ( split //, \$what ) {
\$result += \$num * \$num;
}

return 1 if \$result == 1;
return 0 if \$results_cache{\$result};
\$results_cache{\$result} = 1;
\$what = \$result;
}

return;
}
``````

## Luiz Felipe

Luiz Felipe’s solution breaks the test out into two functions. The first, `happy_sum()`, is simply tasked with computing the digit square sum:

``````sub happy_sum {
my (\$number, \$sum);

\$number = shift;
\$sum = 0;

foreach my \$sub_number (split //, \$number) {
\$sum += \$sub_number ** 2;
}

return \$sum;
}
``````

And the `is_happy()` function, with the by now very familiar `%seen` hash, takes care of the rest:

``````sub is_happy {
my (\$number, %seen);

\$number = shift;

until (\$number == 1) {
my \$new_number = happy_sum(\$number);

return if \$seen{\$new_number}++;

\$number = \$new_number;
}
}
``````

It’s worth noting that there is no obvious return value here for what happens when the `until (\$number == 1) { ... }` loop falls through (in the case of a happy number). Remember that the return value of any BLOCK in Perl is always the last expression in the BLOCK.

The `\$number = \$new_number` expression’s value will propagate to the return for the `sub is_happy { ... }` block. So, `is_happy` returns `\$new_number`, which will always be 1 thanks to the `until` loop’s condition.

Could Luiz have simply stuck a `return 1` after the loop? Sure. But then one or two of you wouldn’t have learned about implicit return values.

Personally, I take a considered approach when it comes to using an explicit `return` at the end of a sub. I’m guided by what is going to be obvious, maintainable, and error free, without leaking internal logic. Often that means an explicit `return`, but just as often not. Some corporate style guides are sticklers for explicit `return`s, but that’s a whole ‘nother discussion.

## Matthew Neleigh

Matthew Neleigh’s solution is perhaps most interesting for the internal documentation style:

``````################################################################################
# Determine whether a positive integer is a Happy Number in Base 10; see
# https://en.wikipedia.org/wiki/Happy_number for a description of the Happy
# Numbers
# Takes one argument:
# * The integer N to examine
# Returns on success:
# * 1 if N is a Happy Number
# * 0 if N is not a Happy Number
# Returns on error:
# * undef if N is less than 1
################################################################################
sub is_happy_number_b10{
my \$n = int(shift());

return(undef)
unless(\$n > 0);

my %seen = ();

# Loop until one of the exit criteria triggers
# a return from the function
while(1){
my \$sum_squares = 0;

# If \$n is one, we've found a happy number;
# return true
return(1)
if(\$n == 1);

# Sum the squares of the digits in \$n
foreach(split("", \$n)){
\$sum_squares += \$_ * \$_;
}

# If we've seen this value of \$sum_squares
# before, we didn't start with a happy number;
# return false
return(0)
if(\$seen{\$sum_squares});

# Store the sum of the squares for later
# examination in future iterations, and set
# \$n to this new value
\$seen{\$sum_squares} = 1;
\$n = \$sum_squares;
}

}
``````

The comments do a very good job of describing what is happening in great detail. Here’s the function without the comments:

``````sub is_happy_number_b10{
my \$n = int(shift());

return(undef) unless(\$n > 0);

my %seen = ();

while(1){
my \$sum_squares = 0;

return(1) if(\$n == 1);

foreach(split("", \$n)){
\$sum_squares += \$_ * \$_;
}

return(0) if(\$seen{\$sum_squares});

\$seen{\$sum_squares} = 1;
\$n = \$sum_squares;
}

}
``````

Matt’s verbose comment style looks rather like an inline blog post, which is a perfectly efficient way to communicate a Weekly Challenge solution, in my opinion!

## Niels van Dijke

Niels van Dijke’s solution is a nice and concise variation on the theme we’ve seen before:

``````sub isHappy (\$) {
my (\$n) = @_;

my %seen;

while (\$n != 1 and !exists \$seen{\$n}) {
\$seen{\$n}++;
\$n = sum map { \$_*\$_ } unpack '(A1)*', \$n;
}

return \$n == 1;
}
``````

Niels has made it a bit more concise by combining the happy/sad conditionals in the `while` statement. What makes Neils’s solution stand out, however, is the use of `unpack` instead of `split`, to get the digits of `\$n`. He’s the only one to use `unpack`.

## Pete Houston

Pete Houston’s solution is again, quite similar, but there’s a twist:

``````sub is_happy {
my \$x    = shift;
my %seen = (\$x => 1);

while (\$x != 1) {

# Sum the squares of the digits
my \$sum = 0;
\$sum += chop (\$x) ** 2 for 1 .. length \$x;

# Have we looped?
return 0 if \$seen{\$sum};

# Store it and go again
\$seen{\$x = \$sum} = 1;
}

return 1;
}
``````

Pete’s use of `chop` to get the digits is a fun way to go about it. `chop` got a bad rap in the early days of Perl, as some programmers used it to remove trailing newlines. This worked on Unix and Linux systems where the newline was a single character, but caused errors on DOS-based systems that used `\r\n` for a newline, and failed even more ungracefully if the string didn’t contain a newline at all. `chop` also modifies its argument, whereas `chomp()` does not. Over and over, “use `chomp`, not `chop`. It’s safer!", was beaten into our heads. `chop` has always had its uses, though!

Pete is not removing newlines, nor does he care if the argument is modified, so `chop` works just fine.

## Peter Campbell Smith

Peter Campbell Smith’s solution starts off with a bunch of file-scoped variables:

``````my (\$test, \$so_far, \$i, @digits, \$d, @seen, @sad, \$result1, \$result2, \$indent, \$found);
``````

What these do, I have no idea yet, although it appears there is a whole array of `@sad`ness in store!

``````\$found = 0;

# loop in the hope that we find 8 happy numbers before 1000
TEST: for \$test (1 .. 1000) {
last if \$found == 8;  # success!

\$indent = 0;
\$so_far = \$test;   # this will be our running sum of squares
@seen = ();        # these are sums already seen for this \$test (indicating looping)
\$result1 = '';

# now iterate over the adding the digits squares
for \$i (1 .. 10) {

# split \$so_far into digits
@digits = split('', \$so_far);

# this is all stuff to format the output as per Mohammad's example
\$result1 .= qq[\$so_far => ];
\$indent += length(\$so_far) + (\$i == 1 ? 1 : 4);
\$result2 = (' ' x \$indent) . qq[=> ];

# now sum the square of the digits
\$so_far = 0;
for \$d (@digits) {
\$so_far += \$d**2;

# more formatting stuff
\$result1 .= qq[\$d^2 + ];
\$result2 .= \$d**2 . qq[ + ];
}

# more formatting stuff
\$result1 = substr(\$result1, 0, -2) . qq[\n] .
substr(\$result2, 0, -2) . qq[\n] . (' ' x \$indent) . '=> ';

# if \$so_far is 1 we are happy!
if (\$so_far == 1) {
say qq[\n\${result1}1];
\$found ++;
next TEST;

# if \$so_far has been seen already for this \$test or is already known to be \$sad
# then we're in a loop and \$test is sad
} elsif (\$seen[\$so_far] or \$sad[\$so_far]) {
next TEST;
}

# if neither of the above are true then we note that we've seen \$seen and keep going
\$seen[\$so_far] = 1;
}
}
``````

Peter’s code is also formatting the results exactly in the way Mohammad’s task description did, so we’ll see, for example:

``````28 => 2^2 + 8^2
=> 4 + 64
=> 68 => 6^2 + 8^2
=> 36 + 64
=> 100 => 1^2 + 0^2 + 0^2
=> 1 + 0 + 0
=> 1
``````

Neat!

## PokGoPun

PokGoPun’s solution uses simple a memoization strategy on top of a recursive implementation:

``````my %happy;

sub isHappy{
my \$i = shift;
return \$happy{\$i} if defined \$happy{\$i};
if (grep{\$_==\$i} @_){
\$happy{\$_}=0 foreach @_;
return 0;
}
my \$sum = eval(join(" + ", map{\$_*\$_} split //,\$i));
push @_, \$i;
if (\$sum==1){
\$happy{\$_}=1 foreach @_;
return 1;
}
return isHappy(\$sum,@_);
}
``````

Every time a number is found to be happy or sad, every seen number is added to the cache.

## Flavio Poletti

Flavio Poletti’s solution also caches results, using two `state` variables:

``````sub is_happy (\$n) {
state \$is_happy = { 1 => 1 };
state \$is_not_happy = {};
return 1 if \$is_happy->{\$n};
return 0 if \$is_not_happy->{\$n};
my %round;
while (! \$round{\$n}) {
\$round{\$n} = 1;
\$n = sum map { \$_ * \$_ } split m{}mxs, \$n;
if (\$n == 1) {
\$is_happy->{\$_} = 1 for keys %round;
return 1;
}
}
\$is_not_happy->{\$_} for keys %round;
return 0;
}
``````

## Roger Bell_West

Roger Bell_West’s solution starts out with a sum of square digits function:

``````sub ssd {
my \$n   = shift;
my \$out = 0;
while ( \$n > 0 ) {
my \$d = \$n % 10;
\$out += \$d * \$d;
\$n = int( \$n / 10 );
}
return \$out;
}
``````

Roger peels off each digit with `\$n % 10` rather than using `split`, `unpack`, or `chop`. His `happy()` function returns a list of `\$ct` happy numbers:

``````sub happy {
my \$ct = shift;
my %hm = ( 1 => 1 );
my \$c  = 0;
my @out;
while (1) {
\$c++;
unless ( exists \$hm{\$c} ) {
my \$v  = \$c;
my %ss = ( \$v => 1 );
my \$h  = 1;
while (1) {
if ( exists \$hm{\$v} ) {
\$h = \$hm{\$v};
last;
}
else {
\$v = ssd(\$v);
if ( exists \$ss{\$v} ) {
\$h = 0;
last;
}
\$ss{\$v}++;
}
}
map { \$hm{\$_} = \$h } keys %ss;
}
if ( \$hm{\$c} ) {
push @out, \$c;
if ( scalar @out >= \$ct ) {
last;
}
}
}
return \@out;
}
``````

We can see some familiar constructs here: a cache of happy numbers in `%hm`, and a seen hash in `%ss`, with a simple loop that iterates over the `ssd()` function (sum of square digits) until the result has been seen, or is known to be happy (or sad). 1 is pre-populated in `%hm`, so Roger doesn’t need to explicitly check for `\$v == 1`.

## Ryan Thompson

My solution is quite similar to the others:

``````# Return true if \$_ is a happy number
sub is_happy(_) {
my \$n = shift;

my %seen;
for (my \$c = \$n; \$c != 1; \$c = sum map { \$_*\$_ } split //, \$c) {
return if \$seen{\$c}++;
}

return 1
}
``````

For some reason, I decided to cram the sum of square digits into into the C-style `for` loop conditional. It’s certainly not the weirdest thing I’ve ever shoved into a conditional, but this is a PG-rated review, so I’ll just leave it at that.

At least you know I’m not immune to my own critiques!

## Ulrich Rieke

Ulrich Rieke’s solution gives us a nicely concise `squareSum()` function:

``````sub squareSum {
my \$number = shift;
return sum( map { \$_**2 } split( //, \$number ) );
}
``````

He then uses that to implement an iterative `isHappy()` checker:

``````sub isHappy {
my %seen;
my \$number = shift;
my \$sum    = squareSum(\$number);
\$seen{\$sum}++;
do {
\$sum = squareSum(\$sum);
\$seen{\$sum}++;
} until ( \$sum == 1 || \$seen{\$sum} > 1 );
return ( \$sum == 1 );
}
``````

## W. Luis Mochan

W. Luis Mochan’s solution is another concise iterative implementation:

``````sub happy {
my \$x=shift;
my %seen;
while(!\$seen{\$x}){
\$seen{\$x}=1;
\$x=sum map {\$_*\$_} split "", \$x
}
return \$x==1;
}
``````

### Blogs this week:

Adam RussellRabbitFarm | RabbitFarm

Arne SommerPrimarily Happy with Raku and Perl - Arne Sommer

Jaldhar H. VyasPerl Weekly Challenge: Week 164

Mark SennMark Senn’s blog | Mark Senn’s blog

Peter Campbell SmithPalindromic primes and moody numbers

Roger Bell_WestRogerBW’s Blog: The Weekly Challenge 164: Happy Palindromes

## SO WHAT DO YOU THINK ?

If you have any suggestions or ideas then please do share with us.