Multiplicative Persistence #2

Question

We had a challenge on Multiplicative Persistence here.
As a recap, to get a multiplicative persistence of a number, do these steps:

1. Multiply all the digits of a number (in base \10ドル\$)
2. Repeat Step 1 until you have a single digit left.
3. Then count the number of iterations.

More here on Numberphile:

• Numberphile "What's special about 277777788888899?"
• Numberphile "Multiplicative Persistence (extra footage)"

See the previous challenge.

Rules

The last challenge was all about seeing the intermediate results, but here:

• The input should be a positive integer \$n\$.
• The output should be the integer with the greatest multiplicative persistence among numbers from \0ドル\$ to \$n-1\$, choosing the smallest option in case of a tie.
• This is code-golf, so the shortest code wins.

Example

[inp]: 10
[out]: 0
[inp]: 100
[out]: 77
[inp]: 50
[out]: 39
[inp]: 31
[out]: 25

_{Note: Numbers somewhat randomly chosen.}

Good Luck!

• math scat: Sandbox for (about) 80 hours
• Jonah: why isn't the answer for 10 just 9?
• Arnauld: @Jonah The multiplicative persistence is the number of iterations, not the final digit. But this should be made clearer in the challenge.
• math scat: @Arnauld Ok, doing that
• avarice: @Jonah i wish it was like yours comment, then i could just submit n-1 :P

Answer 1

Husk, 10 bytes

►ȯLU¡oΠd↔l·

Try it online!

Explanation

►ȯLU¡oΠd↔l·
 ↔l· reverse the range 0..n-1
►ȯ max-by, returning the last maximal element for the following:
 ¡o create an infinite list using:
 Πd product of digits.
 U longest unique prefix
 L take its length 

• Klik: New to code golf here. Isn't this more than 10 bytes since it uses unicode?
• Jonathan Allan: @Klik it's 10 bytes - the characters are just a representation of the 256 bytes - see the code-page.

Answer 2

Jelly, 10 bytes

ḶDP$ƬL$ÐṀḢ

Try it online!

Jelly, 10 bytes

ḶDP$Ƭ€ẈMḢ’

Try it online!

How they work

ḶDP$ƬL$ÐṀḢ - Main link. Takes n on the left
Ḷ - Unlength; [0, 1, 2, ..., n-1]
 $ÐṀ - Return the maximal elements under the previous 2 links:
 $Ƭ - Iterate the previous 2 links until reaching a fixed point, collecting all steps:
 D - Digits
 P - Product
 L - Length; Number of steps
 Ḣ - Take the lowest maximal element

ḶDP$Ƭ€ẈMḢ’ - Main link. Takes n on the left
Ḷ - Unlength; [0, 1, 2, ..., n-1]
 € - Over each integer, 0 ≤ i < n:
 $Ƭ - Iterate the previous 2 links until reaching a fixed point, collecting all steps:
 D - Digits
 P - Product
 Ẉ - Lengths of each
 M - 1-indices of maximal elements
 Ḣ - Take the first (lowest) one
 ’ - Decrement to 0-index

• kops: I don't really know Jelly, but it looks like the Ḷ is only necessary to go from [0,n-1] and if you remove it you implicitly iterate over [1,n] instead, which almost gets to where you need except that we're off by 1 (so the first program can erroneously return n, and the second program both does that and the index is also off by 1). Could this possibly lead to a 1 byte save by sneaking the -1 or equivalent operation in somewhere else?

Answer 3

Python 2, 70 bytes

lambda n:max(range(n),key=g)
g=lambda x:x<10or-~g(eval('*'.join(`x`)))

Try it online!

The helper function g recursively computes multiplicative persistence, and the main function in the top line finds value that maximizes g among the half-open range from 0 to n. It works out that max chooses the earlier element in case of a tie for greatest.

Answer 4

R, (削除) 94 (削除ここまで) (削除) 91 (削除ここまで) 87 bytes

Edit: thanks to Kirill L. for spotting 2 (!) bugs, and also saving 3 bytes, and -4 more bytes thanks to Robin Ryder

which.max(Map(f<-function(x)`if`(x>9,1+f(prod(utf8ToInt(c(x,""))-48)),0),1:scan()-1))-1

Try it online!

Started as a rather unimaginative construction based around Giuseppe's 'Multiplicative persistence' answer, which deserves most of the credit.

Now adjusted (in response to bug-spotting by Kirill L.) into a recursive version that saved all the bytes needed for the bug-fix (I hope)...

• Dominic van Essen: @KirillL. - Thanks for the bug-spotting! I hope it's fixed now (I managed to re-work it to avoid costing extra bytes, so I've probably introduced more problems now...)
• Dominic van Essen: @KirillL. - and special thanks for the brilliant Map golf! I'd never realised that Map would work with only one vector argument, and so can (presumably?) always substitute sapply... now I'm going to have to go back to ALL my previous answers and change them...
• Kirill L.: Well, it won't help in all cases - Map doesn't simplify the result to vector, so it won't work with functions that don't like lists.
• Robin Ryder: 87 bytes (with possibly room for improvement if you can find a shorter way of converting to character). I posted the same golf on Giuseppe's answer. :-)

Answer 5

Julia 0.7, (削除) 58 (削除ここまで) (削除) 54 (削除ここまで) 49 bytes

n->argmax(.!(0:n-1))-1
!n=n>9&&!prod(digits(n))+1

Try it online!

Thanks to MarcMush for -5 bytes.

• MarcMush: 49 bytes (and also works with Julia 1.x)

Answer 6

JavaScript (ES6), 77 bytes

f=(n,m)=>n--?f(n,m>(g=n=>v=n>9&&-~g(eval([...n+''].join`*`)))(n)?m:(x=n,v)):x

Try it online!

Answer 7

05AB1E, 12 bytes

L<ε.ΓSP}g]Zk

Try it online!

Commented:

L< # push [1 .. input] - 1
 ε } # map over each integer:
 .Γ } # cumulative fixed-point:
 # run until the result doesn't change and collect results
 SP # take the product (P) of the digits (S)
 g # get the length of the resulting list
 Zk # find the index (k) of the minimum length (Z)

Alternative 12 byters: FN.ΓSP])€gZk and <1ŸΣ.ΓSP}g}θ

• math scat: really? so fast? Nice answer

Answer 8

Charcoal, 18 bytes

FN⊞υ∧›ι9⊕§υΠιI⌕υ⌈υ

Try it online! Link is to verbose version of code. Explanation:

FN

Loop over the range 0..n-1.

⊞υ

Push to the predefined list...

∧›ι9

... zero if the current index is less than 10, otherwise...

⊕§υΠι

... increment the previously calculated persistence of the digital product of the current index.

I⌕υ⌈υ

Print the first entry with maximal persistence.

Answer 9

JavaScript (Node.js), 68 bytes

g=n=>n>9&&-~g(eval([...n+''].join`*`));f=n=>n--?g(h=f(n))<g(n)?n:h:0

Try it online!

Answer 10

Scratch, 454 bytes

Try it online!

This one was fun to make! It takes 13 seconds to process the first 100,000 numbers. Alternatively, 48 blocks.

when gf clicked
set[H v]to(
set[M v]to(
set[N v]to(-1
ask()and wait
repeat(answer
change(N)by(1
set[C v]to(
delete all of[B v
repeat(length of(N
change[C v]by(1
add(letter(C)of(N))to[B v
end
set[P v]to(
repeat until<(length of[B v])=(1
set[R v]to(1
repeat(length of[B v
set[R v]to((R)*(item(1)of[B v
delete(1)of[B v
end
set[C v]to(
repeat(length of(R
change[C v]by(1
add(letter(C)of(R))to[B v
end
change[P v]by(1
if<(P)>(H)>then
set[H v]to(P
set[M v]to(N

Answer 11

PowerShell, 110 bytes

param($n)filter f{$_
if($_-gt9){("$_"|% t*y)-join'*'|iex|f}}
($k=0..$n|%{($_|f).count}).indexof(($k|sort)[-1])

Try it online!

Thanks to @mazzy for the function and -24 bytes

• mazzy: ? Try it online!

Answer 12

Befunge-98 (FBBI), ^{(削除) 107 (削除ここまで) (削除) 105 (削除ここまで)} 108 bytes

+3 for a bugfix with the tiebreaks.

Definitely some golfing left to do...

< v:-1_;# $ <;v#:&
e:p1 9;j`N' <^;#1p4
;0円:<v; +1:$<^
+1円\v>:9`! #^_1円
>$$ ^ @.N'<
^#::<X'*%ap55/a_

Try it online! The code contains two null bytes, indicated by N above

How?

^{slightly outdated}

Product of the digits:
product of the digits of 123 Accessing more than the top two values on the stack is quite hard in Befunge, which is why we save the remaining digits in the cell where the X is initially in.
1\ inserts a 1 (initial product) below the input value, then the product is calculated by repeatedly multiplying with last digit of the remaining input.

Computing the multiplicative persistence:
multiplicative resistance of 25
0\ inserts the initial value of 0 below the input integer. :9`! #^_ continues east to increment the persistence and calculate the next product of digits as long as the top of the stack is larger than 9, and exits to the top at ^ once a value less or equal to 9 is reached.
For a more compact version of this which prints the intermediate results, see my answer to the other challenge.

Storing intermediate results:
The highest persistence gets stored at the N at index 1, 9, and this is directly used to be compared with new results. If the new results is not larger than the current record ; skips the update code 91p:d4p, which updates the record and stores the record index at 4, 13.

The main loop:
enter image description here
The loop counts down to 0 and sends the IP off to the other code in between. Once 0 has gone around the loop, the value stored at 4, 13 is printed and the program exits.

Answer 13

Vyxal Ṁ, 9 bytes

ƛ(Π↔L;:Gḟ

Try it Online!

Never have I had to use both m and M flags in the same challenge.

Explained

ƛ(Π↔L;:Gḟ
ƛ # over the range [0, input) - managed by the m and M flags
 (Π↔ # get the iterations of the multiplicative persistance - repeatedly take the product of the digits of each number in the range, collecting results until it doesn't change
 L; # and take the length
 :G # push the maximum element and
 ḟ # get the first index where it occurs

• rak1507: the m stands for metagolfscript

Answer 14

Python 2, 85 bytes

d=[]
for x in range(input()):d+=x<10or-~d[eval('*'.join(`x`))],
print d.index(max(d))

Try it online!

Using a function to calculate the persistence came in at 87 bytes, but there might be way to do everything in a single function.

Answer 15

Haskell, 82 bytes

f n=snd$minimum$((,)=<<p)<$>[0..n-1]
p n|n>9=p(product$read.pure<$>show n)-1
p n=0

Try it online!

Golfing Delfad0r's solution by using the decorate-sort-undecorate idiom to find the maximizing value.

It's easier to see how it works in this slightly longer version.

83 bytes

f n=snd$minimum[(-p i,i)|i<-[0..n-1]]
p n|n>9=1+p(product$read.pure<$>show n)
p n=1

Try it online!

For each candidate value i, we create the pair (-p i,i), take the minimum of all of them which compares first by -p i, the call snd to get just the value i. My first draft did maximum[(p i,i)|i<-[0..n-1]], but this tiebreaks equal p i's to higher i's whereas we want lower. Negating p i and finding the minimum fixes this.

We can negate p i directly in its definition without costing any bytes by subtracting 1 each step rather than adding 1. It doesn't hurt to start from 0 rather than -1 for the base case, since shifting p by a constant doesn't affect comparisons.

82 bytes

f n=snd$minimum[(p i,i)|i<-[0..n-1]]
p n|n>9=p(product$read.pure<$>show n)-1
p n=0

Try it online!

The code at the top implements \i->(p i,i) as (,)=<<p and maps it over the range, but unfortunately doesn't save any bytes with the parens it needs.

Answer 16

Haskell, ^{(削除) 86 (削除ここまで) (削除) 85 (削除ここまで)} 84 bytes

• -1 byte thanks to xnor for removing the f 1=0 case.

f n|n>1,x<-f$n-1,p x>=p(n-1)=x
f n=n-1
p n|n>9=1+p(product$read.pure<$>show n)
p n=1

Try it online!

• xnor: It looks like you can have the f 1=0 be handled by f n=f$n-1 by adding an n>1, condition to the second case.
• Delfad0r: @xnor Is this what you meant? Thanks, by the way :)

Answer 17

Retina, 60 bytes

.+
*
L$`.
$.`
+/\d.+/_~(`.
$&$*
)`^
.+¶#$$.(
.
#
D`#+
¶*$
¶

Try it online! Link includes test cases. Explanation:

.+
*
L$`.
$.`

List the numbers up to n.

+/\d.+/_

Repeat while there are numbers of at least two digits...

~(`.
$&$*
)`^
.+¶#$$.(

... convert the numbers into Retina expressions that calculate their digital product and evaluate them. (As in my Retina answer to the previous challenge, an ungrouped version is actually a byte longer.)

.
#
D`#+

Keep only the the new record multiplicative persistences.

¶*$
¶

Retrieve the value with the highest new record persistence.

Answer 18

Wolfram Language (Mathematica), (削除) 57 (削除ここまで) 56 bytes

MaximalBy[Range@#-1,#>9&&1+#0@@Times@@@RealDigits@#&,1]&

Try it online!

Returns the value wrapped in a list.

Since MaximalBy chooses the maximum based on Mathematica's internal ordering, choosing a value for the base case (when n≤9) isn't necessary.

Answer 19

C (gcc), (削除) 95 (削除ここまで) 94 bytes

Saved a byte thanks to ceilingcat!!!

a;b;c;d;r;f(n){for(b=0;n--;r=c>=b?b=c,n:r)for(c=0,d=n;a=d,d=d>9;++c)for(;a;a/=10)d*=a%10;d=r;}

Try it online!