Perl Weekly Challenge 176.
My solutions (task 1 and task 2 ) to the The Weekly Challenge - 176.
Task 1: Permuted Multiples
Submitted by: Mohammad S Anwar
Write a script to find the smallest positive integer x such
that x, 2x, 3x, 4x, 5x and 6x are permuted multiples of each
other.
For example, the integers 125874 and 251748 are permutated
multiples of each other as
251784 = 2 x 125874
and also both have the same digits but in different order.
Output
142857
A brute force method consists of searching all integers, multiplying them by 2..6 and comparing their digits to those of the original integer. This may be simply done by ordering their digits and joining them, yielding a one-liner solution.
perl -MList::Util=all -E '
$n=1; while(1){ say($n), exit if all {o($n)==o($_*$n)} (2..6); ++$n}
sub o($n){join "", sort {$a<=>$b} split "", $n}'
Results:
142857
By changinng the initial value, I can search for the next one:
perl -MList::Util=all -E '
$n=142858; while(1){ say($n), exit if all {o($n)==o($_*$n)} (2..6); ++$n}
sub o($n){join "", sort {$a<=>$b} split "", $n}'
Results:
1428570
I can also change the set of multipliers to test, as in
perl -MList::Util=all -E '
$n=1; while(1){ say($n), exit if all {o($n)==o($_*$n)} (2..3); ++$n}
sub o($n){join "", sort {$a<=>$b} split "", $n}'
Results:
142857
Curiously, I get the same result if I only test 2 and 3 than when I test 2..4, 2..5 and 2..6. If I only test 2 I get a slightly smaller result, 125874, and the second result is 142857.
I also tested the multipliers 2..7 but got impatient after 2 minutes.
The full code is
1 # Perl weekly challenge 176
2 # Task 1: Permuted multiples
3 #
4 # See https://wlmb.github.io/2022/08/01/PWC176/#task-1-permuted-multiples
5 use v5.36;
6 use List::Util qw(all);
7 my $how_many=shift//1;
8 my $current=1;
9 my $found=0;
10 while($found<$how_many){
11 say("$found: ", join " ", map {$_*$current} (1..6)), ++$found
12 if all {ordered($current)==ordered($_*$current)} (2..6);
13 ++$current;
14 }
15
16 sub ordered($n){
17 join "", sort {$a<=>$b} split "", $n
18 }
Example: Get the first 6 numbers such that its 2..6 multiples are digit permutations.
./ch-1.pl 6
Results:
1: 142857 285714 428571 571428 714285 857142
2: 1428570 2857140 4285710 5714280 7142850 8571420
3: 1429857 2859714 4289571 5719428 7149285 8579142
4: 14285700 28571400 42857100 57142800 71428500 85714200
5: 14298570 28597140 42895710 57194280 71492850 85791420
6: 14299857 28599714 42899571 57199428 71499285 85799142
There seems to be a nice pattern that is easy to generalize. From the first three and the last 4 results, we may guess that 142857×1000=142857000 has permutted multiples, as well as 142985700, 142998570 and 142999857 (I eliminate the trailing zero and put a 9 at the fourth position), as we can verify with the following code:
perl -MList::Util=all -E '
for my $n(@ARGV){say "$n ", (all {o($n)==o($_*$n)} (2..6))?"yes":"no";}
sub o($n){join "", sort {$a<=>$b} split "", $n}
' 142857000 142985700 142998570 142999857
Results:
142857000 yes
142985700 yes
142998570 yes
142999857 yes
Just for fun, I also programmed the solution in emacs-lisp, as I’m writing this entry in emacs.
(defun sorted-digits (n)
"Sorted list of the digits of n"
(sort (mapcar
'string-to-number (split-string (number-to-string n) "" t)
)
'<))
(defun eqlist (nl ml)
"Check if two lists are equal"
(cond
((null nl) (null ml))
((eq (car nl) (car ml)) (eqlist (cdr nl) (cdr ml)))))
(defun check-multiplier (n m)
"Check if n and n*m have the same digits"
(let* ((r (* m n)) (nl (sorted-digits n)) (rl (sorted-digits r)))
(eqlist nl rl)))
(defun permuted-multiples (n)
"Check if the number n has permuted multiples"
(cl-loop for m from 2 to 6 for success = t then (check-multiplier n m)
until (not success) finally return success))
(defun search ()
"Search integers from 1 onward looking for permuted multiples"
(cl-loop
for n from 1 for found = nil then (permuted-multiples n)
until found finally return n))
;; Run the search and print the result
(print (search))
Results:
142857
Task 2: Reversible Numbers
Submitted by: Mohammad S Anwar
Write a script to find out all Reversible Numbers below 100.
A number is said to be a reversible if sum of the number and
its reverse had only odd digits.
For example,
36 is reversible number as 36 + 63 = 99 i.e. all digits are odd.
17 is not reversible as 17 + 71 = 88, none of the digits are odd.
Output
10, 12, 14, 16, 18, 21, 23, 25, 27,
30, 32, 34, 36, 41, 43, 45, 50, 52,
54, 61, 63, 70, 72, 81, 90
Out of laziness I propose a brute force solution: Search one by one all numbers until enough reversible numbers are found. We can ignore one digit numbers as they sum to themselves to yield even numbers.
perl -MList::Util=all -E 'for (10..100-1){push @r, $_ if r($_)} say join ", ", @r;
sub r($n){return all {$_%2==1} split "", $n+reverse $n}'|fmt
Results:
10, 12, 14, 16, 18, 21, 23, 25, 27, 30, 32, 34, 36, 41, 43, 45, 50, 52,
54, 61, 63, 70, 72, 81, 90
The full code is
# Perl weekly challenge 176
# Task 2: Reversible numbers
#
# See https://wlmb.github.io/2022/08/01/PW176/#task-2-reversible-numbers
use v5.36;
use List::Util qw(all);
my @reversible;
for (10..100-1){
push @reversible, $_ if is_reversible($_)
}
say join ", ", @reversible;
sub is_reversible($n){ # read the comments from the bottom up
return all {$_%2==1} # and check they are all odd
split "", # split the digits of the result
$n # the original number
+ # add it to
reverse $n # reverse digits
}
./ch-2.pl|fmt
Results:
10, 12, 14, 16, 18, 21, 23, 25, 27, 30, 32, 34, 36, 41, 43, 45, 50, 52,
54, 61, 63, 70, 72, 81, 90
I also do the code in emacs-lisp
(defun odd-digits (n)
"Check that n has only odd digits"
(cond
((null n) t)
((= (% (car n) 2) 1) (odd-digits (cdr n)))
(t nil)))
(defun digits (n)
"List of digits of n"
(mapcar 'string-to-number (split-string(number-to-string n) "" t)))
(defun reverse-digits (n)
"Number with the digits of n in reversed order"
(string-to-number(reverse(number-to-string n))))
(defun is-reversible (n)
"n is a reversible number"
(odd-digits (digits (+ n (reverse-digits n)))))
;; search and print reversible numbers below 100
(print (cl-loop for n from 10 below 100 append (if (is-reversible n) (list n) '())))
Results:
(10 12 14 16 18 21 23 25 27 30 32 34 36 41 43 45 50 52 54 61 63 70 72 81 90)