A387653 Numbers k such that k and k+1 are both almost practical numbers (A174533).
134504, 636615, 648584, 1521975, 1836135, 2105144, 2276504, 2607255
Offset: 1
Programs
-
Mathematica
almostPracQ[n_] := almostPracQ[n] = Module[{d = Divisors[n], c, x}, c = CoefficientList[Product[1 + x^i, {i, d}], x]; Count[Rest[c], _?(# > 0 &)] == Total[d] - 2]; Select[Range[135000], almostPracQ[#] && almostPracQ[#+1] &] (* warning: a slow program *) -
PARI
isA174533(k) = {my(d = divisors(k), nd = #d, s = vecsum(d), p = prod(i = 1, nd, 1 + 'x^d[i])); #select(x -> x > 0, Col(p)) + 1 == s;} \\ A174533 list(kmax) = {my(is1 = 0, is2); for(k = 2, kmax, is2 = isA174533(k); if(is1 && is2, print1(k-1, ", ")); is1 = is2);} \\ warning: a slow program