perl logo Perl logo (Thanks to Olaf Alders)

The weekly challenge 350 - Task 2: Shuffle Pairs

  1 #!/usr/bin/env perl
  2 # https://theweeklychallenge.org/blog/perl-weekly-challenge-350/#TASK2
  3 #
  4 # Task 2: Shuffle Pairs
  5 # =====================
  6 #
  7 # If two integers A <= B have the same digits but in different orders, we say
  8 # that they belong to the same shuffle pair if and only if there is an integer
  9 # k such that B = A * k where k is called the witness of the pair.
 10 #
 11 # For example, 1359 and 9513 belong to the same shuffle pair, because 1359 * 7 = 9513.
 12 #
 13 # Interestingly, some integers belong to several different shuffle pairs. For
 14 # example, 123876 forms one shuffle pair with 371628, and another with 867132,
 15 # as 123876 * 3 = 371628, and 123876 * 7 = 867132.
 16 #
 17 # Write a function that for a given $from, $to, and $count returns the number
 18 # of integers $i in the range $from <= $i <= $to that belong to at least $count
 19 # different shuffle pairs.
 20 #
 21 # PS: Inspired by a conversation between Mark Dominus and Simon Tatham at Mastodon.
 22 #
 23 ## Example 1
 24 ##
 25 ## Input: $from = 1, $to = 1000, $count = 1
 26 ## Output: 0
 27 ##
 28 ## There are no shuffle pairs with elements less than 1000.
 29 #
 30 #
 31 ## Example 2
 32 ##
 33 ## Input: $from = 1500, $to = 2500, $count = 1
 34 ## Output: 3
 35 ##
 36 ## There are 3 integers between 1500 and 2500 that belong to shuffle pairs.
 37 ##
 38 ## 1782, the other element is 7128 (witness 4)
 39 ## 2178, the other element is 8712 (witness 4)
 40 ## 2475, the other element is 7425 (witness 3)
 41 #
 42 #
 43 ## Example 3
 44 ##
 45 ## Input: $from = 1_000_000, $to = 1_500_000, $count = 5
 46 ## Output: 2
 47 ##
 48 ## There are 2 integers in the given range that belong to 5 different shuffle
 49 ## pairs.
 50 ##
 51 ## 1428570 pairs with 2857140, 4285710, 5714280, 7142850, and 8571420
 52 ## 1429857 pairs with 2859714, 4289571, 5719428, 7149285, and 8579142
 53 ##
 54 ## The witnesses are 2, 3, 4, 5, and 6 for both the integers.
 55 #
 56 #
 57 ## Example 4
 58 ##
 59 ## Input: $from = 13_427_000, $to = 14_100_000, $count = 2
 60 ## Output: 11
 61 ##
 62 ## 6 integers in the given range belong to 3 different shuffle pairs, 5
 63 ## integers belong to 2 different ones.
 64 #
 65 #
 66 ## Example 5
 67 ##
 68 ## Input: $from = 1030, $to = 1130, $count = 1
 69 ## Output: 2
 70 ##
 71 ## There are 2 integers between 1030 and 1130 that belong to at least one shuffle pair:
 72 ## 1035, the other element is 3105 (witness k = 3)
 73 ## 1089, the other element is 9801 (witness k = 9)
 74 #
 75 ############################################################
 76 ##
 77 ## discussion
 78 ##
 79 ############################################################
 80 #
 81 # We start by noting that a number can only have shuffle pairs with witnesses
 82 # in the range 2..9.
 83 # However, this can go both ways: 1359 pairs with 9513, so in case the range is
 84 # 1000..1500, we need to find this pair, but we also need to find it if the
 85 # range is 9000..9600 (and we need to find both the numbers as part of a shuffle
 86 # pair if the range is 1000..9600).
 87 # So for each number in the range, we check whether we have the required number
 88 # of pairs by checking in both directions - which means both multiplying and
 89 # dividing by 2..9.
 90 # We can stop searching for more witnesses once we found enough witnesses for
 91 # our given count.
 92 #
 93 use v5.36;
 94 
 95 shuffle_pairs(1, 1000, 1);
 96 shuffle_pairs(1500, 2500, 1);
 97 shuffle_pairs(1_000_000, 1_500_000, 5);
 98 shuffle_pairs(13_427_000, 14_100_000, 2);
 99 shuffle_pairs(1030, 1130, 1);
100 
101 sub shuffle_pairs($from, $to, $count) {
102     say "Input: $from, $to, $count";
103     my $output = 0;
104     foreach my $i ($from..$to) {
105         $output++ if enough_pairs($i, $count);
106     }
107     say "Output: $output";
108 }
109 
110 sub enough_pairs($number, $required_count) {
111     my $count = 0;
112     foreach my $x (2..9) {
113         $count++ if is_pair($number, $number * $x);
114         $count++ if is_pair($number, $number / $x);
115         last if $count >= $required_count;
116     }
117     return $count >= $required_count;
118 }
119 
120 sub is_pair($i, $j) {
121     return 0 unless $j == int($j);
122     my $left = join("", sort {$a <=> $b} split //,$i);
123     my $right = join("", sort {$a <=> $b} split //,$j);
124     return $left eq $right;
125 }