The first two MU-numbers are 2 and 3. Every other MU-number is the smallest number not yet appeared that can be expressed as the product of two earlier distinct MU-numbers in exactly one way.
Here are the first 10
2, 3, 6, 12, 18, 24, 48, 54, 96, 162
Given a positive number calculate and output the nth MU-number.
This is a code-golf competition so you should aim to make your source code as small as possible.
@u+Gfq2l@GcLTGheGQhB2
0-indexed.
@u+Gfq2l@GcLTGheGQhB2Q Implicitly append Q and read+eval input to it.
hB2 Take the list [2, 2 + 1].
u Q Put the list in G and apply this Q times:
eG Get last number in G.
h Add one.
f Starting from that, find the first T such that:
cLTG Divide T by each of the numbers in G.
@G Find the quotients that are also in G.
l Get the number of such quotients.
q2 Check that it equals 2.
+G Append that T to G.
@ Q Get the Q'th number in G.
@ sign on the last line is misaligned. I can't make a suggested edit, since it's a 2-character change.
\$\endgroup\$
Jul 13, 2017 at 23:20
l#(a:b)|[x]<-[a|i<-l,j<-l,i<j,i*j==a]=a:(a:l)#b|1<2=l#b
((2:3:[2,3]#[4..])!!)
How it works
2:3: -- start the list with 2 and 3 and append a call to # with
[2,3] -- the list so far and
#[4..] -- list of candidate elements
l # (a:b) -- l -> list so far, a -> next candidate element, b -> rest c.el.
| [x]<-[...] -- if the list [...] is a singleton list
=a:(a:l#b) -- the result is a followed by a recursive call with l extended
by a and b
| 1<2=l#b -- if it's not a singleton list, drop a and retry with b
-- the [...] list is
[ i<-l,j<-l, -- loop i through l and j through l and whenever
i<j, -- i<j and
i*j==a] -- i*j==a
a| -- add a to the list
ŒcP€ḟ⁸ṢŒgLÞḢḢṭ
2,3Ç¡ị@
A monadic link, 1-indexed.
ŒcP€ḟ⁸ṢŒgLÞḢḢṭ - Link 1, add the next number: list, a e.g. [2,3,6,12,18,24]
Œc - unordered pairs [[2,3],[2,6],[2,12],[2,18],[2,24],[3,6],[3,12],[3,18],[3,24],[6,12],[6,18],[6,24],[12,18],[12,24],[18,24]]
P€ - product of €ach [6,12,24,36,48,18,36,54,72,72,108,144,216,288,432]
⁸ - chain's left argument, a [2,3,6,12,18,24]
ḟ - filter discard [36,48,36,54,72,72,108,144,216,288,432]
Ṣ - sort [36,36,48,54,72,72,108,144,216,288,432]
Œg - group runs of equal elements [[36,36],[48],[54],[72,72],[108],[144],[216],[288],[432]]
Þ - sort by:
L - length [[48],[54],[108],[144],[216],[288],[432],[36,36],[72,72]]
Ḣ - head [48]
Ḣ - head 48
ṭ - tack to a [2,3,6,12,18,24,48]
2,3Ç¡ị@ - Link: number, i e.g. 7
2,3 - literal [2,3] [2,3]
¡ - repeat i times:
Ç - call last link (1) as a monad [2,3,6,12,18,24,48,54,96]
ị@ - index into with swapped @rguments (with i) 48
8 bytes thanks to Giuseppe.
r=3:2;for(i in 1:scan())r=c(min((g=(r%o%r)[i:-1<i])[colSums(g%o%g==g*g)+g%in%r<3]),r);r[3]
< has lower precedence than + so I couldn't figure out what in the heck +g%in%r<3 was doing, and while I was doing that, you golfed down the two parts I was going to suggest... +1
\$\endgroup\$
4,{_2m*{~>},::*1$-$e`$0=|}qi*-2=
Online demo with 0-indexing.
I'm not sure there's much to be done beyond a trivial translation of the spec with one exception: by starting with a list of [0 1 2 3] (instead of [2, 3]) I save one byte immediately on initialisation and another two by being able to do 0=| (adding just the new element because its frequency is 1 and is already in the list), but don't introduce any false elements because for every x in the list 0*x and 1*x are already in the list.
n=input()
l=[2,3]
exec't=sorted(x*y for i,x in enumerate(l)for y in l[i+1:]);l+=min(t,key=(l+t).count),;'*n
print l[n]
simple modification of the code found at oeis link
(s={2,3};Do[n=Select[Split@Sort@Flatten@Table[s[[j]]s[[k]],{j,Length@s},{k,j+1,Length@s}],#[[1]]>s[[-1]]&&Length@#==1&][[1,1]];AppendTo[s,n],{#}];s[[#]])&
0-indexed
for($r=[2,3];!$r[$argn];$r[]=$l=min($m)/2){$m=[];foreach($r as$x)foreach($r as$y)($p=$x*$y)<=$l|$y==$x?:$m[$p]+=$p;}echo$r[$argn];
Expanded
for($r=[2,3];!$r[$argn]; #set the first to items and loop till search item exists
$r[]=$l=min($m)/2){ # add the half of the minimum of found values to the result array
$m=[]; # start with empty array
foreach($r as$x) # loop through result array
foreach($r as$y) # loop through result array
($p=$x*$y)<=$l|$y==$x? # if product is greater as last value and we do multiple two distinct values
:$m[$p]+=$p; # add 2 times or more the product to array so we drop 36 cause it will be 144
}
echo$r[$argn]; # Output
0-indexed
for($r=[2,3];!$r[$argn];$r[]=$l=min(array_diff_key($m,$d))){$d=$m=[];foreach($r as$x)foreach($r as$y)$x<$y?${dm[$m[$p=$x*$y]<1&$p>$l]}[$p]=$p:0;}echo$r[$argn];
0-indexed
for($r=[2,3];!$r[$argn];$r[]=$l=min(array_diff($m,$d))){$d=$m=[];foreach($r as$x)foreach($r as$y)$x<$y?${dm[!in_array($p=$x*$y,$m)&$p>$l]}[]=$p:0;}echo$r[$argn];
(t=1;s={2,3};While[t<#,s=AppendTo[s,Sort[Select[First/@Select[Tally[Times@@@Permutations[s,{2}]],#[[2]]==2&],#>Last@s&]][[1]]];t++];s[[#]])&
3:i:"t&*9B#u2=)yX-X<h]2_)
3: % Push [1 2 3]. Initial array of MU numbers, to be extended with more numbers
i: % Input n. Push [1 2 ... n]
" % Do this n times
t % Duplicate array of MU numbers so far
&* % Matrix of pair-wise products
9B % Push 9 in binary, that is, [1 0 0 1]
# % Specify that next function will produce its first and fourth ouputs
u % Unique: pushes unique entries (first output) and their counts (fourth)
2= % True for counts that equal 2
) % Keep only unique entries with count 2
y % Duplicate (from below) array of MU numbers so far
X- % Set difference
X< % Minimum. This is the new MU number
h % Concatenate vertically horizontally to extend the array
] % End
2_ % Push 2 negated, that is, -2
) % Get entry at position -2, that is, third-last. Implicitly display
{(2,3,{first *∉@_,@_.combinations(2).classify({[*]
$_}).grep(*.value==1)».key.sort}...*)[$_]}
2, 3, { ... } ... * is an infinite sequence where each element starting with the third is computed by the brace-delimited code block. Since the code block takes its arguments via the slurpy @_ array, it receives the entire current sequence in that array.@_.combinations(2) is a sequence of all 2-element combinations of @_..classify({ [*] $_ }) classifies each 2-tuple by its product, producing a hash where the products are the keys and the values are the list of 2-tuples that have that product..grep(*.value == 1) selects those key-value pairs from the hash where the value (ie, the list of pairs having that key as a product) has a size of 1.».key selects only the keys of each pair. This is the list of products that arise from only one combination of factors of the current sequence..sort sorts the products numerically.first * ∉ @_, ... finds the first of those products that has not already appeared in the sequence.A recursive function that takes a 0-based index.
f=(n,a=[2,m=3])=>a[n]||a.map(c=>a.map(d=>c<d&(d*=c)>m?b[d]=b[d]/0||d:0),b=[])|f(n,a.push(m=b.sort((a,b)=>a-b)[0])&&a)
At each iteration of f(), we use the last term m of the sequence and an initially empty array b to identify the next term. For each product d > m of two earlier distinct MU-numbers, we do:
b[d] = b[d] / 0 || d
and then keep the minimum value of b.
The above expression is evaluated as follows:
b[d] | b[d] / 0 | b[d] / 0 || d
-------------------+-----------+--------------
undefined | NaN | d
already equal to d | +Infinity | +Infinity
+Infinity | +Infinity | +Infinity
This guarantees that products which can be expressed in more than one way will never be selected.
f = (n, a = [2, m = 3]) => // given: n = input, a[] = MU array, m = last term
a[n] || // if a[n] is defined, return it
a.map(c => // else for each value c in a[]:
a.map(d => // and for each value d in a[]:
c < d & // if c is less than d and
(d *= c) > m ? // d = d * c is greater than m:
b[d] = b[d] / 0 || d // b[d] = either d or +Infinity (see 'How?')
: // else:
0 // do nothing
), // end of inner map()
b = [] // initialization of b[]
) | // end of outer map()
f( // do a recursive call:
n, // - with n
a.push( // - push in a[]:
m = b.sort((a, b) => a - b)[0] // m = minimum value of b[]
) && a // and use a[] as the 2nd parameter
) // end of recursive call
f=(n,a=[2,m=3])=>a[n]||a.map(c=>a.map(d=>c<d&(d*=c)>m?b[d]=b[d]/0||d:0),b=[])|f(n,a.push(m=b.sort((a,b)=>a-b)[0])&&a)
for(var n = 0; n < 10; n++) {
console.log('MU[' + n + '] = ' + f(n));
}
n x=[a*b|[a,b]<-mapM id[1:x,x]]
d x=minimum[a|a<-n x,2==sum[1|b<-n x,b==a]]:x
l x|x<3=x+1:[2]|1>0=d$l$x-1
(!!0).l
n x=(*)<$>x<*>1:x
\$\endgroup\$
a=[2,3];exec'p=[x*y for x in a for y in a if x-y];a+=min(q for q in p if p.count(q)+(q in a)<3),;'*input();print a[-2]
Thanks to @Mr.Xcoder and @LeakyNun for improvements!
p.count(q)==1 to p.count(q)>0 is valid, because that's the code that ensures the "in exactly one way" condition of the challenge.
\$\endgroup\$
p.count(q)-~(q in a)<=3 is equivalent to p.count(q)+(q in a)<3
\$\endgroup\$
Jul 13, 2017 at 18:55