A066720 The greedy rational packing sequence: a(1) = 1; for n > 1, a(n) is smallest number such that the ratios a(i)/a(j) for 1 <= i < j <= n are all distinct.

1, 2, 3, 5, 7, 8, 11, 13, 17, 18, 19, 23, 29, 31, 37, 41, 43, 47, 50, 53, 59, 60, 61, 67, 71, 73, 79, 81, 83, 89, 97, 98, 101, 103, 105, 107, 109, 113, 127, 128, 131, 137, 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, 223, 227, 229, 233, 239

Offset: 1

Author

N. J. A. Sloane, Jan 15 2002

Keywords

• nonn
• nice

Comments

Sequence was apparently invented by Jeromino Wannhoff - see the Rosenthal link.

An equivalent definition: a(1) = 1, a(2) = 2 and thereafter a(n) is the smallest number such that all a(i)*a(j) are different. - Thanks to Jean-Paul Delahaye for this comment. - N. J. A. Sloane, Oct 01 2020

If you replace the word "ratio" with "difference" and start from 1 using the same greedy algorithm you get A005282. - Sharon Sela (sharonsela(AT)hotmail.com), Jan 15 2002

Taking a(n) as the smallest number such that the pairwise sums a(i)+a(j) (iA011185. - Jean-Paul Delahaye, Oct 02 2020. [This replaces an incorrect comment.]

Does every rational number appear as a ratio? See A066657, A066658.

Contains all primes. Differs from A066724 in that the latter forbids only the products of distinct terms. - Ivan Neretin, Mar 02 2016

Examples

			After 5, 7 is the next member and not 6 as 6*1 = 2*3.
		

Links

• N. J. A. Sloane, Table of n, a(n) for n = 1..20000
• David Applegate, First 48186 terms of A066721 and their factorizations (implies first 8165063 terms of current sequence)
• Rainer Rosenthal, Posting to de.rec.denksport, Jan 15 2002
• Robert E. Sawyer, Is there such a sequence? Posting by r.e.s. to sci.math newsgroup, Jan 13, 2002

Crossrefs

Consists of the primes together with A066721.

Cf. A011185, A005282, A066724, A066775, A079850, A079852.

For the rationals that are produced see A066657/A066658 and A066848, A066849.

Programs

Haskell

import qualified Data.Set as Set (null)
import Data.Set as Set (empty, insert, member)
a066720 n = a066720_list !! (n-1)
a066720_list = f [] 1 empty where
   f ps z s | Set.null s' = f ps (z + 1) s
            | otherwise   = z : f (z:ps) (z + 1) s'
     where s' = g (z:ps) s
           g []     s                      = s
           g (x:qs) s | (z * x) `member` s = empty
                      | otherwise          = g qs $ insert (z * x) s
-- Reinhard Zumkeller, Nov 19 2013

Maple

A[1]:= 1:
F:= {1}:
for n from 2 to 100 do
for k from A[n-1]+1 do
Fk:= {k^2, seq(A[i]*k,i=1..n-1)};
if Fk intersect F = {} then
A[n]:= k;
F:= F union Fk;
break
fi
od
od:
seq(A[i],i=1..100); # Robert Israel, Mar 02 2016

Mathematica

s={1}; xok := Module[{}, For[i=1, i<=n, i++, For[j=1; k=Length[dl=Divisors[s[[i]]x]], j<=k, j++; k--, If[MemberQ[s, dl[[j]]]&&MemberQ[s, dl[[k]]], Return[False]]]]; True]; For[n=1, True, n++, Print[s[[n]]]; For[x=s[[n]]+1, True, x++, If[xok, AppendTo[s, x]; Break[]]]] (* Dean Hickerson *)
a[1] = 1; a[n_] := a[n] = Block[{k = a[n - 1] + 1, b = c = Table[a[i], {i, 1, n - 1}], d}, While[c = Append[b, k]; Length[ Union[ Flatten[ Table[ c[[i]]/c[[j]], {i, 1, n}, {j, 1, n}]]]] != n^2 - n + 1, k++ ]; Return[k]]; Table[ a[n], {n, 1, 75} ] (* Robert G. Wilson v *)
nmax = 100; a[1] = 1; F = {1};
For[n = 2, n <= nmax, n++,
For[k = a[n-1]+1, True, k++, Fk = Join[{k^2}, Table[a[i]*k, {i, 1, n-1}]] // Union; If[Fk ~Intersection~ F == {}, a[n] = k; F = F ~Union~ Fk; Break[]
]]];
Array[a, nmax] (* Jean-François Alcover, Mar 26 2019, after Robert Israel *)

PARI

{a066720(m) = local(a,rat,n,s,new,b,i,k,j); a=[]; rat=Set([]); n=0; s=0; while(sKlaus Brockhaus, Feb 23 2002

Extensions

More terms from Dean Hickerson, Klaus Brockhaus and David Applegate, Jan 15 2002

Entry revised by N. J. A. Sloane, Oct 01 2020.