How to resolve the algorithm Jordan-Pólya numbers step by step in the Perl programming language

Published on 12 May 2024 09:40 PM
#Perl

How to resolve the algorithm Jordan-Pólya numbers step by step in the Perl programming language

Table of Contents

Problem Statement

Jordan-Pólya numbers (or J-P numbers for short) are the numbers that can be obtained by multiplying together one or more (not necessarily distinct) factorials. 480 is a J-P number because 480 = 2! x 2! x 5!. Find and show on this page the first 50 J-P numbers. What is the largest J-P number less than 100 million? Find and show on this page the 800th, 1,800th, 2,800th and 3,800th J-P numbers and also show their decomposition into factorials in highest to lowest order. Optionally, do the same for the 1,050th J-P number. Where there is more than one way to decompose a J-P number into factorials, choose the way which uses the largest factorials. Hint: These J-P numbers are all less than 2^53.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Jordan-Pólya numbers step by step in the Perl programming language

Source code in the perl programming language

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

use ntheory 'factorial';
use List::AllUtils <max firstidx>;

sub table { my $t = 10 * (my $c = 1 + length max @_); ( sprintf( ('%'.$c.'d')x@_, @_) ) =~ s/.{1,$t}\K/\n/gr }

sub Jordan_Polya {
    my $limit = shift;
    my($k,@JP) = (2);
    push @JP, factorial $_ for 0..18;

    while ($k < @JP) {
        my $rk = $JP[$k];
        for my $l (2 .. @JP) {
            my $kl = $JP[$l] * $rk;
            last if $kl > $limit;
            LOOP: {
                my $p = firstidx { $_ >= $kl } @JP;
                if    ($p  < $#JP and $JP[$p] != $kl) { splice @JP, $p, 0, $kl }
                elsif ($p == $#JP                   ) {   push @JP,        $kl }
                $kl > $limit/$rk ? last LOOP : ($kl *= $rk)
            }
        }
        $k++
    }
    shift @JP; return @JP
}

my @JP = Jordan_Polya 2**27;
say "First 50 Jordan-Pólya numbers:\n" . table @JP[0..49];
say 'The largest Jordan-Pólya number before 100 million: ' . $JP[-1 + firstidx { $_ > 1e8 } @JP];

You may also check:How to resolve the algorithm Barnsley fern step by step in the Mathematica / Wolfram Language programming language
You may also check:How to resolve the algorithm Knapsack problem/Continuous step by step in the Picat programming language
You may also check:How to resolve the algorithm Five weekends step by step in the Elixir programming language
You may also check:How to resolve the algorithm Increment a numerical string step by step in the Prolog programming language
You may also check:How to resolve the algorithm Real constants and functions step by step in the Chef programming language