Re: Multiplication digit persistence

I don't have the math skills to know whether there is some formula to find the "steps" so a brute force approach was my only option. Initially I used glob with multiples of the {1,2,3,4,5,6,7,8,9} pattern to generate an array of n-digit numbers to test but that was wasteful. All that is needed are numbers where digits are equal or greater than the preceding digit. I used Math::BigInt to cope with large values and initially used ->bmul() to find the product of all the digits. However, changing

    my $prod = Math::BigInt->new( 1 );
    $prod->bmul( $_ ) for split m{}, $nVal->bstr();
[download]

    my $prod = Math::BigInt->new( 1 );
    my %digits;
    $digits{ $_ } ++ for split m{}, $nVal->bstr();
    $prod->bmul( $_ ) for
       map {
          $digits{ $_ } > 1
          ? Math::BigInt->new( $_ )->bpow( $digits{ $_ } )
          : $_
          } keys %digits;
[download]

produced gains in performance as the length of the numbers increased. I tried to make further gains by employing threads but the results were woeful; I am obviously not understanding something about them and where they can usefully be employed and may well raise a SoPW to seek enlightenment. The code:-

use 5.018;
use warnings;

use Math::BigInt;
use Time::HiRes qw{ gettimeofday tv_interval };

use Fcntl;
STDOUT->autoflush( 1 );
STDERR->autoflush( 1 );

my $startDigits;
my $stopDigits;

if ( scalar @ARGV == 2 )
{
    ( $startDigits, $stopDigits ) = @ARGV;
}
elsif ( scalar @ARGV == 1 )
{
    $startDigits = 2;
    $stopDigits = shift;
}
else
{
    $startDigits = 2;
    $stopDigits = 8;
}

my $maxSteps  = 0;
my $nTried    = 0;

my $rcGenDigits;
$rcGenDigits = sub
{
    my( $depth, $start ) = @_;
    return [] unless $depth;
    my $raValues;
    foreach my $digit ( $start .. 9 )
    {
        my $raInner = $rcGenDigits->( $depth - 1, $digit );
        push @{ $raValues },
           scalar @{ $raInner }
           ? map { $digit . $_ } @{ $raInner }
           : $digit;
    }
    return $raValues;
};

my $steps;
my $raRecord;

my $startTV = my $lastTV = [ gettimeofday() ];
my $nowTV;
my $elapsed;
my $delta;

foreach my $nDigits ( $startDigits .. $stopDigits )
{
    print
       q{ } x $stopDigits,
       qq{\rGenerating ${nDigits}-digit values ... };
    my $raValues = $rcGenDigits->( $nDigits, 1 );
    $nowTV       = [ gettimeofday() ];
    $delta       = tv_interval( $lastTV, $nowTV );
    $elapsed     = tv_interval( $startTV, $nowTV );
    $lastTV      = $nowTV;
    say
       qq{found @{ [ scalar @{ $raValues } ] }, },
       qq{took @{ [ scaleSecs( $delta ) ] }\n},
       qq{Trying ${nDigits}-digit values, },
       qq{at elapsed time @{ [ scaleSecs( $elapsed ) ] }\n};

    foreach my $value ( @{ $raValues } )
    {
        $nTried ++;
        print STDERR qq{$value\r} unless $nTried %1000;
        $raRecord = [];
        try( $value );
    }

    $nowTV       = [ gettimeofday() ];
    $delta       = tv_interval( $lastTV, $nowTV );
    $lastTV      = $nowTV;
    say
       q{ } x $stopDigits,
       qq{\nTrying ${nDigits}-digit values },
       qq{took @{ [ scaleSecs( $delta ) ] }\n};    
}

say q{ } x $stopDigits, q{};
$nowTV   = [ gettimeofday() ];
$elapsed = tv_interval( $startTV, $nowTV );
say qq{Total elapsed time @{ [ scaleSecs( $elapsed ) ] }\n};

sub per
{
    my $nStr = shift;
    my $nVal = Math::BigInt->new( $nStr );
    push @{ $raRecord }, [ $steps ++, $nVal->bstr() ];
    return if $nVal->bcmp( 10 ) == -1;

    my $prod = Math::BigInt->new( 1 );
    my %digits;
    $digits{ $_ } ++ for split m{}, $nVal->bstr();
    $prod->bmul( $_ ) for
       map {
          $digits{ $_ } > 1
          ? Math::BigInt->new( $_ )->bpow( $digits{ $_ } )
          : $_
          } keys %digits;
    return per( $prod->bstr() );
}

sub scaleSecs
{
    my $tv          = shift;
    my $secs        = int $tv;
    my( $fracPart ) = $tv =~ m{(?<=\.)(\d+)};

    my $wks  = 0;
    my $days = 0;
    my $hrs  = 0;
    my $mins = 0;

    while($secs >= 604800)
    {
        $wks ++;
        $secs -= 604800;
    }
    while($secs >= 86400)
    {
        $days ++;
        $secs -= 86400;
    }
    while($secs >= 3600)
    {
        $hrs ++;
        $secs -= 3600;
    }
    while($secs >= 60)
    {
        $mins ++;
        $secs -= 60;
    }

    my $retStr
       = ( $wks ? qq{${wks}w } : q{} )
       . ( $days ? qq{${days}d } : q{} )
       . ( $hrs ? qq{${hrs}h } : q{} )
       . ( $mins ? qq{${mins}m } : q{} )
       . qq{$secs.${fracPart}s};    
}

sub try
{
    my $nStr = shift;
    $steps   = 0;
    per( $nStr );

    my $actualSteps = $steps - 1;
    if ( $actualSteps > $maxSteps )
    {
        $nowTV    = [ gettimeofday() ];
        $elapsed  = tv_interval( $startTV, $nowTV );
        say
           q{ } x $stopDigits,
           qq{\rFound steps: $actualSteps -- },
           qq{at elapsed time @{ [ scaleSecs( $elapsed ) ] }};
        printf qq{%7d %s\n}, @{ $_ } for @{ $raRecord };
        $maxSteps = $actualSteps;
    }
}
[download]

Running the script with no arguments tests numbers of length 2 through 8 digits.

Generating 2-digit values ... found 45, took 0.000142s
Trying 2-digit values, at elapsed time 0.000142s

Found steps: 1 -- at elapsed time 0.000444s
      0 11
      1 1
Found steps: 2 -- at elapsed time 0.002256s
      0 25
      1 10
      2 0
Found steps: 3 -- at elapsed time 0.00473s
      0 39
      1 27
      2 14
      3 4
Found steps: 4 -- at elapsed time 0.009294s
      0 77
      1 49
      2 36
      3 18
      4 8
        
Trying 2-digit values took 0.010699s

Generating 3-digit values ... found 165, took 0.000462s
Trying 3-digit values, at elapsed time 0.011303s

Found steps: 5 -- at elapsed time 0.06251s
      0 679
      1 378
      2 168
      3 48
      4 32
      5 6
        
Trying 3-digit values took 0.057506s

Generating 4-digit values ... found 495, took 0.001567s
Trying 4-digit values, at elapsed time 0.070376s

Found steps: 6 -- at elapsed time 0.249183s
      0 6788
      1 2688
      2 768
      3 336
      4 54
      5 20
      6 0
        
Trying 4-digit values took 0.187418s

Generating 5-digit values ... found 1287, took 0.00469s
Trying 5-digit values, at elapsed time 0.262484s

Found steps: 7 -- at elapsed time 0.773186s
      0 68889
      1 27648
      2 2688
      3 768
      4 336
      5 54
      6 20
      7 0
        
Trying 5-digit values took 0.522252s

Generating 6-digit values ... found 3003, took 0.016299s
Trying 6-digit values, at elapsed time 0.801035s

        
Trying 6-digit values took 1.34961s

Generating 7-digit values ... found 6435, took 0.029679s
Trying 7-digit values, at elapsed time 2.180324s

Found steps: 8 -- at elapsed time 4.382705s
      0 2677889
      1 338688
      2 27648
      3 2688
      4 768
      5 336
      6 54
      7 20
      8 0
        
Trying 7-digit values took 3.047357s

Generating 8-digit values ... found 12870, took 0.069061s
Trying 8-digit values, at elapsed time 5.296742s

Found steps: 9 -- at elapsed time 10.071529s
      0 26888999
      1 4478976
      2 338688
      3 27648
      4 2688
      5 768
      6 336
      7 54
      8 20
      9 0
        
Trying 8-digit values took 6.295458s

        
Total elapsed time 11.593337s
[download]

The script successfully finds the 15-digit value with 11 steps but I have yet to find a 12 stepper, having run with up to 27-digit values. Output from a 26- and 27-digit run below:-

Generating 26-digit values ... found 18156204, took 4m 56.352544s
Trying 26-digit values, at elapsed time 4m 56.352544s

Found steps: 1 -- at elapsed time 4m 56.352979s
      0 11111111111111111111111111
      1 1
Found steps: 2 -- at elapsed time 4m 56.35532s
      0 11111111111111111111111125
      1 10
      2 0
Found steps: 3 -- at elapsed time 4m 56.35849s
      0 11111111111111111111111139
      1 27
      2 14
      3 4
Found steps: 4 -- at elapsed time 4m 56.364262s
      0 11111111111111111111111177
      1 49
      2 36
      3 18
      4 8
Found steps: 5 -- at elapsed time 4m 56.408053s
      0 11111111111111111111111679
      1 378
      2 168
      3 48
      4 32
      5 6
Found steps: 6 -- at elapsed time 4m 56.552653s
      0 11111111111111111111116788
      1 2688
      2 768
      3 336
      4 54
      5 20
      6 0
Found steps: 7 -- at elapsed time 4m 56.92614s
      0 11111111111111111111168889
      1 27648
      2 2688
      3 768
      4 336
      5 54
      6 20
      7 0
Found steps: 8 -- at elapsed time 4m 58.708825s
      0 11111111111111111112677889
      1 338688
      2 27648
      3 2688
      4 768
      5 336
      6 54
      7 20
      8 0
Found steps: 9 -- at elapsed time 5m 1.542849s
      0 11111111111111111126888999
      1 4478976
      2 338688
      3 27648
      4 2688
      5 768
      6 336
      7 54
      8 20
      9 0
Found steps: 10 -- at elapsed time 5m 19.523648s
      0 11111111111111113778888999
      1 438939648
      2 4478976
      3 338688
      4 27648
      5 2688
      6 768
      7 336
      8 54
      9 20
     10 0
Found steps: 11 -- at elapsed time 9m 34.047507s
      0 11111111111277777788888899
      1 4996238671872
      2 438939648
      3 4478976
      4 338688
      5 27648
      6 2688
      7 768
      8 336
      9 54
     10 20
     11 0
                           
Trying 26-digit values took 3h 46m 34.174622s

Generating 27-digit values ... found 23535820, took 6m 47.473396s
Trying 27-digit values, at elapsed time 3h 58m 18.000562s

                           
Trying 27-digit values took 4h 57m 27.198992s

                           
Total elapsed time 8h 55m 47.367434s
[download]

As you can see, the above run finds all the steps up to 11, just with a series of 1s prepended and the whole run took almost 9 hours on a 2012 MacBook Pro 2.3GHz quad core i7. It may be that there are no 12-steppers at all, I don't have the maths to tell, but I think any further tests will have to be using a faster language. Perhaps this will be a good project to translate to Go, as I try to learn more.

Update: Corrected typo, s/MacBoon/MacBook/

Cheers,

JohnGG

Comment on Re: Multiplication digit persistence Select or Download Code

Replies are listed 'Best First'.
Re^2: Multiplication digit persistence by pryrt (Abbot) on Mar 28, 2019 at 13:34 UTC
The script successfully finds the 15-digit value with 11 steps but I have yet to find a 12 stepper, having run with up to 27-digit values. Output from a 26- and 27-digit run below:- ... As you can see, the above run finds all the steps up to 11, just with a series of 1s prepended and the whole run took almost 9 hours on a 2012 MacBook Pro 2.3GHz quad core i7. It may be that there are no 12-steppers at all, I don't have the maths to tell,... It was mentioned in the video, and I am quoting the similar idea from the Wolfram MathWorld Multiplicative Persistence article: "There is no number <10^(233) with multiplicative persistence >11". You're going to have to go a lot higher than 27 digits if you want to find the elusive 12-stepper. I tried talking the lowest 11-stepper (277777788888899), then permuting its digits, and listing the factors of each of those permutations (keeping the single-digit factors separate, then lumping what's left if it's not), trying to find one or more permutations that is soley made up of single-digit factors -- because if there's a group of only-single-digit factors that make up a 11-stepper, then making a 12-stepper is as simple as concatenating those digits. -- Actually, I remembered that I started with a 10-stepper, because I wanted to see if I could proof-of-concept it to go from the 10-stepper to a known 11-stepper. I only made it about a million permutations through. If I had started with the 11-stepper, that would have been almost enough, because there are only 15! / 6! / 6! / 2! permutations of 277777788888899, which is 1.3million permutations. But since I was using the 10-stepper 4996238671872 => 1223466778899, which has fewer repeating digits, so is 13!/2!/2!/2!/2!/2! = 195million permutations. Looks like I'll have to find some spare CPU cycles to try the 11-stepper, too. #!/usr/bin/env perl use 5.010; use warnings; use strict; use bigint; use Math::Combinatorics; $\|++; sub mult_root { my $prod = 1; $prod = $_ for split //, shift; return $prod; } sub sum_root { my $sum = 0; $sum += $_ for split //, shift; return $sum; } sub persistance_count { my $arg = shift; my $count = shift // 0; my $debug = shift // 0; return $count unless 1 < length($arg); ++$count; my $r = mult_root($arg); print "::$count: $arg => $r\n" if $debug; persistance_count($r, $count, $debug); } my @min_persistance = (0, 10, 25, 39, 77, 679, 6788, 68889, 2677889, 2 +6888999, 3778888999, 277777788888899); printf "persistance_count(%s) = %s\n", $_, persistance_count($_) for @ +min_persistance; printf "\ndebug(%s)\n", $min_persistance[-1]; persistance_count($min_p +ersistance[-1], 0, 1); sub digital_factor { # factors a number into powers of single digits, plus a leftover #(that may be prime, or just coprime with all single digits) my $arg = $_[0]; unless($arg) { print "digital_factor(0) = 0\n"; return (toobig => 0); } my %factor; foreach my $k (reverse 2..9) { next unless $k eq 0+$k; while(0 == $arg % $k) { $factor{$k}++; $arg /= $k; } } $factor{toobig} = $arg unless 1 == $arg; return %factor; } sub print_factor { my($v, %f) = @_; printf "digital_factor(%s) = ", $v; foreach my $k ( 2..9 ) { printf "%s%s ", $k, $f{$k} if exists $f{$k}; } printf "%s\n", (exists($f{toobig}) ? $f{toobig} : 1); } print "\n"; for(@min_persistance, 4996238671872) { my %f = digital_factor($_); print_factor($_, %f); } print "\n"; foreach my $base ( 4996238671872 ) { my $i = 0; my @symbols = split //, $base; my %done; printf "loop(%s): mult_root=%s sum_root=%s\n", $base, mult_root($b +ase), sum_root($base); my $iter = Math::Combinatorics->new(count => scalar @symbols, data + => \@symbols); while(my @perm = $iter->next_permutation) { my $v = 0 + join '', @perm; next if $done{$v}; $done{$v}++; my %f = digital_factor($v); print_factor($v, %f); #last unless ++$i < 100; } print "\n"; } [download]	[reply] [d/l]
Re^3: Multiplication digit persistence by LanX (Saint) on Mar 28, 2019 at 14:16 UTC
> Looks like I'll have to find some spare CPU cycles to try the 11-stepper, too. But you know that'll fail? The smallest useful digit is 2 2**50 has already more than 15 digits. Any of your permutations will have 15 only. It was said that there's no solution under 200+ digits update Probably I didn't think it thru, the product of more than 50 digits could contain many 1s acting as fillers in between your targeted 15 digits... in other words 1277777788888899 is am eleven stepper too, just not the smallest. BTW: For the same reason is 1223466778899 not the smallest 10 stepper. Cheers Rolf _{(addicted to the Perl Programming Language :) Wikisyntax for the Monastery FootballPerl is like chess, only without the dice}	[reply]
Re^4: Multiplication digit persistence by pryrt (Abbot) on Mar 28, 2019 at 15:45 UTC
But you know that'll fail? Yes. I believed I was eventually going to have to inject additional 1s into the 11-stepper to generate enough single-digit factors to get at least 233 digits in the 12-stepper. And I knew the chances were that the first 11-stepper, even with 1s, might not ever be able to generate a 12-stepper. Since the conjecture is that there are no 12-steppers -- though there isn't a solid mathematical reason, other than "233 digits wasn't enough for 12-step, when 15 digits was sufficient for 11-step, so it's not likely to have any 12-steppers" -- the chances are small than any amateur (like us me) will find a 12-stepper. (Though mathematics does have some strange outliers, like the Monster Group being so far out there, or the sixth platonic-solid-analog in 4d, when all other dimensions have fewer.) update: I am an amateur at mathematics. I should not have spoken for anyone else. Sorry, LanX.	[reply]
Re^5: Multiplication digit persistence by LanX (Saint) on Mar 28, 2019 at 16:52 UTC
Re^6: Multiplication digit persistence by pryrt (Abbot) on Mar 28, 2019 at 20:24 UTC
Some notes below your chosen depth have not been shown here

update