Peter
Peter Campbell Smith

Running persistence

Weekly challenge 238 — 9 October 2023

Week 238 - 9 Oct 2023

Task 2

Task — Persistence sort

You are given an array of positive integers, @int. Write a script to sort the given array in increasing order with respect to the count of steps required to obtain a single-digit number by multiplying its digits recursively for each array element. If any two numbers have the same count of steps, then print the smaller number first.

Examples


Example 1
Input: @int = (15, 99, 1, 34)
Output: (1, 15, 34, 99)

15 => 1 x 5 => 5 (1 step)
99 => 9 x 9 => 81 => 8 x 1 => 8 (2 steps)
1  => 0 step
34 => 3 x 4 => 12 => 1 x 2 => 2 (2 steps)

Example 2
Input: @int = (50, 25, 33, 22)
Output: (22, 33, 50, 25)

50 => 5 x 0 => 0 (1 step)
25 => 2 x 5 => 10 => 1 x 0 => 0 (2 steps)
33 => 3 x 3 => 9 (1 step)
22 => 2 x 2 => 4 (1 step)

Analysis

The essence of this task is the multiplication of the digits of an integer. To do that, I treat the number as a string and use a regular expression to precede each digit with ' * ', then precede the string with 1, and use eval to evaluate the string as an expression:

while ($product > 9) {

   # convert 123 to * 1 * 2 * 3
   $product =~ s|(\d)|\* $1 |g; 

   # evaluate 1 * 1 * 2 * 3
   $product = eval(qq[1$product]);
}

There is then the slightly awkward requirement to present the results in order of the number of steps required (ie number of iterations of the above while), and the slightly more awkward rule to report those with an equal number of steps in increasing order.

I do that by an initial sort of the supplied @ints, then loop over the possible number of steps from 0 upwards, and within that iterate over @ints, reporting any member that requires the current number of steps. I count the number of @ints reported and break out of the loops when that count equals the number of integers in @ints.

Of course that is rather inefficient, but the number of steps required rises very slowly as the source numbers increase. The numbers 1, 10, 25, 39, 77, 679, 6788 and 68889 are respectively the smallest integers whose repetitively multiplied digits require 0, 1, 2 ... 7 steps to reach a single digit. No number under a million requires 8.

Try it 

Try running the script with any input, for example:
234, 345, 456, 567, 678


Script


#!/usr/bin/perl

use v5.16;    # The Weekly Challenge - 2023-10-09
use utf8;     # Week 238 task 2 - Persistence sort
use strict;   # Peter Campbell Smith
use warnings; # Blog: http://ccgi.campbellsmiths.force9.co.uk/challenge

persistence_sort(15, 99, 1, 34);
persistence_sort(50, 25, 33, 22);
persistence_sort(644, 939, 265, 312, 5);
persistence_sort(81, 71, 61, 51, 41);
persistence_sort(1, 10, 25, 39, 77, 679, 6788, 68889);

sub persistence_sort {
    
    my (@ints, $j, $product, @steps, $num_ints, $todo, $s, @results, $explain);
    
    @ints = @_;
    say qq[\nInput:  (] . join(', ', @ints) . ')';
    
    # sort ints so that end results are sorted within each step count
    @ints = sort {$a <=> $b} @ints;
    $num_ints = @ints - 1;
    $explain = '';
    
    # calculate digit products
    for $j (0 .. $num_ints) {
        $product = $ints[$j];
        $steps[$j] = 0;
        $explain .= qq[   $ints[$j] =>];
        
        # loop while product is not a single digit
        while ($product > 9) {
            $product =~ s|(\d)|\* $1 |g;  # converts 123 to *1*2*3
            $explain .= substr($product, 1, -1) . ' =>';
            $product = eval(qq[1$product]);   # evaluates 1*1*2*3
            $steps[$j] ++;
        }
        $explain .= qq[ $product (steps: $steps[$j])\n];
    }
    
    # loop over number of steps
    $todo = $num_ints + 1;
    STEPS: for $s (0 .. 99) {
        
        # find step counts == $s
        for $j (0 .. $num_ints) {
            if ($steps[$j] == $s) {
                push(@results, $ints[$j]);
                
                # check whether we've got them all
                $todo --;
                last STEPS unless $todo;
            }
        }
    }
    say qq[Output: (]. join(', ', @results) . qq[)\n]  . substr($explain, 0, -1);
}

    

Output



Input:  (15, 99, 1, 34)
Output: (1, 15, 34, 99)
   1 => 1 (steps: 0)
   15 => 1 * 5 => 5 (steps: 1)
   34 => 3 * 4 => 1 * 2 => 2 (steps: 2)
   99 => 9 * 9 => 8 * 1 => 8 (steps: 2)

Input:  (50, 25, 33, 22)
Output: (22, 33, 50, 25)
   22 => 2 * 2 => 4 (steps: 1)
   25 => 2 * 5 => 1 * 0 => 0 (steps: 2)
   33 => 3 * 3 => 9 (steps: 1)
   50 => 5 * 0 => 0 (steps: 1)

Input:  (644, 939, 265, 312, 5)
Output: (5, 312, 265, 939, 644)
   5 => 5 (steps: 0)
   265 => 2 * 6 * 5 => 6 * 0 => 0 (steps: 2)
   312 => 3 * 1 * 2 => 6 (steps: 1)
   644 => 6 * 4 * 4 => 9 * 6 => 5 * 4 => 2 * 0 => 0 (steps: 4)
   939 => 9 * 3 * 9 => 2 * 4 * 3 => 2 * 4 => 8 (steps: 3)

Input:  (81, 71, 61, 51, 41)
Output: (41, 51, 61, 71, 81)
   41 => 4 * 1 => 4 (steps: 1)
   51 => 5 * 1 => 5 (steps: 1)
   61 => 6 * 1 => 6 (steps: 1)
   71 => 7 * 1 => 7 (steps: 1)
   81 => 8 * 1 => 8 (steps: 1)

Input:  (1, 10, 25, 39, 77, 679, 6788, 68889)
Output: (1, 10, 25, 39, 77, 679, 6788, 68889)
   1 => 1 (steps: 0)
   10 => 1 * 0 => 0 (steps: 1)
   25 => 2 * 5 => 1 * 0 => 0 (steps: 2)
   39 => 3 * 9 => 2 * 7 => 1 * 4 => 4 (steps: 3)
   77 => 7 * 7 => 4 * 9 => 3 * 6 => 1 * 8 => 8 (steps: 4)
   679 => 6 * 7 * 9 => 3 * 7 * 8 => 1 * 6 * 8 => 4 * 8 => 3 * 2 => 6 (steps: 5)
   6788 => 6 * 7 * 8 * 8 => 2 * 6 * 8 * 8 => 7 * 6 * 8 => 3 * 3 * 6 => 5 * 4 => 2 * 0 => 0 (steps: 6)
   68889 => 6 * 8 * 8 * 8 * 9 => 2 * 7 * 6 * 4 * 8 => 2 * 6 * 8 * 8 => 7 * 6 * 8 => 3 * 3 * 6 => 5 * 4 => 2 * 0 => 0 (steps: 7)