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.
Table of Contents
Task 1  Prime Palindrome
[ Adam Russell  Alexander Pankoff  Arne Sommer  Athanasius  CheokYin Fung  Colin Crain  Dave Jacoby  Ali Moradi  Duncan C. White  E. Choroba  Jaldhar H. Vyas  James Marquis  James Smith  Jorg Sommrey  Julien Fiegehenn  Kjetil Skotheim  Laurent Rosenfeld  Lubos Kolouch  Luiz Felipe  Matthew Neleigh  Mohammad S Anwar  Niels van Dijke  Pete Houston  Peter Campbell Smith  PokGoPun  Flavio Poletti  Robert DiCicco  Roger Bell_West  Ryan Thompson  Ulrich Rieke  W. Luis Mochan ]
Task 2  Happy Numbers
[ Adam Russell  Alexander Pankoff  Arne Sommer  Athanasius  CheokYin Fung  Colin Crain  Dave Jacoby  Ali Moradi  Duncan C. White  E. Choroba  Jaldhar H. Vyas  James Smith  Jorg Sommrey  Julien Fiegehenn  Kjetil Skotheim  Laurent Rosenfeld  Lubos Kolouch  Luiz Felipe  Matthew Neleigh  Niels van Dijke  Pete Houston  Peter Campbell Smith  PokGoPun  Flavio Poletti  Roger Bell_West  Ryan Thompson  Ulrich Rieke  W. Luis Mochan ]
Blogs
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
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:
Blog › Perl
Blog › Prolog
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);
}
Blog › Primarily Happy with Raku and Perl  Arne Sommer
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.
CheokYin Fung
CheokYin Fung’s solution is a refreshingly cheeky oneliner:
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 CheokYin 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. CheokYin 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 oddlength 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 homegrown 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 oneliner with
Math::Prime::Util
:
perl MMath::Prime::Util=is_prime e 'print join "\n", grep { $_ eq reverse $_} grep { is_prime($_) } 1..1000'
Blog › Shiny Happy Numbers: Weekly Challenge #164  Committed to Memory
Ali Moradi
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
reused 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;
Blog › Perl Weekly Challenge: Week 164
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 nonpalindromes 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 hardcoded 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;
Blog › Perl Weekly Challenge 164: Prime Palindromes and Happy Numbers
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 characterbycharacter 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 oneliner:
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);
Blog › Palindromic primes and moody numbers
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 socalled “6k ± 1” test to reduce the number of operations, compared to trial division.
As a side note, I wholeheartedly encourage code reuse, 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 }
Blog › PWC164  Prime Palindrome  ETOOBUSY
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 nonstandard but common itoa()
.
Blog › RogerBW’s Blog: The Weekly Challenge 164: Happy Palindromes
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 (nonprimes)
for my $n (2..$limit) {
next if $comp[$n];
$comp[$_] = 1 for map { $n * $_ } 2..$limit/$n;
}
2, grep { !$comp[$_] } 3..$limit;
}
Blog › PWC 164 › Palindromic Primes – Ryan J Thompson
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, precomputing, 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
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";
}
Blog › RabbitFarm (Perl)
Blog › RabbitFarm (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 sumofdigitsquares 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;
}
Blog › Primarily Happy with Raku and Perl  Arne Sommer
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 base10 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 10Happy Numbers:\n%s\n", $TARGET, join ', ', @happy;
I’m glad Athanasius showcased this optimization, so I could talk about it.
CheokYin Fung
CheokYin 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 prerun 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.
Blog › Happy Happy Joy Joy – Programming Excursions in Perl and Raku
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.
Blog › Shiny Happy Numbers: Weekly Challenge #164  Committed to Memory
Ali Moradi
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 base10 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;
}
Blog › Perl Weekly Challenge: Week 164
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 frontloads 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 thewhile
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 outerfor 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 hardcoded 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 bhappy numbers (happy numbers in base b):
# Generalizing the task to bhappy numbers in any base.
#
# Build a generator for bhappy 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 bhappy 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 bhappy number on every call,
like this:
my $it = happy_gen(10);
say $it>() for 1..5; # First 5 10happy 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 bhappy 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 socalled 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;
}
}
Blog › Perl Weekly Challenge 164: Prime Palindromes and Happy Numbers  laurent_r [blogs.perl.org]
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 DOSbased 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 filescoped 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;
@sad = ();
# 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]) {
$sad[$so_far] = 1;
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!
Blog › Palindromic primes and moody numbers
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;
}
Blog › PWC164  Happy Numbers  ETOOBUSY
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 prepopulated in %hm
, so Roger doesn’t need to
explicitly check for $v == 1
.
Blog › RogerBW’s Blog: The Weekly Challenge 164: Happy Palindromes
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
Cstyle for
loop conditional. It’s certainly not the weirdest thing I’ve
ever shoved into a conditional, but this is a PGrated review, so I’ll just
leave it at that.
At least you know I’m not immune to my own critiques!
Blog › PWC 164 › Happy Numbers – Ryan J Thompson
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;
}
See Also
Blogs this week:
Adam Russell › RabbitFarm  RabbitFarm
Arne Sommer › Primarily Happy with Raku and Perl  Arne Sommer
Colin Crain › Happy Happy Joy Joy – Programming Excursions in Perl and Raku
Dave Jacoby › Shiny Happy Numbers: Weekly Challenge #164  Committed to Memory
Flavio Poletti › PWC164  Prime Palindrome  ETOOBUSY  PWC164  Happy Numbers  ETOOBUSY
Jaldhar H. Vyas › Perl Weekly Challenge: Week 164
James Smith › perlweeklychallengeclub/challenge164/jamessmith at master · drbaggy/perlweeklychallengeclub · GitHub
Laurent Rosenfeld › Perl Weekly Challenge 164: Prime Palindromes and Happy Numbers  laurent_r [blogs.perl.org]
Luca Ferrari › Perl Weekly Challenge 164: quick and easy – Luca Ferrari – Open Source advocate, human being  Perl Weekly Challenge 164: quick and easy – Luca Ferrari – Open Source advocate, human being
Mark Senn › Mark Senn’s blog  Mark Senn’s blog
Peter Campbell Smith › Palindromic primes and moody numbers
Roger Bell_West › RogerBW’s Blog: The Weekly Challenge 164: Happy Palindromes
Ryan Thompson › PWC 164 › Happy Numbers – Ryan J Thompson  PWC 164 › Palindromic Primes – Ryan J Thompson
W. Luis Mochan › Perl Weekly Challenge 164. – W. Luis Mochán. Blog. – Físico, investigador del ICFUNAM.Physicist, researcher at ICFUNAM.