Try to find a number that takes more than eleven steps.
use v5.10;
use strict;
use warnings;
use List::Util qw(product);
sub per {
my ($n) = @_;
return if $n < 10;
my $p = product split //, $n;
return $p, per($p);
}
my @steps = per 277777788888899;
my $steps = @steps;
say "$steps steps";
say for @steps;
Re: Multiplication digit persistence
by haukex (Chancellor) on Mar 21, 2019 at 13:26 UTC

Try to find a number that takes more than eleven steps.
Heh, I guess you just watched the Numberphile video that was just released? ;)
 [reply] [d/l] 

 [reply] 
Re: Multiplication digit persistence
by choroba (Bishop) on Mar 21, 2019 at 17:41 UTC

When searching for the 12 stepper, you probably need to modify the script in the following way:
 my $p = product split //, $n;
+ my $p = 'Math::BigInt'>new(product split //, $n);
Also, put use Math::BigInt;
somewhere to the top, and enclose the tobewinner in quotes.
map{substr$_>[0],$_>[1]0,1}[\*{},3],[[]],[ref qr1,,1],[{}],[sub{}^*ARGV,3]
 [reply] [d/l] [select] 

 [reply] [d/l] 
Re: Multiplication digit persistence
by golux (Chaplain) on Mar 21, 2019 at 15:03 UTC

I also watched the video this morning, not realizing it came up because it was new.
When I saw that Matt was using Python to code it, of course I wanted to try it in Perl instead!
This was what I came up with:
#!/usr/bin/perl
use strict;
use warnings;
use feature qw( say );
use Function::Parameters;
$ = 1;
# Try the recordholder
try_num(277777788888899, 1);
# Search for record holders at each # iterations
my $num = my $max = my $maxn = my $print = 0;
while (1) {
++$num;
my ($per, $new) = (persist($num), 0);
(0 == $num % 100_000) and $print = 1;
($per > $max) and ($maxn, $max, $print, $new) = ($num, $per, 1, 1)
+;
$print and print " CURR=$num, MAX=$max, MAXP=$maxn\e[K\r";
$new and say "";
$print = $new;
}
fun try_num($num, $dbg = 0) {
my $per = persist($num, $dbg);
printf "\e[102m Count[$num] = %s\e[m\n\n", persist($num, $dbg);
}
fun muldigs($num, $dbg = 0, $res = 1) {
$dbg and say " Num: $num";
my @dbg = ( );
map { push @dbg, ($res *= $_) } split(//, $num);
$dbg and say " > " . join(",", @dbg);
return $res;
}
fun persist($num, $dbg = 0) {
my ($mul, $iter) = ($num, 0);
while (1) {
(length($mul) > 1) or return $iter;
($iter, $mul) = ($iter+1, muldigs($mul, $dbg));
$dbg and say "Iter: $iter [$mul]\n";
}
}
say
substr+lc crypt(qw $i3 SI$),4,5
 [reply] [d/l] 

printf "\e[102m Count[%s] = %s\e[m\n\n", $num, persist($num, $dbg)
+;
The first argument is a FORMAT string and using variable interpolation could introduce an invalid '%' character.
my @dbg = ( );
map { push @dbg, ($res *= $_) } split(//, $num);
You are not using map correctly:
my @dbg = map { $res *= $_ } split(//, $num);
 [reply] [d/l] [select] 

 [reply] [d/l] 
Re: Multiplication digit persistence
by johngg (Canon) on Mar 28, 2019 at 11:47 UTC

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 ndigit 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();
to
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;
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;
}
}
Running the script with no arguments tests numbers of length 2 through 8 digits.
The script successfully finds the 15digit value with 11 steps but I have yet to find a 12 stepper, having run with up to 27digit values. Output from a 26 and 27digit 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 12steppers 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/
 [reply] [d/l] [select] 

The script successfully finds the 15digit value with 11 steps but I have yet to find a 12 stepper, having run with up to 27digit values. Output from a 26 and 27digit 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 12steppers 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 12stepper.
I tried talking the lowest 11stepper (277777788888899), then permuting its digits, and listing the factors of each of those permutations (keeping the singledigit factors separate, then lumping what's left if it's not), trying to find one or more permutations that is soley made up of singledigit factors  because if there's a group of onlysingledigit factors that make up a 11stepper, then making a 12stepper is as simple as concatenating those digits.  Actually, I remembered that I started with a 10stepper, because I wanted to see if I could proofofconcept it to go from the 10stepper to a known 11stepper. I only made it about a million permutations through. If I had started with the 11stepper, 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 10stepper 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 11stepper, too.
 [reply] [d/l] 

> Looks like I'll have to find some spare CPU cycles to try the 11stepper, 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] 




