A348631
Nonexponential weird numbers: nonexponential abundant numbers (A348604) that are not equal to the sum of any subset of their nonexponential divisors.
Original entry on oeis.org
70, 4030, 5830, 10430, 10570, 10990, 11410, 11690, 12110, 12530, 12670, 13370, 13510, 13790, 13930, 14770, 15610, 15890, 16030, 16310, 16730, 16870, 17570, 17990, 18410, 18830, 18970, 19390, 19670, 19810, 20510, 21490, 21770, 21910, 22190, 23170, 23590, 24290
Offset: 1
70 is a term since the sum of its nonexponential divisors, {1, 2, 5, 7, 10, 14, 35}, is 74 > 70, and no subset of these divisors sums to 70.
-
dQ[n_, m_] := (n > 0 && m > 0 && Divisible[n, m]); expDivQ[n_, d_] := Module[{ft = FactorInteger[n]}, And @@ MapThread[dQ, {ft[[;; , 2]], IntegerExponent[d, ft[[;; , 1]]]}]]; neDivs[1] = {}; neDivs[n_] := Module[{d = Divisors[n]}, Select[d, ! expDivQ[n, #] &]]; nesigma[n_] := Total@neDivs[n]; neAbundantQ[n_] := nesigma[n] > n; neWeirdQ[n_] := neAbundantQ[n] && Module[{d = neDivs[n]}, SeriesCoefficient[Series[Product[1 + x^d[[i]], {i, Length[d]}], {x, 0, n}], n] == 0]; Select[Range[6000], neWeirdQ]
A349285
(1+e)-weird numbers: (1+e)-abundant numbers k such that no subset of the aliquot (1+e)-divisors of k sums to k.
Original entry on oeis.org
70, 836, 4030, 5830, 10430, 10570, 10990, 11410, 11690, 12110, 12530, 12670, 13370, 13510, 13790, 13930, 14770, 15610, 15890, 16030, 16310, 16730, 16870, 17570, 17990, 18410, 18830, 18970, 19390, 19670, 19810, 20510, 21490, 21770, 21910, 22190, 23170, 23590, 24290
Offset: 1
-
divQ[n_, m_] := (n > 0 && (m == 0 || Divisible[n, m])); oeDivQ[n_, d_] := Module[{f = FactorInteger[n]}, And @@ MapThread[divQ, {f[[;; , 2]], IntegerExponent[d, f[[;; , 1]]]}]]; oeDivs[1] = {1}; oeDivs[n_] := Module[{d = Divisors[n]}, Select[d, oeDivQ[n, #] &]]; oesigma[1] = 1; oesigma[n_] := Total@oeDivs[n]; oeAbundantQ[n_] := oesigma[n] > 2*n; oeWeirdQ[n_] := oeAbundantQ[n] && Module[{d = Most[oeDivs[n]]}, SeriesCoefficient[Series[Product[1 + x^d[[i]], {i, Length[d]}], {x, 0, n}], n] == 0]; Select[Range[12000], oeWeirdQ]
A381071
Numbers k such that the sum of the proper divisors of k that have the same binary weight as k is larger than k, and no subset of these divisors sums to k.
Original entry on oeis.org
1050, 3150, 4284, 4410, 5148, 6292, 6790, 7176, 8890, 10764, 17850, 18648, 19000, 19530, 32886, 33072, 33150, 35088, 35530, 35720, 35770, 38850, 41360, 43164, 45084, 49368, 49764, 50456, 50730, 52884, 54280, 54340, 58410, 58696, 59010, 59408, 63492, 66010, 68376
Offset: 1
Similar sequences:
A006037,
A064114,
A292986,
A306984,
A321146,
A327948,
A339939,
A348525,
A348631,
A349285,
A364862.
-
divs[n_] := Module[{hw = DigitCount[n, 2, 1]}, Select[Divisors[n], DigitCount[#, 2, 1] == hw &]];
weirdQ[n_, d_, s1_, m1_] := weirdQ[n, d, s1, m1] = Module[{s = s1, m = m1}, If[m == 0, False, While[m > 0 && d[[m]] > n, s -= d[[m]]; m--]; If[m == 0, True, d[[m]] < n && If[s > n, weirdQ[n - d[[m]], d, s - d[[m]], m - 1] && weirdQ[n, d, s - d[[m]], m - 1], s < n && m < Length[d] - 1]]]];
q[n_] := Module[{d = divs[n], s, m}, s = Total[d] - n; m = Length[d] - 1; weirdQ[n, d, s, m]]; Select[Range[70000], q] (* based on a Pari code by M. F. Hasler at A006037 *)
-
divs(n) = {my(h = hammingweight(n)); select(x -> hammingweight(x)==h, divisors(n));}
is(n, d = divs(n), s = vecsum(d)-n, m = #d-1) = {if(m == 0, return(0)); while(m > 0 && d[m] > n, s -= d[m]; m--); if(m==0, return(1)); (d[m] < n &&
if(s > n, is(n-d[m], d, s-d[m], m-1) && is(n, d, s-d[m], m-1), s < n && m < #d-1));} \\ based on a code by M. F. Hasler at A006037
Showing 1-3 of 3 results.
Comments