A334902 Infinitary practical numbers (A334901) whose number of divisors is not a power of 2.
72, 360, 480, 504, 600, 672, 792, 864, 936, 1050, 1056, 1152, 1176, 1224, 1248, 1350, 1368, 1400, 1470, 1650, 1656, 1800, 1950, 1960, 2088, 2200, 2232, 2520, 2600, 2646, 2664, 2952, 3096, 3200, 3234, 3240, 3360, 3384, 3402, 3528, 3816, 3822, 3960, 4200, 4248, 4312
Offset: 1
Keywords
Links
- Amiram Eldar, Table of n, a(n) for n = 1..10000
Programs
-
Mathematica
bin[n_] := 2^(-1 + Position[Reverse @ IntegerDigits[n, 2], ?(# == 1 &)] // Flatten); f[p, e_] := p^bin[e]; icomp[n_] := Flatten[f @@@ FactorInteger[n]]; fun[p_, e_] := Module[{b = IntegerDigits[e, 2]}, m = Length[b]; Product[If[b[[j]] > 0, 1 + p^(2^(m - j)), 1], {j, 1, m}]]; isigma[1] = 1; isigma[n_] := Times @@ fun @@@ FactorInteger[n]; infPracQ[n_] := Module[{f, p, e, prod = 1, ok = True}, If[n < 1 || (n > 1 && OddQ[n]), False, If[n == 1, True, r = Sort[icomp[n]]; Do[If[r[[i]] > 1 + isigma[prod], ok = False; Break[]]; prod = prod*r[[i]], {i, Length[r]}]; ok]]]; pow2Q[n_] := n/2^IntegerExponent[n, 2] == 1; Select[Range[4400], ! pow2Q[DivisorSigma[0, #]] && infPracQ[#] &]
Comments