diff options
| -rw-r--r-- | challenge-169/athanasius/perl/ch-1.pl | 168 | ||||
| -rw-r--r-- | challenge-169/athanasius/perl/ch-2.pl | 132 | ||||
| -rw-r--r-- | challenge-169/athanasius/raku/ch-1.raku | 168 | ||||
| -rw-r--r-- | challenge-169/athanasius/raku/ch-2.raku | 217 |
4 files changed, 685 insertions, 0 deletions
diff --git a/challenge-169/athanasius/perl/ch-1.pl b/challenge-169/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..af339c879f --- /dev/null +++ b/challenge-169/athanasius/perl/ch-1.pl @@ -0,0 +1,168 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 169 +========================= + +TASK #1 +------- +*Brilliant Numbers* + +Submitted by: Mohammad S Anwar + +Write a script to generate first 20 Brilliant Numbers. + + Brilliant numbers are numbers with two prime factors of the same length. + +The number should have _exactly_ two prime factors, i.e. it’s the product of +two primes of the same length. + +For example, + + 24287 = 149 x 163 + 24289 = 107 x 227 + + Therefore 24287 and 24289 are 2-brilliant numbers. + These two brilliant numbers happen to be consecutive as there are no even + brilliant numbers greater than 14. + +Output + + 4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209, 221, 247, 253, + 289, 299 + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Note +---- +If an n-brilliant number is defined as a product of n primes of the same length +(i.e., of the same number of digits when represented in base 10), then this +Task is a search for 2-brilliant numbers. [2] + +Algorithm +--------- +The number of brilliant numbers required is specified in the constant $TARGET. +Although the number is given as 20 in the Task description, I have designed the +solution to accommodate larger numbers by making the generation of primes open- +ended. + +Prime numbers are generated by get_primes(), which receives as input the number +of digits required, and returns a sorted list of all the primes with that num- +ber of digits. get_primes() uses a sieve of Eratosthenes, which on subsequent +calls is extended as needed. + +The algorithm *constructs* brilliant numbers by producing all possible combina- +tions of prime numbers of a given number of digits. As the brilliant numbers +are produced out-of-order, they must be sorted to produce the required solu- +tion. However, note that when the number of digits per prime number increases, +the smallest new brilliant number is necessarily larger than the previously- +largest one; e.g., 101² > 97². Therefore, when a given number of prime digits +produces a total number of brilliant numbers greater than or equal to $TARGET, +no further generation of brilliant numbers is needed. + +Reference +--------- +[1] "A078972 Brilliant numbers: semiprimes (products of two primes, A001358) + whose prime factors have the same number of decimal digits.", OEIS, + https://oeis.org/A078972 +[2] Dario Alpern, "Brilliant numbers", + https://www.alpertron.com.ar/BRILLIANT.HTM + +=cut +#============================================================================== + +use strict; +use warnings; +use feature qw( state ); +use Const::Fast; +use List::MoreUtils qw( after_incl ); + +const my $TARGET => 20; +const my $USAGE => "Usage:\n perl $0\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 169, Task #1: Brilliant Numbers (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my $args = scalar @ARGV; + $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' . + "$args\n$USAGE"; + + my @brilliant; + + for (my $digits = 1; scalar @brilliant < $TARGET; ++$digits) + { + my $primes = get_primes( $digits ); + + for my $p (@$primes) + { + for my $q (after_incl { $_ == $p } @$primes) + { + push @brilliant, $p * $q; + } + } + } + + @brilliant = sort { $a <=> $b } @brilliant; + + printf "The first %d brilliant numbers:\n%s\n", + $TARGET, join ', ', @brilliant[ 0 .. $TARGET - 1 ]; +} + +#------------------------------------------------------------------------------ +sub get_primes # Extensible sieve of Eratosthenes +#------------------------------------------------------------------------------ +{ + my ($digits) = @_; + my $max_idx = 10 ** $digits - 1; + state @sieve = ((0, 0), (1) x ($max_idx - 1)); + my $orig_end = $#sieve; + state $first = 1; + + if ($first || $max_idx > $orig_end) + { + push @sieve, (1) x ($max_idx - $orig_end) if !$first; # Extend sieve + + for my $i (0 .. int sqrt $max_idx) + { + if ($sieve[ $i ]) # Prime + { + my $start = $first ? 2 : int( ($orig_end + 1) / $i ); + + for my $j ($start .. int( $max_idx / $i )) + { + $sieve[ $i * $j ] = 0; # Composite + } + } + } + + $first = 0; + } + + # @range contains all integers of the required number of digits: + # e.g., if $digits = 2 then @range = 10 .. 99 + + my @range = 10 ** ($digits - 1) .. $max_idx; + + return [ grep { $sieve[ $_ ] } @range ]; # Apply the sieve +} + +############################################################################### diff --git a/challenge-169/athanasius/perl/ch-2.pl b/challenge-169/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..babe969342 --- /dev/null +++ b/challenge-169/athanasius/perl/ch-2.pl @@ -0,0 +1,132 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 169 +========================= + +TASK #2 +------- +*Achilles Numbers* + +Submitted by: Mohammad S Anwar + +Write a script to generate first 20 Achilles Numbers. Please checkout +[ https://en.wikipedia.org/wiki/Achilles_number |wikipedia] for more informa- +tion. + + An Achilles number is a number that is powerful but imperfect. Named after + Achilles, a hero of the Trojan war, who was also powerful but imperfect. + + A positive integer n is a powerful number if, for every prime factor p of + n, p^2 is also a divisor. + + A number is a perfect power if it has any integer roots (square root, cube + root, etc.). + +For example 36 factors to (2, 2, 3, 3) - every prime factor (2, 3) also has its +square as a divisor (4, 9). But 36 has an integer square root, 6, so the number +is a perfect power. + +But 72 factors to (2, 2, 2, 3, 3); it similarly has 4 and 9 as divisors, but it +has no integer roots. This is an Achilles number. + +Output + + 72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, + 1125, 1152, 1323, 1352, 1372, 1568, 1800 + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Algorithm +--------- +Note that the given definition of an imperfect number, viz., "has no integer +roots", can also be expressed in terms of the number's prime factors: a number +is imperfect if and only if the highest common factor of the exponents of its +prime factors is 1. [1] + +Achilles numbers are identified as follows: + + Beginning with the number 2, successive integers are tested as follows: + + (1) Are they powerful? A number is powerful if and only if all of the + exponents of its prime factors are greater than 1. + (2) Are they imperfect? (see above). + + Numbers meeting both criteria are recorded as Achilles numbers. + +Implementation +-------------- +All the hard work is delegated to routines factor_exp() and gcd() in the CPAN +module Math::Prime::Util: + + factor_exp( $n ) returns an array of prime-factor/exponent pairs; e.g., + factor_exp( 360 ) = ([2, 3], [3, 2], [5, 1]) meaning 360 = 2³ × 3² × 5¹ + + gcd( $p, $q ) returns the greatest common divisor (aka the highest common + factor) of $p and $q; e.g., gcd( 30, 72 ) = 6 + +References +---------- +[1] "A052486 Achilles numbers - powerful but imperfect...", OEIS, + https://oeis.org/A052486 +[2] "Achilles number", Wikipedia, https://en.wikipedia.org/wiki/Achilles_number + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use List::Util qw( all ); +use Math::Prime::Util qw( factor_exp gcd ); + +const my $TARGET => 20; +const my $USAGE => "Usage:\n perl $0\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 169, Task #2: Achilles Numbers (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my $args = scalar @ARGV; + $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' . + "$args\n$USAGE"; + + my @achilles; + + for (my $n = 2; scalar @achilles < $TARGET; ++$n) + { + my @fact_exps = factor_exp( $n ); + my @exponents = map { $_->[ 1 ] } @fact_exps; + my $is_powerful = all { $_ >= 2 } @exponents; + + if ($is_powerful) + { + my $is_perfect = gcd( @exponents ) == 1; + + push @achilles, $n if $is_perfect; + } + } + + printf "The first %d Achilles numbers:\n%s\n", + $TARGET, join ', ', @achilles; +} + +############################################################################### diff --git a/challenge-169/athanasius/raku/ch-1.raku b/challenge-169/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..b78d5dfcdf --- /dev/null +++ b/challenge-169/athanasius/raku/ch-1.raku @@ -0,0 +1,168 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 169 +========================= + +TASK #1 +------- +*Brilliant Numbers* + +Submitted by: Mohammad S Anwar + +Write a script to generate first 20 Brilliant Numbers. + + Brilliant numbers are numbers with two prime factors of the same length. + +The number should have _exactly_ two prime factors, i.e. it’s the product of +two primes of the same length. + +For example, + + 24287 = 149 x 163 + 24289 = 107 x 227 + + Therefore 24287 and 24289 are 2-brilliant numbers. + These two brilliant numbers happen to be consecutive as there are no even + brilliant numbers greater than 14. + +Output + + 4, 6, 9, 10, 14, 15, 21, 25, 35, 49, 121, 143, 169, 187, 209, 221, 247, 253, + 289, 299 + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Note +---- +If an n-brilliant number is defined as a product of n primes of the same length +(i.e., of the same number of digits when represented in base 10), then this +Task is a search for 2-brilliant numbers. [2] + +Algorithm +--------- +The number of brilliant numbers required is specified in the constant $TARGET. +Although the number is given as 20 in the Task description, I have designed the +solution to accommodate larger numbers by making the generation of primes open- +ended. + +Prime numbers are generated by get-primes(), which receives as input the number +of digits required, and returns a sorted list of all the primes with that num- +ber of digits. get-primes() uses a sieve of Eratosthenes, which on subsequent +calls is extended as needed. + +The algorithm *constructs* brilliant numbers by producing all possible combina- +tions of prime numbers of a given number of digits. As the brilliant numbers +are produced out-of-order, they must be sorted to produce the required solu- +tion. However, note that when the number of digits per prime number increases, +the smallest new brilliant number is necessarily larger than the previously- +largest one; e.g., 101² > 97². Therefore, when a given number of prime digits +produces a total number of brilliant numbers greater than or equal to $TARGET, +no further generation of brilliant numbers is needed. + +Reference +--------- +[1] "A078972 Brilliant numbers: semiprimes (products of two primes, A001358) + whose prime factors have the same number of decimal digits.", OEIS, + https://oeis.org/A078972 +[2] Dario Alpern, "Brilliant numbers", + https://www.alpertron.com.ar/BRILLIANT.HTM + +=end comment +#============================================================================== + +my UInt constant $TARGET = 20; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 169, Task #1: Brilliant Numbers (Raku)\n".put; +} + +#============================================================================== +sub MAIN() +#============================================================================== +{ + my UInt %brilliant{UInt}; + + loop (my UInt $digits = 1; %brilliant.keys.elems < $TARGET; ++$digits) + { + my UInt @primes = get-primes( $digits ); + + for @primes -> UInt $p + { + for @primes -> UInt $q + { + ++%brilliant{ $p * $q }; + } + } + } + + my UInt @brilliant = %brilliant.keys.sort; + + "The first %d brilliant numbers:\n%s\n".printf: + $TARGET, @brilliant[ 0 .. $TARGET - 1 ].join: ', '; +} + +#------------------------------------------------------------------------------ +# Extensible sieve of Eratosthenes +# +sub get-primes( UInt:D $digits --> Seq:D[UInt:D] ) +#------------------------------------------------------------------------------ +{ + my UInt $max-idx = 10 ** $digits - 1; + state UInt @sieve = False, False, |(1 xx ($max-idx - 1)); + my UInt $orig-end = @sieve.end; + state Bool $first = True; + + if $first || $max-idx > $orig-end + { + @sieve.push: |(1 xx ($max-idx - $orig-end)) if !$first; # Extend sieve + + for 0 .. $max-idx.sqrt.Int -> UInt $i + { + if @sieve[ $i ] # Prime + { + my UInt $start = $first ?? 2 !! (($orig-end + 1) / $i).floor; + + for $start .. ($max-idx / $i).floor -> UInt $j + { + @sieve[ $i * $j ] = 0; # Composite + } + } + } + + $first = False; + } + + # @range contains all integers of the required number of digits: + # e.g., if $digits = 2 then @range = 10 .. 99 + + my UInt @range = 10 ** ($digits - 1) .. $max-idx; + + return @range.grep: { @sieve[ $_ ] }; # Apply the sieve +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +############################################################################### diff --git a/challenge-169/athanasius/raku/ch-2.raku b/challenge-169/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..9c7ccdf455 --- /dev/null +++ b/challenge-169/athanasius/raku/ch-2.raku @@ -0,0 +1,217 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 169 +========================= + +TASK #2 +------- +*Achilles Numbers* + +Submitted by: Mohammad S Anwar + +Write a script to generate first 20 Achilles Numbers. Please checkout +[ https://en.wikipedia.org/wiki/Achilles_number |wikipedia] for more informa- +tion. + + An Achilles number is a number that is powerful but imperfect. Named after + Achilles, a hero of the Trojan war, who was also powerful but imperfect. + + A positive integer n is a powerful number if, for every prime factor p of + n, p^2 is also a divisor. + + A number is a perfect power if it has any integer roots (square root, cube + root, etc.). + +For example 36 factors to (2, 2, 3, 3) - every prime factor (2, 3) also has its +square as a divisor (4, 9). But 36 has an integer square root, 6, so the number +is a perfect power. + +But 72 factors to (2, 2, 2, 3, 3); it similarly has 4 and 9 as divisors, but it +has no integer roots. This is an Achilles number. + +Output + + 72, 108, 200, 288, 392, 432, 500, 648, 675, 800, 864, 968, 972, + 1125, 1152, 1323, 1352, 1372, 1568, 1800 + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2022 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Algorithm +--------- +Note that the given definition of an imperfect number, viz., "has no integer +roots", can also be expressed in terms of the number's prime factors: a number +is imperfect if and only if the highest common factor of the exponents of its +prime factors is 1. [1] + +Achilles numbers are identified as follows: + + Beginning with the number 2, successive integers are tested as follows: + + (1) Are they powerful? A number is powerful if and only if all of the + exponents of its prime factors are greater than 1. + (2) Are they imperfect? (see above). + + Numbers meeting both criteria are recorded as Achilles numbers. + +Implementation +-------------- +Routine prime-factors() is copied from the Raku solution to Week 168, Task 2. +Routine prime-factor-pairs() transforms the output of prime-factors() into an +array of prime-factor/exponent pairs; e.g., for $n = 360, the prime factors +[2, 2, 2, 3, 3, 5] become [[2, 3], [3, 2], [5, 1]]. + +Routine gcd() uses the Euclidean algorithm [3] to find the greatest common +divisor of the first two input numbers, then repeats the algorithm with the gcd +just found and the next input number, and so on until the input is exhausted. + +References +---------- +[1] "Achilles numbers - powerful but imperfect...", OEIS, + https://oeis.org/A052486 +[2] "Achilles number", Wikipedia, https://en.wikipedia.org/wiki/Achilles_number +[3] "Greatest common divisor", Wikipedia, + https://en.wikipedia.org/wiki/Greatest_common_divisor + +=end comment +#============================================================================== + +my UInt constant $TARGET = 20; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 169, Task #2: Achilles Numbers (Raku)\n".put; +} + +#============================================================================== +sub MAIN() +#============================================================================== +{ + my UInt @achilles; + + loop (my UInt $n = 2; +@achilles < $TARGET; ++$n) + { + my Array[UInt] @factor-pairs = prime-factor-pairs( $n ); + my UInt @exponents = @factor-pairs.map: { $_[ 1 ] }; + my Bool $is-powerful = (@exponents.all >= 2).so; + + if $is-powerful + { + my Bool $is-perfect = gcd( @exponents ) == 1; + + @achilles.push: $n if $is-perfect; + } + } + + "The first %d Achilles numbers:\n%s\n".printf: + $TARGET, @achilles.join: ', '; +} + +#------------------------------------------------------------------------------ +sub prime-factor-pairs( UInt:D $n where * ≥ 2 --> Array:D[Array:D[UInt:D]] ) +#------------------------------------------------------------------------------ +{ + my UInt @prime-factors = prime-factors( $n ); + my UInt %factor2exp{UInt}; + + for @prime-factors.sort -> UInt $factor + { + ++%factor2exp{ $factor }; + } + + my Array[UInt] @prime-factor-pairs; + + for %factor2exp.keys.sort -> UInt $factor + { + my UInt $exponent = %factor2exp{ $factor }; + + @prime-factor-pairs.push: Array[UInt].new: $factor, $exponent; + } + + return @prime-factor-pairs; +} + +#------------------------------------------------------------------------------ +sub prime-factors( UInt:D $n where * ≥ 2 --> Array:D[UInt:D] ) +#------------------------------------------------------------------------------ +{ + my UInt @prime-factors; + my UInt $dividend = $n; + + while $dividend %% 2 + { + @prime-factors.push: 2; + + $dividend = ($dividend / 2).Int; + } + + my UInt $start = 3; + + L-OUTER: while $dividend > 1 + { + loop (my UInt $factor = $start; ; $factor += 2) + { + if $factor.is-prime && $dividend %% $factor + { + @prime-factors.push: $factor; + + $dividend = ($dividend / $factor).Int; + $start = $factor; + + if $dividend.is-prime + { + @prime-factors.push: $dividend; + last L-OUTER; + } + + next L-OUTER; + } + } + } + + return @prime-factors; +} + +#------------------------------------------------------------------------------ +sub gcd( *@nums where { +@nums ≥ 1 && .all ~~ UInt:D && .all ≥ 1 } --> UInt:D ) +#------------------------------------------------------------------------------ +{ + my UInt $a = @nums.shift; + + while +@nums + { + my UInt $b = @nums.shift; + + # Euclidean algorithm: "the algorithm replaces (a, b) by (b, a mod b) + # repeatedly until the pair is (d, 0)" [3] + + ($a, $b) = $b, $a % $b until $b == 0; + } + + return $a; +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +############################################################################### |