From 7b5d182d13b17173d90126381681f9583f8f88eb Mon Sep 17 00:00:00 2001 From: PerlMonk-Athanasius Date: Sun, 5 Dec 2021 18:58:11 +1000 Subject: Perl & Raku solutions to Tasks 1 & 2 of the Perl Weekly Challenge #141 --- challenge-141/athanasius/perl/ch-1.pl | 136 +++++++++++++++++++ challenge-141/athanasius/perl/ch-2.pl | 228 ++++++++++++++++++++++++++++++++ challenge-141/athanasius/raku/ch-1.raku | 136 +++++++++++++++++++ challenge-141/athanasius/raku/ch-2.raku | 204 ++++++++++++++++++++++++++++ 4 files changed, 704 insertions(+) create mode 100644 challenge-141/athanasius/perl/ch-1.pl create mode 100644 challenge-141/athanasius/perl/ch-2.pl create mode 100644 challenge-141/athanasius/raku/ch-1.raku create mode 100644 challenge-141/athanasius/raku/ch-2.raku diff --git a/challenge-141/athanasius/perl/ch-1.pl b/challenge-141/athanasius/perl/ch-1.pl new file mode 100644 index 0000000000..614d2c8061 --- /dev/null +++ b/challenge-141/athanasius/perl/ch-1.pl @@ -0,0 +1,136 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 141 +========================= + +TASK #1 +------- +*Number Divisors* + +Submitted by: Mohammad S Anwar + +Write a script to find lowest 10 positive integers having exactly 8 divisors. + +Example + + 24 is the first such number having exactly 8 divisors. + 1, 2, 3, 4, 6, 8, 12 and 24. + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Configuration +------------- +- Set $VERBOSE to a true value to show the divisors of each integer in the + solution +- $DIVISORS is configurable; e.g., $DIVISORS = 2 generates the prime numbers! + +Algorithm +--------- +1. Divisors come in pairs: if i is a divisor of n then j = n / i is also a + divisor of n +2. If i = j then i = sqrt(n) + +So, to find all the divisors of n by searching, it's only necessary to search +the range 1 to sqrt(n): + + divisors := empty + FOR d in range 1 to ⌊sqrt(n)⌋ + IF d is a divisor of n THEN + Add d to divisors + d1 := n / d + IF d < d1 + Add d1 to divisors + ENDIF + ENDIF + ENDFOR + sort divisors ascending + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; + +const my $VERBOSE => 1; +const my $DIVISORS => 8; +const my $TARGET => 10; +const my $USAGE => "Usage:\n perl $0\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 141, Task #1: Number Divisors (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my $args = scalar @ARGV; + $args == 0 or die 'ERROR: Expected 0 command line arguments, found ' . + "$args\n$USAGE"; + + printf "The lowest %d positive integers having exactly %d divisors:\n", + $TARGET, $DIVISORS; + + for (my ($first, $n, $count) = (1, 1, 0); $count < $TARGET; ++$n) + { + my @divisors = find_divisors( $n ); + + if (scalar @divisors == $DIVISORS) + { + if ($VERBOSE) + { + printf " %2d (%s )\n", $n, + join ', ', map { sprintf '%2d', $_ } @divisors; + } + else + { + printf '%s%d', $first ? ' ' : ', ', $n; + } + + $first = 0; + ++$count; + } + } + + print "\n" unless $VERBOSE; +} + +#------------------------------------------------------------------------------ +sub find_divisors +#------------------------------------------------------------------------------ +{ + my ($n) = @_; + my @div; + + for my $d (1 .. int sqrt $n) + { + if ($n % $d == 0) + { + push @div, $d; + + my $d1 = $n / $d; + + push @div, $d1 if $d < $d1; + } + } + + return sort { $a <=> $b } @div; +} + +############################################################################### diff --git a/challenge-141/athanasius/perl/ch-2.pl b/challenge-141/athanasius/perl/ch-2.pl new file mode 100644 index 0000000000..af919a4897 --- /dev/null +++ b/challenge-141/athanasius/perl/ch-2.pl @@ -0,0 +1,228 @@ +#!perl + +############################################################################### +=comment + +Perl Weekly Challenge 141 +========================= + +TASK #2 +------- +*Like Numbers* + +Submitted by: Mohammad S Anwar + +You are given positive integers, $m and $n. + +Write a script to find total count of integers created using the digits of $m +which is also divisible by $n. + +Repeating of digits are not allowed. Order/Sequence of digits can't be altered. +You are only allowed to use (n-1) digits at the most. For example, 432 is not +acceptable integer created using the digits of 1234. Also for 1234, you can +only have integers having no more than three digits. + +Example 1: + + Input: $m = 1234, $n = 2 + Output: 9 + + Possible integers created using the digits of 1234 are: + 1, 2, 3, 4, 12, 13, 14, 23, 24, 34, 123, 124, 134 and 234. + + There are 9 integers divisible by 2 such as: + 2, 4, 12, 14, 24, 34, 124, 134 and 234. + +Example 2: + + Input: $m = 768, $n = 4 + Output: 3 + + Possible integers created using the digits of 768 are: + 7, 6, 8, 76, 78 and 68. + + There are 3 integers divisible by 4 such as: + 8, 76 and 68. + +=cut +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=comment + +Assumptions +----------- +- "You are only allowed to use (n-1) digits at the most." From the examples, I + assume the "n" here is unrelated to $n, and is a shorthand for the following: + If $m has n digits, then each created integer may contain between 1 and n-1 + digits. +- "Repeating of digits are not allowed." I assume this means that a digit which + occurs once in $m cannot occur twice in a created integer. But I assume that + repeated digits are allowed within $m, and that these repeated digits may + also occur in created integers (provided they occur in the correct order). +- I assume that the desired output is a count of *unique* solutions. + +Configuration +------------- +- If the digit 0 occurs in $m, then the number zero will be a possible created + integer; and since 0 is evenly divisible by any (non-zero) integer, 0 will + then always appear in the solution set. It is not clear from the Task Des- + cription whether this is the desired result; so the constant $ALLOW_0 is pro- + vided. When it is set to a true value (the default), 0 may appear in the + solution set; when it is set to a false value, the number 0 will be excluded + from the solution set. +- When the constant $VERBOSE is set to a true value (the default), the output + will be followed by a list of possible integers and a list of the integers in + the solution set, as shown in the Task Description. + +Algorithm +--------- +Determining whether a created integer is evenly divisible by $n is trivial. But +the construction of possible integers which precedes this step is more inter- +esting: + + [Array] pool := the empty string + FOR each digit d in $m (most to least significant digit) + FOR each entry p in pool (as it is populated on *entering* this loop) + concatenate p with d and store the result ("pd") in pool + ENDFOR + ENDFOR + Remove the empty string and the string representing $m from pool + Remove any strings beginning with an initial '0' + Optionally restore the number zero itself + Remove duplicates from pool + Convert the strings in pool to integers + Sort the integers in pool in ascending numerical order + +The above algorithm could also be performed in reverse: + + FOR each digit d in $m (least to most significant digit) + FOR each entry p in pool (as it is populated on *entering* this loop) + concatenate d with p and store the result ("dp") in pool + ENDFOR + ENDFOR + +=cut +#============================================================================== + +use strict; +use warnings; +use Const::Fast; +use Regexp::Common qw( number ); + +const my $VERBOSE => 1; +const my $ALLOW_0 => 1; +const my $USAGE => +"Usage: + perl $0 + + Positive integer: source of digits + Positive integer: divisor\n"; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + $| = 1; + print "\nChallenge 141, Task #2: Like Numbers (Perl)\n\n"; +} + +#============================================================================== +MAIN: +#============================================================================== +{ + my ($m, $n) = parse_command_line(); + + print "Input: \$m = $m, \$n = $n\n"; + + my @ints = find_all_integers( $m ); + my @like; + + for my $i (@ints) + { + push @like, $i if $i % $n == 0; + } + + printf "Output: %d\n", scalar @like; + + explain( $m, $n, \@ints, \@like ) if $VERBOSE; +} + +#------------------------------------------------------------------------------ +sub find_all_integers +#------------------------------------------------------------------------------ +{ + my ($m) = @_; + my @pool = ''; + + for my $digit (split //, $m) + { + push @pool, $pool[ $_ ] . $digit for 0 .. $#pool; + } + + shift @pool; # Remove the empty string + pop @pool; # Remove $m + + @pool = grep { !/ ^ 0 /x } @pool; + + push @pool, 0 if $ALLOW_0 && $m =~ / 0 /x; # Optionally restore zero + + my %uniq; + ++$uniq{ $_ } for @pool; + + return sort { $a <=> $b } keys %uniq; +} + +#------------------------------------------------------------------------------ +sub explain +#------------------------------------------------------------------------------ +{ + my ($m, $n, $ints, $like) = @_; + my $possibles = scalar @$ints; + my $solutions = scalar @$like; + + printf "\n%d integer%s can be created using the digits of %d", + $possibles, ($possibles == 1 ? '' : 's' ), $m; + + print +($possibles == 0) ? "\n" : ":\n" . join( ', ', @$ints ) . "\n"; + + printf "\nof which %d %s evenly divisible by %d", + $solutions, ($solutions == 1 ? 'is' : 'are'), $n; + + print +($solutions == 0) ? "\n" : ":\n" . join( ', ', @$like ) . "\n"; +} + +#------------------------------------------------------------------------------ +sub parse_command_line +#------------------------------------------------------------------------------ +{ + my $args = scalar @ARGV; + $args == 2 or error( "Expected 2 command line arguments, found $args" ); + + my ($m, $n) = @ARGV; + + for my $i ($m, $n) + { + $i =~ / ^ $RE{num}{int} $ /x + or error( qq["$i" is not a valid integer] ); + + $i > 0 or error( qq["$i" is not positive] ); + } + + return ($m, $n); +} + +#------------------------------------------------------------------------------ +sub error +#------------------------------------------------------------------------------ +{ + my ($message) = @_; + + die "ERROR: $message\n$USAGE"; +} + +############################################################################### diff --git a/challenge-141/athanasius/raku/ch-1.raku b/challenge-141/athanasius/raku/ch-1.raku new file mode 100644 index 0000000000..bc23aada79 --- /dev/null +++ b/challenge-141/athanasius/raku/ch-1.raku @@ -0,0 +1,136 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 141 +========================= + +TASK #1 +------- +*Number Divisors* + +Submitted by: Mohammad S Anwar + +Write a script to find lowest 10 positive integers having exactly 8 divisors. + +Example + + 24 is the first such number having exactly 8 divisors. + 1, 2, 3, 4, 6, 8, 12 and 24. + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Configuration +------------- +- Set $VERBOSE to True to show the divisors of each integer in the solution +- $DIVISORS is configurable; e.g., $DIVISORS = 2 generates the prime numbers! + +Algorithm +--------- +1. Divisors come in pairs: if i is a divisor of n then j = n / i is also a + divisor of n +2. If i = j then i = sqrt(n) + +So, to find all the divisors of n by searching, it's only necessary to search +the range 1 to sqrt(n): + + divisors := empty + FOR d in range 1 to ⌊sqrt(n)⌋ + IF d is a divisor of n THEN + Add d to divisors + d1 := n / d + IF d < d1 + Add d1 to divisors + ENDIF + ENDIF + ENDFOR + sort divisors ascending + +=end comment +#============================================================================== + +my Bool constant $VERBOSE = True; +my UInt constant $DIVISORS = 8; +my UInt constant $TARGET = 10; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 141, Task #1: Number Divisors (Raku)\n".put; +} + +#============================================================================== +sub MAIN() +#============================================================================== +{ + "The lowest %d positive integers having exactly %d divisors:\n".printf: + $TARGET, $DIVISORS; + + loop (my (Bool $first, UInt $n, UInt $count) = (True, 1, 0); + $count < $TARGET; ++$n) + { + my UInt @divisors = find-divisors( $n ); + + if @divisors.elems == $DIVISORS + { + if $VERBOSE + { + " %d (%s )\n".printf: + $n, @divisors.map( { '%2d'.sprintf: $_ } ).join: ', '; + } + else + { + '%s%d'.printf: $first ?? ' ' !! ', ', $n; + } + + $first = False; + ++$count; + } + } + + "\n".print unless $VERBOSE; +} + +#------------------------------------------------------------------------------ +sub find-divisors( UInt:D $n --> Seq:D[UInt:D] ) +#------------------------------------------------------------------------------ +{ + my UInt @div; + + for 1 .. $n.sqrt.Int -> UInt $d + { + if $n % $d == 0 + { + @div.push: $d; + + my UInt $d1 = $n div $d; # Note: integer division + + @div.push: $d1 if $d < $d1; + } + } + + return @div.sort; +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/; + + $usage.put; +} + +############################################################################## diff --git a/challenge-141/athanasius/raku/ch-2.raku b/challenge-141/athanasius/raku/ch-2.raku new file mode 100644 index 0000000000..e4eb6860da --- /dev/null +++ b/challenge-141/athanasius/raku/ch-2.raku @@ -0,0 +1,204 @@ +use v6d; + +############################################################################### +=begin comment + +Perl Weekly Challenge 141 +========================= + +TASK #2 +------- +*Like Numbers* + +Submitted by: Mohammad S Anwar + +You are given positive integers, $m and $n. + +Write a script to find total count of integers created using the digits of $m +which is also divisible by $n. + +Repeating of digits are not allowed. Order/Sequence of digits can’t be altered. +You are only allowed to use (n-1) digits at the most. For example, 432 is not +acceptable integer created using the digits of 1234. Also for 1234, you can +only have integers having no more than three digits. + +Example 1: + + Input: $m = 1234, $n = 2 + Output: 9 + + Possible integers created using the digits of 1234 are: + 1, 2, 3, 4, 12, 13, 14, 23, 24, 34, 123, 124, 134 and 234. + + There are 9 integers divisible by 2 such as: + 2, 4, 12, 14, 24, 34, 124, 134 and 234. + +Example 2: + + Input: $m = 768, $n = 4 + Output: 3 + + Possible integers created using the digits of 768 are: + 7, 6, 8, 76, 78 and 68. + + There are 3 integers divisible by 4 such as: + 8, 76 and 68. + +=end comment +############################################################################### + +#--------------------------------------# +# Copyright © 2021 PerlMonk Athanasius # +#--------------------------------------# + +#============================================================================== +=begin comment + +Assumptions +----------- +- "You are only allowed to use (n-1) digits at the most." From the examples, I + assume the "n" here is unrelated to $n, and is a shorthand for the following: + If $m has n digits, then each created integer may contain between 1 and n-1 + digits. +- "Repeating of digits are not allowed." I assume this means that a digit which + occurs once in $m cannot occur twice in a created integer. But I assume that + repeated digits are allowed within $m, and that these repeated digits may + also occur in created integers (provided they occur in the correct order). +- I assume that the desired output is a count of *unique* solutions. + +Configuration +------------- +- If the digit 0 occurs in $m, then the number zero will be a possible created + integer; and since 0 is evenly divisible by any (non-zero) integer, 0 will + then always appear in the solution set. It is not clear from the Task Des- + cription whether this is the desired result; so the constant $ALLOW_0 is pro- + vided. When it is set to True (the default), 0 may appear in the solution + set; when it is set to False, the number 0 will be excluded from the solution + set. +- When the constant $VERBOSE is set to True (the default), the output will be + followed by a list of possible integers and a list of the integers in the + solution set, as shown in the Task Description. + +Algorithm +--------- +Determining whether a created integer is evenly divisible by $n is trivial. But +the construction of possible integers which precedes this step is more inter- +esting: + + [Array] pool := the empty string + FOR each digit d in $m (most to least significant digit) + FOR each entry p in pool (as it is populated on *entering* this loop) + concatenate p with d and store the result ("pd") in pool + ENDFOR + ENDFOR + Remove the empty string and the string representing $m from pool + Remove any strings beginning with an initial '0' + Optionally restore the number zero itself + Remove duplicates from pool + Convert the strings in pool to integers + Sort the integers in pool in ascending numerical order + +The above algorithm could also be performed in reverse: + + FOR each digit d in $m (least to most significant digit) + FOR each entry p in pool (as it is populated on *entering* this loop) + concatenate d with p and store the result ("dp") in pool + ENDFOR + ENDFOR + +=end comment +#============================================================================== + +my Bool constant $VERBOSE = True; +my Bool constant $ALLOW_0 = True; + +subset Positive of Int where * > 0; + +#------------------------------------------------------------------------------ +BEGIN +#------------------------------------------------------------------------------ +{ + "\nChallenge 141, Task #2: Like Numbers (Raku)\n".put; +} + +#============================================================================== +sub MAIN +( + Positive:D $m, #= Positive integer: source of digits + Positive:D $n #= Positive integer: divisor +) +#============================================================================== +{ + "Input: \$m = $m, \$n = $n".put; + + my UInt @ints = find-all-integers( $m ); + my UInt @like; + + for @ints -> UInt $i + { + @like.push: $i if $i % $n == 0; + } + + "Output: %d\n".printf: @like.elems; + + explain( $m, $n, @ints, @like ) if $VERBOSE; +} + +#------------------------------------------------------------------------------ +sub find-all-integers( Positive:D $m --> Seq:D[UInt:D] ) +#------------------------------------------------------------------------------ +{ + my Str @pool = ''; + + for $m.split( '', :skip-empty ) -> Str $digit + { + @pool.push: @pool[ $_ ] ~ $digit for 0 .. @pool.end; + } + + @pool.shift; # Remove the empty string + @pool.pop; # Remove $m + @pool.=grep: { !/ ^ 0 / }; # Remove all strings beginning with zero + + @pool.push: '0' if $ALLOW_0 && $m ~~ / 0 /; # Restore zero itself + + my UInt %uniq; # Remove duplicates + ++%uniq{ $_ } for @pool; + + return %uniq.keys.map( { .Int } ).sort; +} + +#------------------------------------------------------------------------------ +sub explain +( + Positive:D $m, + Positive:D $n, + Array:D[UInt:D] $ints, + Array:D[UInt:D] $like +) +#------------------------------------------------------------------------------ +{ + my UInt $possibles = @$ints.elems; + my UInt $solutions = @$like.elems; + + "\n%d integer%s can be created using the digits of %d".printf: + $possibles, ($possibles == 1 ?? '' !! 's' ), $m; + + (($possibles == 0) ?? '' !! ":\n" ~ @$ints.join( ', ' )).put; + + "\nof which %d %s evenly divisible by %d".printf: + $solutions, ($solutions == 1 ?? 'is' !! 'are'), $n; + + (($solutions == 0) ?? '' !! ":\n" ~ @$like.join( ', ' )).put; +} + +#------------------------------------------------------------------------------ +sub USAGE() +#------------------------------------------------------------------------------ +{ + my Str $usage = $*USAGE; + + $usage ~~ s/ ($*PROGRAM-NAME) /raku $0/; + $usage.put; +} + +############################################################################## -- cgit