A331365 Least k whose set of divisors contains exactly n Pythagorean quadruples, or 0 if no such k exists.

42, 84, 168, 252, 672, 756, 420, 504, 2592, 1872, 840, 1008, 1512, 2940, 1680, 2016, 1260, 4536, 3360, 3024, 9450, 4620, 5880, 6552, 9504, 6930, 3780, 8400, 23184, 25704, 2520, 6300, 31752, 8820, 19800, 11088, 10920, 13104, 15840, 19152, 19656, 16632, 38016

Offset: 1

Author

Michel Lagneau, May 03 2020

Keywords

• nonn

Comments

a(n) == 0 (mod 6).

Examples

			a(3) = 168 because the set of the divisors {1, 2, 3, 4, 6, 7, 8, 12, 14, 21, 24, 28, 42, 56, 84, 168} contains 3 Pythagorean quadruples {2, 3, 6, 7}, {4, 6, 12, 14} and {8, 12, 24, 28}.
		

Links

• Chai Wah Wu, Table of n, a(n) for n = 1..1026
• Eric Weisstein's World of Mathematics, Pythagorean Quadruples.

Crossrefs

Cf. A027750, A169580, A330893, A330894.

Programs

Maple

with(numtheory):
for n from 1 to 52 do :
ii:=0:
for q from 3 to 10^8 while(ii=0) do:
   d:=divisors(q):n0:=nops(d):it:=0:
    for i from 1 to n0-3 do:
     for j from i+1 to n0-2 do :
      for k from j+1 to n0-1 do:
      for l from k+1 to n0 do:
       if d[i]^2 + d[j]^2 + d[k]^2 = d[l]^2
        then
        it:=it+1:
        else
       fi:
      od:
     od:
    od:
   od:
    if it = n
     then
     ii:=1: printf(`%d %d \n`,n,q):
     else
    fi:
od:
od:

Mathematica

upto = 38016; nq[n_] := If[Mod[n, 6] > 0, 0, Block[{t, u, v, c=0, d = Divisors@ n, m}, m = Length@ d; Do[t = d[[i]]^2 + d[[j]]^2; Do[u = t + d[[h]]^2; If[u > n^2, Break[]]; If[Mod[n^2, u] == 0 && IntegerQ[v = Sqrt@ u] && Mod[n, v] == 0, c++], {h, j+1, m-1}], {i, m-3}, {j, i+1, m-2}]; c]]; w = ParallelTable[ {nq@ n, n}, {n, 6 Range[ upto / 6]}]; t=0 Range@ Max[First /@ w]; Do[{q, x} = e; If[q > 0 && t[[q]] == 0, t[[q]] = x], {e, w}]; AppendTo[t, 0]; TakeWhile[t, # > 0 &] (* Giovanni Resta, May 04 2020 *)