The largest prime factor of 19! is 19.
In[]:=
19!
Out[]=
121645100408832000
Let’s factor it:
In[]:=
FactorInteger[19!]
Out[]=
{{2,16},{3,8},{5,3},{7,2},{11,1},{13,1},{17,1},{19,1}}
Welcome to the concept of smooth numbers. For 19!, the smoothness is 19 because all the prime factors are 19 or less. As numbers get larger, they tend to become less smooth, especially when next to each other. Thus, these two neighboring 13-smooth numbers are a rarity.
In[]:=
FactorInteger/@{123200,123201}
Out[]=
{{{2,6},{5,2},{7,1},{11,1}},{{3,6},{13,2}}}
How can we make that look better? Perhaps a WFR.
In[]:=
ResourceFunction["FormatFactorization"][#]&/@{123200,123201}
Out[]=
{
6
2
2
5
7×11,
6
3
2
13
}
Let’s try for something more compact:
In[]:=
ShortFactor[num_]:=If[PrimeQ[num],Style[num,Blue],Row[Riffle[If[Last[#]==1,ToString[#[[1]]],ToString[#[[1]]]^ToString[#[[2]]]]&/@FactorInteger[num],Graphics[{Gray,AbsolutePointSize[.01],Point[{0,0}],White,Point[{0,-2}]},ImageSize->{3,10}]]]];
In[]:=
ShortFactor/@{123200,123201}
Out[]=
{
6
2
2
5
7
11,
6
3
2
13
}
Yes, I think that looks fairly good. We can make a factor table:
In[]:=
Grid[Partition[ShortFactor/@Range[144],12],Frame->All]
Out[]=
1
2
3
2
2
5
2
3
7
3
2
2
3
2
5
11
2
2
3
13
2
7
3
5
4
2
17
2
2
3
19
2
2
5
3
7
2
11
23
3
2
3
2
5
2
13
3
3
2
2
7
29
2
3
5
31
5
2
3
11
2
17
5
7
2
2
2
3
37
2
19
3
13
3
2
5
41
2
3
7
43
2
2
11
2
3
5
2
23
47
4
2
3
2
7
2
2
5
3
17
2
2
13
53
2
3
3
5
11
3
2
7
3
19
2
29
59
2
2
3
5
61
2
31
2
3
7
6
2
5
13
2
3
11
67
2
2
17
3
23
2
5
7
71
3
2
2
3
73
2
37
3
2
5
2
2
19
7
11
2
3
13
79
4
2
5
4
3
2
41
83
2
2
3
7
5
17
2
43
3
29
3
2
11
89
2
2
3
5
7
13
2
2
23
3
31
2
47
5
19
5
2
3
97
2
2
7
2
3
11
2
2
2
5
101
2
3
17
103
3
2
13
3
5
7
2
53
107
2
2
3
3
109
2
5
11
3
37
4
2
7
113
2
3
19
5
23
2
2
29
2
3
13
2
59
7
17
3
2
3
5
2
11
2
61
3
41
2
2
31
3
5
2
2
3
7
127
7
2
3
43
2
5
13
131
2
2
3
11
7
19
2
67
3
3
5
3
2
17
137
2
3
23
139
2
2
5
7
3
47
2
71
11
13
4
2
2
3
I ran into smooth numbers unexpectedly when
4
9.1
caused an error. The continued fraction was weird.
In[]:=
ContinuedFraction[N[(91/10)^(1/4),100]]
Out[]=
{1,1,2,1,4,75656,1,1,1,2,1,2,1,2,1,1,1,136181,1,2,4,1,64,1,1,3602,4,1,12,7,8,1,2,4267,2,9,1,22,1,1,1,1,1,1,1,4841,35,1,5,5,1,262344,1,2,3,1,3,1,15,3,1}
Usually, large terms in a continued fraction means something weird is happening. But how could something as basic as 9.1 do anything weird? Looking at the fraction it generates a reverse effect:
In[]:=
N[(33/19)^4]
Out[]=
9.1
The fraction is very close to 9.1
In[]:=
N[(33/19)^4,10]
Out[]=
9.099999233
So it seems
91
10
≃
4
33
4
19
. Or 91
4
19
≃ 10
4
33
. Multiplying those out, we get two numbers differing by one:
In[]:=
ShortFactor/@{11859210,11859211}
Out[]=
{2
4
3
5
4
11
,7
13
4
19
}
Playing around with 9.1, we get two consecutive 19-smooth numbers. But it turns out these are the largest consecutive 19-smooth numbers (A002072).
So I started watching for unexpected smooth numbers. Back in 2020 I came across this number.
In[]:=
ShortFactor[799779977]
Out[]=
17
6
19
Just two distinct digits and 19-smooth. More recently, for an overnight run, I tasked Mathematica with finding the smoothest numbers comprised of two distinct digits. I forbid multiples of 10, because those would have been too predictable. Here’s the sequence so far.
In[]:=
list={16,144,3888,55566,255552,1111222,76776777,799779977,4334433444,61161166611,292229292292,1122121111111,55115551555155,799777779779979,1161111111166611,11112112121222112,111111222221111112,3334334333334333333,55333333335335355355,101010110010001010011,3383383883833883388888,11112221111212222222221,112122222222122122122112,2777227772777277722272272,61666616611611166166161116,858885585585555585558558858,3331333133331111313111133133,98888999899889989898999889999,111661111111666616661166166616};​​Grid[{#,Length[IntegerDigits[#]],First[Last[FactorInteger[#]]],ShortFactor[#]}&/@list,Frame->All]
Out[]=
16
2
2
4
2
144
3
3
4
2
2
3
3888
4
3
4
2
5
3
55566
5
7
2
4
3
3
7
255552
6
11
6
2
3
3
11
1111222
7
29
2
2
7
17
23
29
76776777
8
19
2
3
4
7
11
17
19
799779977
9
19
17
6
19
4334433444
10
23
2
2
4
3
3
11
19
2
23
61161166611
11
67
4
3
17
19
23
37
41
67
292229292292
12
29
2
2
8
7
19
23
29
1122121111111
13
139
2
7
2
11
13
17
61
101
139
55115551555155
14
107
3
3
5
2
7
3
13
2
23
67
107
799777779779979
15
71
2
3
7
11
13
19
3
31
2
47
71
1161111111166611
16
101
6
3
11
29
2
79
2
89
101
11112112121222112
17
137
5
2
3
2
7
4
11
13
17
2
73
137
111111222221111112
18
127
3
2
3
7
11
13
31
37
2
53
89
2
127
3334334333334333333
19
307
3
23
2
29
2
41
47
79
157
191
307
55333333335335355355
20
173
5
11
19
29
41
59
61
73
89
101
109
173
101010110010001010011
21
347
19
29
43
73
97
137
193
211
311
347
3383383883833883388888
22
383
3
2
10
3
11
13
23
29
31
79
223
359
383
11112221111212222222221
23
439
2
3
7
11
13
19
23
29
2
37
41
139
157
181
439
112122222222122122122112
24
271
7
2
2
7
11
13
41
73
101
137
199
223
251
271
2777227772777277722272272
25
853
4
2
3
7
79
97
101
227
2
443
463
607
853
61666616611611166166161116
26
521
2
2
3
67
101
113
127
157
163
197
257
277
283
521
858885585585555585558558858
27
587
2
3
23
2
31
2
163
167
223
251
317
353
397
587
3331333133331111313111133133
28
883
3
2
7
61
71
73
101
131
157
239
373
557
787
883
98888999899889989898999889999
29
571
3
3
7
11
2
13
2
23
37
71
79
109
113
313
409
523
571
111661111111666616661166166616
30
823
3
2
3
7
13
17
37
61
83
89
107
113
277
313
419
499
823
The smoothness of these numbers is as follows:
In[]:=
First[Last[FactorInteger[#]]]&/@list
Out[]=
{2,3,3,7,11,29,19,19,23,67,29,139,107,71,101,137,127,307,173,347,383,439,271,853,521,587,883,571,823}
Here’s code for looking for these.
In[]:=
len=9;​​case=Monitor[SortBy[Union[Flatten[Table[Select[​​Union[(FromDigits/@Select[Flatten[Table[IntegerDigits[k,2,len]/.{0->a,1->b},{a,1,9},{b,1,9}],1],Length[Union[#]]==2&])],First[Last[FactorInteger[#]]]<1000&],{k,2^(len-1),2^len-1}]]],First[Last[FactorInteger[#]]]&],k];
In[]:=
{#,FactorInteger[#]}&/@SortBy[Union[Take[case,10]],First[Last[FactorInteger[#]]]&]
Out[]=
{{799779977,{{17,1},{19,6}}},{858558888,{{2,3},{3,2},{11,3},{17,2},{31,1}}},{111222111,{{3,1},{7,2},{11,2},{13,2},{37,1}}},{222444222,{{2,1},{3,1},{7,2},{11,2},{13,2},{37,1}}},{333666333,{{3,2},{7,2},{11,2},{13,2},{37,1}}},{444444111,{{3,3},{23,2},{29,2},{37,1}}},{444888444,{{2,2},{3,1},{7,2},{11,2},{13,2},{37,1}}},{774747477,{{3,3},{7,4},{17,1},{19,1},{37,1}}},{888888222,{{2,1},{3,3},{23,2},{29,2},{37,1}}},{499444944,{{2,4},{3,1},{19,3},{37,1},{41,1}}}}
And from that, a smooth sequence is generated.
The largest prime factor of 3383383883833883388888 is 383.
The largest prime factor of 292229292292 is 29. But
29
2
=536870912, which has all the digits but 4.
I find things like that interesting.

CITE THIS NOTEBOOK

A smooth sequence of numbers like 799779977=17*19^6​
by Ed Pegg​
Wolfram Community, STAFF PICKS, March 6, 2024
​https://community.wolfram.com/groups/-/m/t/3136537