## Perl Weekly Review: Challenge - 041

Sunday, Jan 12, 2020| Tags: Perl

Continues from previous week.

Feel free to submit a merge request or open a ticket if you found any issues with this post. We highly appreciate and welcome your feedback.

For a quick overview, go through the original tasks and recap of the weekly challenge.

Additional feedback to our Perl Weekly Challenge’s Twitter account is much appreciated.

### Write a script to display attractive number between 1 and 50.

A number is an attractive number if the number of its prime factors is also prime number.

The number 20 is an attractive number, whose prime factors are 2, 2 and 5. The total prime factors is 3 which is also a prime number.

I noticed the use of redo in Adam‘s work of brilliance.

``````use strict;
use warnings;

sub prime_factor{
my \$x = shift(@_);
my @factors;
for (my \$y = 2; \$y <= \$x; \$y++){
next if \$x % \$y;
\$x /= \$y;
push @factors, \$y;
redo;
}
return @factors;
}

MAIN:{
for my \$n (1 .. 50){
my @factors = prime_factor(\$n);
print "\$n (" . join(", " , @factors) . ")\n" if(prime_factor(scalar @factors) == 1);
}
}
``````

## Andrezgz

Andrezgz definition of method is_prime() is the main attraction of the solution.

``````#!/usr/bin/perl

use strict;
use warnings;

my \$upto = shift || 50;

foreach (1 .. \$upto){
print \$_ . ' ' if is_prime( scalar prime_decomp(\$_) );
}

sub prime_decomp {
my \$n = shift;

my @prime_decomp;

foreach my \$prime ( prime_factors(\$n) ){
do {
\$n /= \$prime;
push @prime_decomp, \$prime;
} while (\$n % \$prime == 0);
}

return @prime_decomp;
}

sub prime_factors {
my \$n = shift;
return if \$n <= 1;
my @r = grep {\$n % \$_ == 0 && is_prime(\$_)} (2 .. \$n/2); #get prime divisors
return @r ? @r : (\$n); # number is prime if no prime divisors were found
}

sub is_prime {
my \$n = shift;
return if \$n <= 1;
#every composite number has a prime factor less than or equal to its square root.
return 1 == grep {\$n % \$_ == 0} (1 .. sqrt \$n);
}
``````

## Burkhard Nickels

Burkhard didn’t hesitate to go full on with his solution.

``````my \$res = calculate_primes(50);
print "Prime Numbers: ", Dumper(\$res), "\n";

my @numbers = (1 .. 50);
my @primes = (2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53);
print "Prime Numbers: ", Dumper(\@primes), "\n";

print "Attractive Numbers:\n";

foreach my \$nbr (1 .. 50) {
my @res;
my %tree;
my (\$x,\$y) = (-1,0);
print "TEST \$nbr ---> \n";
nr_recursive(\$nbr,\@res,\$x,\\$y,\%tree);
# print "Ergebnis: ", Dumper(\@res), "\n";
\$Data::Dumper::Indent=1;
# print "Ergebnis: ", Dumper(\%tree), "\n";
my \$flat = flatten(\%tree);
# print "Flat: ", Dumper(\$flat), "\n";
is_attractive_number(\$flat);
print "\n";
}

sub is_attractive_number {
my (\$flat) = @_;
foreach my \$k (keys %\$flat) {
my \$attr_nbr = 1;
my @tmp = split(/\./,\$k);
foreach my \$i (@tmp) {
if( ! is_prime(\$i) ) { \$attr_nbr = 0; }
}
if(\$attr_nbr) {
print "   \$k => \$flat->{\$k} Attractive Number";
if( is_prime(\$flat->{\$k}) ) {
print "(Number Factors \$flat->{\$k} is Prime)\n";
} else { print "\n"; }
}
else {
# print "\$k => \$flat->{\$k}\n";
}
}
}

sub nr_recursive {
my (\$number,\$res,\$x,\$y,\$tree) = @_;
\$x++;
# my \$space = " " x (\$x * 2);
# print "\$space X+(\$x/\$\$y)\n";
# print "\$space IN: \$number (\$x/\$y)\n";
my \$loop;
if(\$x == 0) { \$loop = \$number-1; }
else { \$loop = \$number; }
my \$found_count=0;
foreach my \$j ((2 .. \$loop)) {
# print "\$space LO: \$number (\$x/\$y)\n";
my \$div = \$number/\$j;         # Division with every whole number.
my \$nr  = int(\$div);
my \$rst = \$number%\$j;
# print "\$space - \$j (\$div,\$nr,\$rst)\n";
if( ! \$rst ) {           # Result is whole number
\$found_count++;
# print "\$space => \$j (\$x/\$\$y - Next \$nr)\n";
\$res->[\$\$y][\$x] = \$j;

if(\$nr == 1) { \$tree->{\$j} = \$x+1; }
else { \$tree->{\$j} = {}; }

if(\$\$y > 0) {
foreach my \$k (0 .. \$x-1) {
\$res->[\$\$y][\$k] = \$res->[\$\$y-1][\$k];
# print "\$space => \$res->[\$\$y-1][\$k] (\$k/\$\$y)\n";
}
# \$\$y++; print "\$space Y+(\$x/\$\$y)\n";
}

nr_recursive(\$nr,\$res,\$x,\$y,\$tree->{\$j});
# if(\$found_count > 1) {
#   \$\$y++; print "\$space Y+(\$x/\$\$y)\n";
# }
\$\$y = \$#\$res + 1; # print "\$space Y+(\$x/\$\$y)\n";
}
}
\$x--; # print "\$space X-(\$x/\$\$y)\n";
}

sub is_prime {
my (\$nr) = @_;
my \$prime=1;
foreach my \$j ((2 .. \$nr-1)) { # Not dividing by 1 or the same number
my \$div = \$nr/\$j;           # Division with every whole number.
my \$nr  = int(\$div);
my \$rst = \$nr%\$j;
if( ! \$rst ) {             # If no Rest
\$prime=0;              # it is NO prime number
last;
}
}
return \$prime;
}

sub calculate_primes {
my (\$max) = @_;

my @result;
my \$prime=1;
foreach my \$i ((2 .. \$max)) {
foreach my \$j ((2 .. \$i)) {
my \$div = \$i/\$j;         # Division with every whole number.
my \$nr  = int(\$div);
my \$rst = \$i%\$j;
if( ! \$rst and \$i!=\$j) { # If no Rest and not devided by same.
\$prime=0;            # it is NO prime number
last;
}
}
if(\$prime) { push(@result,\$i); } # Prime Number
else { \$prime=1; }
}
return \@result;
}
``````

## Colin Crain

Colin‘s own creation decompose() is really fun to read.

``````use warnings;
use strict;
use feature ":5.26";

my \$max = shift @ARGV // 50;

my @primes = make_prime_list(\$max);
my %primehash = map { \$_ => 1 } @primes;

for (2..\$max) {
my @decomp = decompose(\$_, \@primes);
printf "%-4d--> %-20s  %s\n", \$_, (join ', ', @decomp),
(exists \$primehash{(scalar @decomp)}) ? "\$_ is attractive" : "" ;
}

sub make_prime_list {
## creates a list of all primes less than or equal to a given number
my \$max = shift;
my @output = (2);
CANDIDATE: for(  my \$candidate = 3;  \$candidate <= \$max;  \$candidate += 2  ) {
my \$sqrt_candidate = sqrt( \$candidate );
for(  my \$test = 3; \$test <= \$sqrt_candidate; \$test += 2  ) {
next CANDIDATE if \$candidate % \$test == 0;
}
push @output, \$candidate;
}
return @output;
}

sub decompose {
## given a number and a list of primes less than n/2,
## returns an array list of prime decomposition factors of the number
my (\$num, \$primes) = @_;
my @decomp;
my @primelist = \$primes->@*;
my \$prime = shift @primelist;

while ( \$prime <= \$num ) {
while (\$num % \$prime == 0) {
\$num = \$num / \$prime;
push @decomp, \$prime;
}
last if scalar @primelist == 0;
\$prime = shift @primelist;
}
return @decomp;
}
``````

## Duncan C. White

Duncan invented his own library MakePrimes and PrimeFactors to solve the task. Highly Recommended.

``````use v5.10;  # to get "say"
use strict;
use warnings;
use Function::Parameters;

use lib qw(.);  # I hate this!
use MakePrimes;
use PrimeFactors;

die "Usage: ch-1.pl [N//50]\n" if @ARGV>1;

my \$n = shift // 50;

my @primes = primes_upto( \$n );
my %isprime = map { \$_ => 1 } @primes;

foreach my \$x (2..\$n)
{
my @factors = prime_factors( \$x, @primes );
my \$nf = @factors;
next unless \$isprime{\$nf};
say "\$x is an attractive number, factors are: ", join(',',@factors),
", number factors \$nf is prime";
}
``````

## E. Choroba

Choroba, once again took the help from CPAN module Math::Prime::Util. The end result is nice and clean solution.

``````#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

use Math::Prime::Util qw{ factor is_prime };

sub is_attractive {
my (\$n) = @_;
is_prime(factor(\$n))
}

say for grep is_attractive(\$_), 1 .. 50;
``````

## Javier Luque

Javier also followed the same path as Choroba.

``````#!/usr/bin/perl
# Test: ./ch-1.pl
use strict;
use warnings;
use Math::Prime::Util qw /factor is_prime/;
use feature qw /say/;

for my \$i (1..50) {
my @factors = factor(\$i);
say \$i if (is_prime(scalar(@factors)));
}
``````

## Laurent Rosenfeld

Laurent came up with his own implementation of the method prime_factors().

``````#!/usr/bin/perl
use strict;
use warnings;
use feature qw/say/;
use constant PRIMES => (2, 3, 5, 7);

sub prime_factors {
my \$num = shift;
my \$origin_num = \$num;
my @factors;
for my \$div (PRIMES) {
while (\$num % \$div == 0) {
push @factors, \$div;
\$num /= \$div;
}
return @factors if \$num == 1;
}
push @factors, \$num unless \$num == \$origin_num;
return @factors;
}

my %primes = map { \$_ => 1 } PRIMES;
say "\$_: ", join " ", prime_factors(\$_) for
grep exists \$primes{scalar prime_factors(\$_)}, 1..50;
``````

## Lubos Kolouch

Lubos introduced me to the method count_prime_factors() from the CPAN module Math::Factor::XS. The power of CPAN makes the solution looks nice and clean.

``````use strict;
use warnings;
use Math::Factor::XS qw/count_prime_factors/;
use Math::Prime::XS qw/is_prime/;

sub is_attractive {
my \$what = shift;

return is_prime(count_prime_factors(\$what));
}

# TESTS

use Test::More;

is(is_attractive(20),1);
is(is_attractive(23),'');
is(is_attractive(28),1);
is(is_attractive(256),'');

done_testing;
``````

## Roger Bell_West

Like many members, Roger also took the help of CPAN module Math::Prime::Util.

``````#! /usr/bin/perl

use strict;
use warnings;

use Math::Prime::Util qw(factor is_prime);

foreach my \$c (1..50) {
if (is_prime(scalar factor(\$c))) {
print "\$c\n";
}
}
``````

## Ruben Westerberg

Ruben took the pain and defined his own method prime(), which reminded me of my early days.

``````#!/usr/bin/env perl
use strict;
use warnings;
for (1..50) {
my @a=primeFactors(\$_);
print "Attractive number \$_: prime factors @a\n" if (prime(scalar @a));
}
sub prime {
my \$n=shift;
if (\$n <= 3 ) {
return \$n > 1;
}
elsif (\$n % 2 == 0 or \$n % 3 ==0 ) {
return 0;
}
my \$i=5;
while (\$i**2 <= \$n) {
if ( \$n % \$i ==0 or \$n % (\$i+2) == 0 ) {
return 0;
}
\$i+=6;
}
return 1;
}

sub primeFactors {
my @factors;
my \$i=shift;
for (1..\$i/2) {
if (\$i%\$_ == 0 and prime \$_ ) {
my \$b=\$i/\$_;
push @factors, \$_;
if (prime \$b) {
push @factors, \$b;
}
else {
push @factors, primeFactors(\$b);
}
last;
}
}
@factors;
}
``````

## Ryan Thompson

The main attractioon of Ryan solution was the introduction of Wilson Theorem.

``````#!/usr/bin/env perl

use 5.010;
use warnings;
use strict;
no warnings 'uninitialized';

# Here is how I'd normally tackle this problem:
# use Math::Prime::Util ':all';
# say for grep { is_prime( factor(\$_) ) } 1..50;

my @primes50   = primes_to(50);
my %primes50   = map  { \$_ => 1 } @primes50;
my @attractive = grep { \$primes50{ prime_div_mult(\$_) } } 1..50;

say for @attractive;

# Check our results against https://oeis.org/A063989
if (\$ARGV[0] eq '--test') {
use Test::More;
my @oeis = (4, 6, 8, 9, 10, 12, 14, 15, 18, 20, 21, 22, 25, 26, 27, 28,
30, 32, 33, 34, 35, 38, 39, 42, 44, 45, 46, 48, 49, 50);
is_deeply \@attractive, \@oeis, "Matches published sequence";
done_testing;
}

# Unmodified Wilson's theorem is terrible, unless you only need tiny primes!
# Please, I beg you, use Math::Prime::Util or similar in any real code. :-)
# N is prime iff (N - 1)! % N == 0
sub primes_to {
use bigint;
my \$N = shift;
my \$fac = 1;
my @r;
for my \$n (2..\$N) {
\$fac *= \$n - 1;

push @r, \$n unless (\$fac + 1) % \$n;
}

@r;
}

# Get prime divisors in multiplicity (e.g., 48 = 2, 2, 2, 2, 3)
sub prime_div_mult {
my \$n = shift;
my @div;
for my \$div (@primes50) {
last if \$div > \$n;
while (\$n % \$div == 0) {
\$n /= \$div;
push @div, \$div;
}
}

@div;
}
``````

## Saif Ahmed

Saif made good use of dispatch table. The best part of the solution is the centralisation of core functions.

``````initialise();
getAttractive(20,"method2");
benchmark();

sub getAttractive{                     # gets attractive numbers
my \$n=shift;                       # how many to get
\$method=shift //"method1";         # which method to use or use method1
print "Using \$method the first \$n attractive numbers are:-\n";

my \$candidate=0;                   # number to test for attractiveness

while (\$n--) {
# increment \$candidate until attractive found
while (!\${\$method}{isAttractive}->(++\$Candidate)){};
# display attarctive numbers and factors
print "\$Candidate is attractive; Factors are ",
(join ",",(defined \${\$method}{factors})    ?   # if a cache of factors exists
@{\${\$method}{factors}  ->[\$Candidate]} : # retrieve from cache or
@{\${\$method}{factorise}->(\$Candidate)} ),# just factorise again
"\n";
}
}

sub initialise{

# Method1 caches nothing. The factorise function return the list of factors, or
# just the number itself if it is prime

%method1=(                    # "our" used to make it available
# outsibe the initialise subroutine
factorise=>sub {
my \$wn=\$number=shift;      # the number to test is loaded
my @factorsList=();        # the aray of factors found
my \$test=2;                # start search with 2 as a factor
my \$limit=sqrt(\$wn+1);        # continue to a reasonable limit
while (\$test < \$limit){    # until limit passed
if  (\$wn % \$test){       # if not a factor (i.e. \$wn % \$test is not zero
\$test++;             # test next number
\$test++ unless \$test==3;  # ensure that after 2 only odd numbers are tested
}
else{                    # factor found
push @factorsList,\$test;# store factor in our list
\$wn=\$wn/\$test;          # and factorise the rest...
\$limit=sqrt(\$wn+1)      # ...resetting limit accordingly
}
}
return [@factorsList,\$wn];  # return all factors found (including the last prime)
},

isPrime=>sub{                   # all methods retun the number if no factors are found
my \$t=shift;
return 0 if \$t<2;             # 0 and 1 are not prime numbers
return \$method1{ numberOfFactors}->(\$t)==1?1:0;
},

numberOfFactors=>sub{           # list of factors obtained by factorise
my \$t=shift;
return scalar @{\$method1{factorise}->(\$t)};
},

isAttractive=>sub {             # tests that numberOfFactors() isPrime()
my \$t=shift;
return \$method1{isPrime}->( \$method1{numberOfFactors}->( \$t ) );
},

);

# Method 2 caches the factors.  Because the factors of previously tested numbers are
# retained only the smallest factor is required, and it merely retrieves the rest
# from the cache

%method2=(
factorise=>sub {
my \$number=shift;           # the number to test is loaded
# if number already has ached factors, retieve from cache
return  \$method2{factors}->[\$number] if (defined \$method2{factors}->[\$number]) ;
my \$test=2; \$limit=sqrt(\$number+1);  # as before start with 2 and set limits
while ((\$test < \$limit)&&(\$number % \$test)){
\$test++;
\$test++ unless \$test==3;
}
if (\$test<\$limit){           # found the smallest prime factor.
# Because of caching, all the other factors have
# already been found, no need to search.
\$method2{factors}->[\$number]=  [\$test,@{\$method2{factors}->[\$number/\$test]}]
}
else{                        #otherwise this is a prime number, store in cache
\$method2{factors}->[\$number]=  [\$number];
}
return  \$method2{factors}->[\$number];
},

isPrime=>sub{
my \$t=shift;
return 0 if \$t<2;
return \$method2{numberOfFactors}->(\$t)==1?1:0;
},

numberOfFactors=>sub{              # retrieve from cache
my \$t=shift;
return scalar @{\$method2{factors}->[\$t]};
},

isAttractive=>sub{                # tests that numberOfFactors() isPrime()
my \$t=shift;
return \$method2{isPrime}->( \$method2{numberOfFactors}->( \$t ) );
},

factors=>[],                       # cache of factors
);

# Method 3 caches factors and primes.
# the primes cache is a hash, with each prime stored as key, with next key as its value
# e.g 2=>3,3=>5,5=>7,7=>11,11=>-1,largest=>11. this allows quick retrieval of the next
# found poetntial prime factor.

%method3=(
factorise=>sub{
my \$number=shift;
return  \$method3{factors}->[\$number] if (defined \$method3{factors}->[\$number]) ;
my \$test=2; my \$limit=sqrt(\$number+1);
while ((\$test < \$limit)&&(\$number % \$test)){
\$test=\$method3{primes}->{\$test};        # test larger and larger primes
}
if ((\$number % \$test)||(\$number/\$test ==1)){   # no old prime factor found
# number must be a new prime larger than one previously encountered
# this is stored in a hash, replacing previous largest prime
# this method of setting multiple values in a hash is not possible with "strict"
@method3{primes}->{\$number,\$method3{primes}->{"largest"},{"largest"} }=(-1,\$number,\$number);
\$method3{factors}->[\$number]= [\$number];
}
else{
\$method3{factors}->[\$number]=[\$test,@{\$method3{factors}->[\$number/\$test]}];
}
return \$method3{factors}->[\$number];
},

isPrime=>sub{                                     # check primes from the hash cache
my \$t=shift;
return 0 if \$t<2;
return defined \$method3{primes}->{\$t}?1:0;
},

numberOfFactors=>sub{
my \$t=shift;
return scalar @{\$method3{factors}->[\$t]};        # check factors from the cache array
},

isAttractive=>sub{                # tests that numberOfFactors() isPrime()
my \$t=shift;
return \$method3{isPrime}->( \$method3{numberOfFactors}->( \$t ) );
},

primes =>{2=>3,3=>5,5=>7,7=>11,11=>-1,largest=>11},
factors=>[],
);

for my \$method ("method2","method3"){
for (1..100){
\${\$method}{factorise}->(\$_)
}
}
}

# This routine benchmarks the three methods twice, demonstrating the
# effectiveness of caching at first and subsequent passes.
sub benchmark{
use Time::HiRes qw ( time);
my \$start;
for (1,2){
print "Benchmark pass \$_\n";
for my \$end (1000,10000,100000){

for my \$method (1..3){
\$start=time();
for (1..\$end){
\${"method\$method"}{factorise}->(\$_)
}
\${"duration\$method"}= int (1000*(time()-\$start));
}
print "With \$end factorisations: Method1 \$duration1 ms   Method2 \$duration2 ms  Method3 \$duration3 ms \n";
}
}
}
``````

## Ulrich Rieke

Ulrich setup his own helper methods isPrime(), isAttractive() and primeFactors(). With the helper methods, the end result looks elegant.

``````#!/usr/bin/perl ;
use strict ;
use warnings ;

sub isPrime {
my \$number = shift ;
if ( \$number == 1 ) {
return 0 ;
}
if ( \$number == 2 ) {
return 1 ;
}
for ( my \$i = 2 ; \$i < int ( \$number / 2 + 1 ) ; \$i++ ) {
if ( \$number % \$i == 0 ) {
return 0 ;
last ;
}
}
return 1 ;
}

sub isAttractive {
my \$number = shift ;
my @primeFactors = primeFactors( \$number ) ;
return isPrime( scalar @primeFactors ) ;
}

sub primeFactors {
my \$num = shift ;
if ( \$num == 1 ) {
return ( ) ;
}
my \$current = 2 ;
my @primeFactors ;
while ( \$num != 1 ) {
if ( \$num % \$current == 0 ) {
push @primeFactors , \$current ;
\$num /= \$current ;
}
else {
do {
\$current++ ;
} while ( not isPrime( \$current ) ) ;
}
}
return @primeFactors ;
}

my @attractives = grep { isAttractive( \$_ ) } (1..50) ;
foreach my \$num ( @attractives ) {
print "\$num " ;
}
print "\n" ;
``````

## Walt Mankowski

Walt used the Sieve of Eratosthenes to find the primes. He is the only member who used this hack, very interesting.

``````#!/usr/bin/env perl
use strict;
use warnings;
use feature qw(:5.30);
use experimental qw(signatures);

my \$N = 50;

# Find the primes up to \$n using the Sieve of Eratosthenes
sub primes_up_to(\$n) {
my %primes = map { \$_ => 1 } 2..\$n;
for my \$i (2..sqrt(\$n)) {
if (defined \$primes{\$i}) {
for (my \$j = \$i**2; \$j <= \$n; \$j += \$i) {
delete \$primes{\$j};
}
}
}
return %primes;
}

sub prime_factors(\$n, %primes) {
my @factors;

for my \$i (sort { \$a<=>\$b } keys %primes) {
last if \$i > \$n;
while (\$n % \$i == 0) {
push @factors, \$i;
\$n /= \$i;
}
}
return @factors;
}

my %primes = primes_up_to(\$N);
for my \$i (1..\$N) {
say \$i if defined \$primes{scalar prime_factors(\$i, %primes)};
}
``````

## Wanderdoc

Wanderdoc home grown is_prime() is really cool and on top of print_attactive() was like icing on the cake.

``````use strict;
use warnings FATAL => qw(all);

my \$N = shift || 50; # or die "How much is the number?\n";

for ( 1 .. \$N )
{
print_attractive(\$_);
}

sub print_attractive
{
my \$n = \$_[0];

my \$n_orig = \$n;
my \$counter = 0;

my @factors;

# Old nice one-liner for prime factorization:
# perl -le "\$x = shift; for \$k (2 .. \$x/2) {\$x%\$k or (print \$k and \$x /= \$k and redo) }"

for my \$k ( 2 .. \$n/2 )
{
0 == \$n % \$k and
\$factors[\$counter++] = \$k and
\$n /= \$k and redo;
}
print join(" ", \$n_orig, '=', join(' * ',@factors)), \$/ if is_prime(\$counter);
}

sub is_prime
{
my \$n = \$_[0];
if (\$n <= 3) {return \$n > 1 ? 1 : 0;}
elsif (0 == \$n % 2 or 0 == \$n % 3) {return 0;}

else
{
my \$i = 5;
while ( \$i * \$i <= \$n )
{
if ( 0 == \$n % \$i or 0 == \$n % (\$i + 2))
{
return 0;
}
\$i += 6;
}
}
return 1;
}
``````

### Write a script to display first 20 Leonardo Numbers. Please checkout wiki page for more information.

For example:

##### L(3) = L(1) + L(2) + 1 = 5

and so on.

Adam tried to keep it simple and very well presented end result.

``````use strict;
use warnings;
use constant NUMBERS => 20;

my \$numbers = NUMBERS;
my @leonardo = (1, 1);
while(\$numbers){
if((NUMBERS - \$numbers) < 2){
print "L(" . (NUMBERS - \$numbers) . ") = " . \$leonardo[-1] . "\n";
}
else{
my \$leonardo = \$leonardo[-1] + \$leonardo[-2] + 1;
print "L(" . (NUMBERS - \$numbers) . ") = \$leonardo\n";
push @leonardo, \$leonardo;
}
\$numbers--;
}
``````

## Andrezgz

Andrezgz kept it simple and easy to read.

``````#!/usr/bin/perl

use strict;
use warnings;
use Memoize;

memoize('leo');

my \$upto = shift || 20;
print leo(\$_).' ' for (0 .. --\$upto);

sub leo {
my \$n = shift;
return \$n <= 1 ? 1 : leo(\$n-1) + leo(\$n-2) + 1;
}
``````

## Burkhard Nickels

Burkhard also took the recursive route.

``````print "Function leonardo1() with recursive function call ...\n";
foreach my \$i (0 .. \$max) {
my \$cnt = 0;
my \$nr = leonardo1(\$i,\\$cnt);
print "L(\$i) = \$nr (\$cnt)\n";
}

sub leonardo1 {
my (\$nr,\$cnt) = @_;
\$\$cnt++;
if( \$nr == 0 or \$nr == 1 ) { return 1; }
else {
return leonardo1(\$nr-1,\$cnt) + leonardo1(\$nr-2,\$cnt) + 1;
}
}
``````

## Colin Crain

Colin presented the result nicely laid out.

``````use warnings;
use strict;
use feature ":5.26";

my \$quan = shift @ARGV // 20;

say "the first \$quan Leonardo numbers:";
say "";
say "index  |  number";
say "-------+--------";

my \$i;
printf "%-2d        %d\n", ++\$i, \$_ for make_leonardo(\$quan)->@*;

sub make_leonardo {
##  construct a list of the first n Leonardo numbers
##  requires no recursion if we have the growing list to refer to
my \$quan  = shift;
my \$list  = [1];
push \$list->@*, 1 if \$quan > 1;                         ## now [1,1]
while ( scalar \$list->@* <= \$quan-1 ) {
push \$list->@*, \$list->[-1] + \$list->[-2] + 1;      ## sum last two elements + 1
}
return \$list;
}
``````

## Duncan C. White

Duncan kept it simple without any noise.

``````use v5.10;  # to get "say"
use strict;
use warnings;
#use Data::Dumper;

die "Usage: ch-2.pl [N//20]\n" if @ARGV>1;
my \$n = shift // 20;

my %l;
\$l{0} = 1;
\$l{1} = 1;
say "leonardo(0) = \$l{0}";
say "leonardo(1) = \$l{1}";

foreach my \$i (2..\$n-1)
{
\$l{\$i} = \$l{\$i-2} + \$l{\$i-1} + 1;
say "leonardo(\$i) = \$l{\$i}";
}
``````

## E. Choroba

Choroba blown me away with his hack of shift at the end.

``````#! /usr/bin/perl
use warnings;
use strict;
use feature qw{ say };

my @last2 = (1, 1);
for my \$n (0 .. 20) {
say "L(\$n) = ", \$last2[0];
push @last2, \$last2[0] + \$last2[1] + 1;
shift @last2;
}
``````

## Javier Luque

Javier made use of recursive function.

``````#!/usr/bin/perl
# test: ./ch-2.pl
use strict;
use warnings;
use feature qw /say/;

for my \$i (1..20) {
say "L(\$i) = " . leonardo(\$i);
}

# Leonardo
sub leonardo {
my \$n = shift;
return 1 if (\$n == 0 or \$n == 1);

# Recursive
return (
leonardo(\$n-1) +  # l(n-1)
leonardo(\$n-2) +  # l(n-2)
1                 # 1
);
}
``````

## Laurent Rosenfeld

Laurent didn’t blink once before getting the desired result.

``````use strict;
use warnings;
use feature qw /say/;

my @leonardo = (1, 1);
for my \$i (1..18) {
push @leonardo, \$leonardo[-1] + \$leonardo[-2] + 1;
}
say "@leonardo";
``````

## Lubos Kolouch

It can’t be any simpler than this, thanks Lubos.

``````use strict;
use warnings;
use Data::Dumper;

my @l = (1,1);

for (2..19) {
\$l[\$_] = \$l[\$_-2] + \$l[\$_-1]+1;
}

warn Dumper @l;
``````

## Roger Bell_West

Roger followed the easy path. However while printing the result, he used the negative index hack, very smart.

``````#! /usr/bin/perl

use strict;
use warnings;

my @stack;

foreach my \$i (0..19) {
if (\$i<2) {
push @stack,1;
} else {
push @stack,1+\$stack[-1]+\$stack[-2];
shift @stack;
}
print \$stack[-1],"\n";
}
``````

## Ruben Westerberg

Ruben made use of state to cache the result. I wonder if it is any better than Memoize.

``````#!/usr/bin/env perl
use strict;
use warnings;
use v5.26;

print map { "n: \$_ l: ".l(\$_)."\n"} 0..19;

sub l {
my \$i=shift;
state @cache=(1,1);
push @cache, \$cache[-1]+\$cache[-2]+1 while(! defined(\$cache[\$i]));
\$cache[\$i];
}
``````

## Ryan Thompson

Ryan showed how the use of Memoize can be so powerful. Highly Recommended.

``````use 5.010;
use warnings;
use strict;
use Memoize; # This is a core module

# Use core Perl module "Memoize" to store results of previous calls
# Note this is the exact same code as leo_no_memo, apart from the memoize call
sub leo_memoize {
my \$n = shift;
return 1 if \$n < 2;
1 + leo_memoize(\$n - 1) + leo_memoize(\$n - 2);
}
memoize 'leo_memoize';

# In this case doing memoization ourselves is really easy, and turns out
# to be a surprising 777% faster than Memoize, so it's my preference.
{
my @leo = (1, 1);
sub leo_my_memo {
my \$n = shift;
\$leo[\$n] //= 1 + leo_my_memo(\$n - 1) + leo_my_memo(\$n - 2);
}
}

# Building up the list iteratively is also a good solution
sub leo_to_n {
my @r = (1, 1);
push @r, \$r[-1] + \$r[-2] + 1 for 2..\$_[0];
@r;
}

say for leo_to_n(20);
``````

## Saif Ahmed

Saif never hesitates caching whereever to speed up the performance. I simply love his work.

``````use strict;
use warnings;
use feature 'say';

# hash containing known Leornado numbers.  It is prepopulated with
# L(0) and L(1), but more added as discovered by L().
my %leonardos=(0=>1,1=>1,);

# Golden ratio numbers required for the closedForm() method
my \$gr1=(1+sqrt(5))/2;
my \$gr2=(1-sqrt(5))/2;

say  "\$_) ", L(\$_)  for (0..20);  # find the first 21 leonardo numbers

# This subroutines uses no caching and rapidly slowss after about
# 25 retrievals.
sub l{
my \$ln=shift;
return \$ln < 2?1:l(\$ln-2)+l(\$ln-1)+1;
}

#  This retrieves Leonardo numbers from cache where needed
sub L{
my \$ln=shift;

# find and store L(N) in the hash, if it does not exist already
unless (exists  \$leonardos{\$ln}) {
\$leonardos{\$ln}=L(\$ln-2)+L(\$ln-1)+1
};
#return stored L(N)
return \$leonardos{\$ln};
}

# This is a closed form function that requires no recursion
# see https://en.wikipedia.org/wiki/Leonardo_number
sub closedForm{
my \$ln=shift;
return 2*(\$gr1**(\$ln+1)-\$gr2**(\$ln+1))/(\$gr1-\$gr2) -1;
}
``````

## Steven Wilson

Steven kept it sweet and simple.

``````e strict;
use warnings;

my @leonardo_numbers = ( 1, 1 );
my \$counter = 2;

while ( \$counter < 20 ) {
\$leonardo_numbers[\$counter] =
\$leonardo_numbers[ \$counter - 1 ] +
\$leonardo_numbers[ \$counter - 2 ] +
1;
\$counter++;
}

print join " ", @leonardo_numbers, "\n";``
***

## Ulrich Rieke

**Ulrich** made good use of **negative** index. Clean Hack.

```perl
#!/usr/bin/perl ;
use strict ;
use warnings ;

my @leonardos = ( 1 , 1 ) ;
while ( (scalar @leonardos ) < 20 ) {
push @leonardos , \$leonardos[-1] + \$leonardos[-2] + 1 ;
}
for my \$num ( @leonardos ) {
print "\$num " ;
}
print "\n" ;
``````

## Walt Mankowski

Walt made good use swapping, very nice hack.

``````#!/usr/bin/env perl
use strict;
use warnings;
use feature qw(:5.30);
use experimental qw(signatures);

my \$N = 20;
my (\$l1, \$l2) = (1, 1);

for my \$i (0..\$N-1) {
if (\$i < 2) {
say "L(\$i) = 1";
} else {
(\$l1, \$l2) = (\$l2, \$l1 + \$l2 + 1);
say "L(\$i) = \$l2";
}
}
``````

## Wanderdoc

Wanderdoc exploited the Fibonacci series to get the desired result.

``````#!perl
use strict;
use warnings FATAL => qw(all);

my \$fn = shift || 20; #  or die "How much numbers?\n";
print join(" ", map 2 * fib(\$_ + 1) - 1, 0 .. 20), \$/;

sub fib
{
my \$n = shift;
my \$x = 0;
my \$y = 1;

my \$m = 0;
while ( \$m < \$n )
{
(\$x, \$y) = (\$y, \$x + \$y);
\$m++;

}

return \$x;
}
``````

(1) Perl Weekly Challenge 041 by Adam Russell

(2) PERL WEEKLY CHALLENGE – 041 by Javier Luque

(3) Perl Weekly Challenge 41: Attractive Numbers and Leonardo Numbers by Laurent Rosenfeld

(4) Attractive Numbers by Ryan Thompson

(5) Leonardo Numbers by Ryan Thompson

## SO WHAT DO YOU THINK ?

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