A081454 Triangle read by rows in which the n-th row contains n distinct numbers whose product is a square, which is minimal over all choices for n distinct numbers.
1, 1, 4, 1, 2, 8, 1, 2, 3, 6, 1, 2, 3, 4, 6, 1, 2, 3, 4, 6, 9, 1, 2, 3, 5, 6, 8, 10, 1, 2, 3, 4, 5, 6, 8, 10, 1, 2, 3, 4, 5, 6, 8, 9, 10, 1, 2, 3, 4, 5, 6, 7, 9, 10, 14, 1, 2, 3, 4, 5, 7, 8, 9, 10, 12, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 12, 14, 15, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 14, 22
Offset: 1
Examples
Triangle begins: 1; 1, 4; 1, 2, 8; 1, 2, 3, 6; 1, 2, 3, 4, 6; 1, 2, 3, 4, 6, 9; 1, 2, 3, 5, 6, 8, 10; 1, 2, 3, 4, 5, 6, 8, 10; 1, 2, 3, 4, 5, 6, 8, 9, 10; ... The 7th row could also be 1, 2, 3, 4, 5, 8, 15, but this has a larger last term.
Links
- Max Alekseyev, Rows n = 1..50, flattened
Programs
-
Maple
A081454aux := proc(n,s,mfact) local d,findx,f ; if n = 1 then if s <= mfact then RETURN([s]) ; else RETURN([]) ; fi ; else d := numtheory[divisors](s) ; for findx from n to nops(d) do if op(findx,d) <= mfact then f := A081454aux(n-1,s/op(findx,d),op(findx,d)-1) ; if nops(f) <> 0 then RETURN([op(f),op(findx,d)]) ; fi ; fi ; od ; RETURN([]) ; fi ; end: A081454row := proc(n) local p,s,d,findx,f ; p :=1 ; s :=1 ; while true do d := numtheory[divisors](s) ; if nops(d) >= n then if n = 1 then RETURN([1]) ; else for findx from n to nops(d) do f := A081454aux(n-1,s/op(findx,d),op(findx,d)-1) ; if nops(f) <> 0 then RETURN([op(f),op(findx,d)]) ; fi ; od; fi ; fi ; p := p+1 ; s := p^2 ; od ; end: for n from 1 to 14 do r := A081454row(n) : for i from 1 to n do printf("%d,",op(i,r) ) ; od ; od : # R. J. Mathar, Nov 12 2006
-
Mathematica
T[n_] := T[n] = SortBy[MinimalBy[Select[Subsets[Range[2n+2], {n}], #[[1]] == 1 && IntegerQ@Sqrt[Times @@ #]&], Times @@ #&], Last] // First; Table[Print[n, " ", T[n]]; T[n], {n, 1, 12}] // Flatten (* Jean-François Alcover, Jun 03 2023 *)
Extensions
Edited and extended by David Garber, Jun 17 2003
More terms from Ray G. Opao, Aug 01 2005
Corrected and extended by R. J. Mathar, Nov 12 2006
More terms from Max Alekseyev, Apr 25 2009
Correct row #13 conjectured by Jean-François Alcover and confirmed by Max Alekseyev, Jun 03 2023
Comments