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.



Task #1



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.


Adam Russell

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;
}


Task #2



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

For example:

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

and so on.


Adam Russell

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;
}


SEE ALSO



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

Contact with me