A359411
a(n) is the number of divisors of n that are both infinitary and exponential.
Original entry on oeis.org
1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 2, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1
Offset: 1
a(8) = 2 since 8 has 2 divisors that are both infinitary and exponential: 2 and 8.
-
s[n_] := DivisorSum[n, 1 &, BitAnd[n, #] == # &]; f[p_, e_] := s[e]; a[1] = 1; a[n_] := Times @@ f @@@ FactorInteger[n]; Array[a, 100]
-
s(n) = sumdiv(n, d, bitand(d, n)==d);
a(n) = {my(f = factor(n)); prod(i = 1, #f~, s(f[i,2]));}
-
from math import prod
from sympy import divisors, factorint
def A359411(n): return prod(sum(1 for d in divisors(e,generator=True) if e|d == e) for e in factorint(n).values()) # Chai Wah Wu, Sep 01 2023
A038148
Number of 3-infinitary divisors of n: if n = Product p(i)^r(i) and d = Product p(i)^s(i), each s(i) has a digit a <= b in its ternary expansion everywhere that the corresponding r(i) has a digit b, then d is a 3-infinitary-divisor of n.
Original entry on oeis.org
1, 2, 2, 3, 2, 4, 2, 2, 3, 4, 2, 6, 2, 4, 4, 4, 2, 6, 2, 6, 4, 4, 2, 4, 3, 4, 2, 6, 2, 8, 2, 6, 4, 4, 4, 9, 2, 4, 4, 4, 2, 8, 2, 6, 6, 4, 2, 8, 3, 6, 4, 6, 2, 4, 4, 4, 4, 4, 2, 12, 2, 4, 6, 3, 4, 8, 2, 6, 4, 8, 2, 6, 2, 4, 6, 6, 4, 8, 2, 8, 4, 4, 2, 12, 4, 4, 4, 4, 2, 12, 4, 6, 4, 4, 4, 12, 2, 6, 6, 9, 2, 8, 2, 4, 8
Offset: 1
2^3*3 is a 3-infinitary-divisor of 2^5*3^2 because 2^3*3 = 2^10*3^1 and 2^5*3^2 = 2^12*3^2 in ternary expanded power. All corresponding digits satisfy the condition. 1 <= 1, 0 <= 2, 1 <= 2.
- Antti Karttunen, Table of n, a(n) for n = 1..10000
- Frédéric Chyzak, Ivan Gutman, and Peter Paule, Predicting the number of hexagonal systems with 24 and 25 hexagons, Communications in Mathematical and Computer Chemistry (1999) No. 40, 139-151. See p. 141.
- J. O. M. Pedersen, Tables of Aliquot Cycles [Broken link]
- J. O. M. Pedersen, Tables of Aliquot Cycles [Via Internet Archive Wayback-Machine]
- J. O. M. Pedersen, Tables of Aliquot Cycles [Cached copy, pdf file only]
- Index entries for sequences computed from exponents in factorization of n
-
A038148 := proc(n) if n= 1 then 1; else ifa := ifactors(n)[2] ;
a := 1; for f in ifa do e := convert(op(2,f),base,3) ; a := a*mul(d+1,d=e) ; end do: end if; end proc:
seq(A038148(n),n=1..50) ; # R. J. Mathar, Feb 08 2011
-
a[1] = 1; a[n_] := (k = 1; Do[k = k * Times @@ (IntegerDigits[f, 3] + 1), {f, FactorInteger[n][[All, 2]]}]; k); Table[a[n], {n, 1, 102}](* Jean-François Alcover, Feb 03 2012, after R. J. Mathar *)
-
A006047(n) = { my(m=1, d); while(n, d = (n%3); m *= (1+d); n = (n-d)/3); m; };
A038148(n) = factorback(apply(e -> A006047(e), factorint(n)[, 2])); \\ (After A037445) - Antti Karttunen, May 28 2017
-
(define (A038148 n) (if (= 1 n) n (* (A006047 (A067029 n)) (A038148 (A028234 n))))) ;; Antti Karttunen, May 28 2017
A064379
Irregular triangle whose n-th row is a list of numbers that are infinitarily relatively prime to n (n = 2, 3, ...).
Original entry on oeis.org
1, 1, 2, 1, 2, 3, 1, 2, 3, 4, 1, 4, 5, 1, 2, 3, 4, 5, 6, 1, 3, 5, 7, 1, 2, 3, 4, 5, 6, 7, 8, 1, 3, 4, 7, 9, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 1, 2, 5, 7, 9, 10, 11, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 3, 4, 5, 9, 11, 12, 13, 1, 2, 4, 7, 8, 9, 11, 13, 14, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14
Offset: 2
irelprime[6] = {1, 4, 5} because iDivisors[6] = {1, 2, 3, 6} and iDivisors[4] = {1, 4} so 4 is infinitary_relatively_prime to 6 since it lacks common infinitary divisors with 6.
For n = 2 ..8 irelprime[n] gives {1}, {1,2}, {1,2,3}, {1,2,3,4}, {1,4,5}, {1,2,3,4,5,6}, {1,3,5,7}.
Triangle starts:
2: 1;
3: 1, 2;
4: 1, 2, 3;
5: 1, 2, 3, 4;
6: 1, 4, 5;
7: 1, 2, 3, 4, 5, 6;
8: 1, 3, 5, 7;
9: 1, 2, 3, 4, 5, 6, 7, 8;
10: 1, 3, 4, 7, 9;
11: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10;
12: 1, 2, 5, 7, 9, 10, 11;
13: 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12;
14: 1, 3, 4, 5, 9, 11, 12, 13;
15: 1, 2, 4, 7, 8, 9, 11, 13, 14;
-
irelprime[ n_ ] := Select[ temp=iDivisors[ n ]; Range[ n ], Intersection[ iDivisors[ # ], temp ]==={1}& ]; (* with iDivisors of n as *) bitty[ k_ ] := Union[ Flatten[ Outer[ Plus, Sequence@@{0, #1}&/@Union[ 2^Range[ 0, Floor[ Log[ 2, k ] ] ]*Reverse[ IntegerDigits[ k, 2 ] ] ] ] ] ]; iDivisors[ k_Integer ] := Sort[ (Times @@(First[ it ]^(#1/.z-> List))&)/@Flatten[ Outer[ z, Sequence@@bitty/@Last[ it=Transpose[ FactorInteger[ k ] ] ], 1 ] ] ]; iDivisors[ 1 ] := {1};
infCoprimeQ[n1_, n2_] := Module[{g = GCD[n1, n2]}, If[g == 1, True, AllTrue[ FactorInteger[g][[;; , 1]], BitAnd @@ IntegerExponent[{n1, n2}, #] == 0 &]]]; row[n_] := Select[Range[n - 1], infCoprimeQ[#, n] &]; Table[row[n], {n, 2, 16}] // Flatten (* Amiram Eldar, Mar 26 2023 *)
-
isinfcoprime(n1, n2) = {my(g = gcd(n1, n2), p, e1, e2); if(g == 1,return(1)); p = factor(g)[, 1]; for(i=1, #p, e1 = valuation(n1, p[i]); e2 = valuation(n2, p[i]); if(bitand(e1, e2) > 0, return(0))); 1; }
row(n) = select(x->isinfcoprime(x, n), vector(n-1, i, i)); \\ Amiram Eldar, Mar 26 2023
A074848
Number of 4-infinitary divisors of n.
Original entry on oeis.org
1, 2, 2, 3, 2, 4, 2, 4, 3, 4, 2, 6, 2, 4, 4, 2, 2, 6, 2, 6, 4, 4, 2, 8, 3, 4, 4, 6, 2, 8, 2, 4, 4, 4, 4, 9, 2, 4, 4, 8, 2, 8, 2, 6, 6, 4, 2, 4, 3, 6, 4, 6, 2, 8, 4, 8, 4, 4, 2, 12, 2, 4, 6, 6, 4, 8, 2, 6, 4, 8, 2, 12, 2, 4, 6, 6, 4, 8, 2, 4, 2, 4, 2, 12, 4, 4, 4, 8, 2, 12, 4, 6, 4, 4, 4, 8, 2, 6, 6, 9, 2, 8, 2, 8, 8
Offset: 1
2^4*3 is a 4-infinitary-divisor of 2^5*3^2 because 2^4*3 = 2^10*3^1 and 2^5*3^2 = 2^11*3^2 in 4-ary expanded power. All corresponding digits satisfy the condition. 1<=1, 0<=1, 1<=2.
-
A074848 := proc(n) if n= 1 then 1; else ifa := ifactors(n)[2] ; a := 1; for f in ifa do e := convert(op(2,f),base,4) ; a := a*mul(d+1,d=e) ; end do: end if; end proc:
seq(A074848(n),n=1..70) ; # R. J. Mathar, Feb 08 2011
-
f[p_, e_] := Times @@ (IntegerDigits[e, 4] + 1); a[1] = 1; a[n_] := Times @@ f @@@ FactorInteger[n]; Array[a, 100] (* Amiram Eldar, Sep 09 2020 *)
-
A268444(n) = { my(m=1, d); while(n, d = (n%4); m *= (1+d); n = (n-d)/4); m; };
A074848(n) = factorback(apply(e -> A268444(e), factorint(n)[, 2])) \\ (After A037445) - Antti Karttunen, May 28 2017
-
from math import prod
from sympy import factorint
from gmpy2 import digits
def A268444(n):
s = digits(n,4)
return prod((int(d)+1)**s.count(d) for d in '123')
def A074848(n): return prod(A268444(e) for e in factorint(n).values()) # Chai Wah Wu, Apr 24 2025
-
(definec (A074848 n) (if (= 1 n) n (* (A268444 (A067029 n)) (A074848 (A028234 n))))) ;; Antti Karttunen, May 28 2017
A126171
Number of infinitary amicable pairs (i,j) with i
Original entry on oeis.org
0, 0, 2, 6, 22, 62, 189, 444, 1116, 2594, 6051, 14141
Offset: 1
a(6)=62 because there are 62 infinitary amicable pairs (m,n) with m<n and m<=10^6
-
ExponentList[n_Integer, factors_List] := {#, IntegerExponent[n, # ]} & /@ factors; InfinitaryDivisors[1] := {1}; InfinitaryDivisors[n_Integer?Positive] := Module[ { factors = First /@ FactorInteger[n], d = Divisors[n] }, d[[Flatten[Position[ Transpose[ Thread[Function[{f, g}, BitOr[f, g] == g][ #, Last[ # ]]] & /@ Transpose[Last /@ ExponentList[ #, factors] & /@ d]], ?( And @@ # &), {1}]] ]] ] Null; properinfinitarydivisorsum[k] := Plus @@ InfinitaryDivisors[k] - k; InfinitaryAmicableNumberQ[k_] := If[Nest[properinfinitarydivisorsum, k, 2] == k && ! properinfinitarydivisorsum[k] == k, True, False]; data1 = Select[ Range[10^6], InfinitaryAmicableNumberQ[ # ] &]; data2 = properinfinitarydivisorsum[ # ] & /@ data1; data3 = Table[{data1[[k]], data2[[k]]}, {k, 1, Length[data1]}]; data4 = Select[data3, First[ # ] < Last[ # ] &]; Table[Length[Select[data4, First[ # ] < 10^k &]], {k, 1, 6}]
A126173
Larger element of a reduced infinitary amicable pair.
Original entry on oeis.org
2295, 75495, 817479, 1902215, 1341495, 1348935, 2226014, 2421704, 3123735, 3010215, 5644415, 4282215, 7509159, 10106504, 12900734, 24519159, 31356314, 41950359, 43321095, 80870615, 42125144, 85141719, 87689415, 87802407, 86477895, 105993657, 168669879, 129081735
Offset: 1
a(3)=817479 because 817479 is the largest member of the third reduced infinitary amicable pair, (573560,817479)
-
ExponentList[n_Integer, factors_List] := {#, IntegerExponent[n, # ]} & /@ factors; InfinitaryDivisors[1] := {1}; InfinitaryDivisors[n_Integer?Positive] := Module[ { factors = First /@ FactorInteger[n], d = Divisors[n] }, d[[Flatten[Position[ Transpose[ Thread[Function[{f, g}, BitOr[f, g] == g][ #, Last[ # ]]] & /@ Transpose[Last /@ ExponentList[ #, factors] & /@ d]], ?( And @@ # &), {1}]] ]] ] Null; properinfinitarydivisorsum[k] := Plus @@ InfinitaryDivisors[k] - k; ReducedInfinitaryAmicableNumberQ[n_] := If[properinfinitarydivisorsum[properinfinitarydivisorsum[ n] - 1] == n + 1 && n > 1, True, False]; ReducedInfinitaryAmicablePairList[k_] := (anlist = Select[Range[k], ReducedInfinitaryAmicableNumberQ[ # ] &]; prlist = Table[Sort[{anlist[[n]], properinfinitarydivisorsum[anlist[[n]]] - 1}], {n, 1, Length[anlist]}]; amprlist = Union[prlist, prlist]); data1 = ReducedInfinitaryAmicablePairList[10^7]; Table[Last[data1[[k]]], {k, 1, Length[data1]}]
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}]]; infs[n_] := Times @@ (fun @@@ FactorInteger[n]) - n; s = {}; Do[k = infs[n] - 1; If[k > n && infs[k] == n + 1, AppendTo[s, k]], {n, 2, 10^5}]; s (* Amiram Eldar, Jan 22 2019 *)
A126174
Smaller member of an augmented infinitary amicable pair.
Original entry on oeis.org
1252216, 1754536, 2166136, 2362360, 6224890, 7626136, 7851256, 9581320, 12480160, 12494856, 13324311, 15218560, 15422536, 19028296, 29180466, 36716680, 37542190, 40682824, 45131416, 45495352, 56523810, 67195305, 71570296, 80524665, 89740456, 93182440, 101304490
Offset: 1
a(3)=2166136 because 2166136 is the smaller element of the third augmented infinitary amicable pair, (2166136,2580105).
-
ExponentList[n_Integer, factors_List] := {#, IntegerExponent[n, # ]} & /@ factors; InfinitaryDivisors[1] := {1}; InfinitaryDivisors[n_Integer?Positive] := Module[ { factors = First /@ FactorInteger[n], d = Divisors[n] }, d[[Flatten[Position[ Transpose[ Thread[Function[{f, g}, BitOr[f, g] == g][ #, Last[ # ]]] & /@ Transpose[Last /@ ExponentList[ #, factors] & /@ d]], ?( And @@ # &), {1}]] ]] ] Null; properinfinitarydivisorsum[k] := Plus @@ InfinitaryDivisors[k] - k; AugmentedInfinitaryAmicableNumberQ[n_] := If[properinfinitarydivisorsum[properinfinitarydivisorsum[ n] + 1] == n - 1 && ! properinfinitarydivisorsum[n] + 1 == n, True, False]; AugmentedInfinitaryAmicablePairList[k_] := (anlist = Select[Range[k], AugmentedInfinitaryAmicableNumberQ[ # ] &]; prlist = Table[ Sort[{anlist[[n]], properinfinitarydivisorsum[anlist[[n]]] + 1}], {n, 1, Length[anlist]}]; amprlist = Union[prlist, prlist]); data = AugmentedInfinitaryAmicablePairList[10^7]; Table[First[data[[k]]], {k, 1, Length[data]}]
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}]]; infs[n_] := Times @@ (fun @@@ FactorInteger[n]) - n; s = {}; Do[k = infs[n] + 1; If[k > n && infs[k] == n - 1, AppendTo[s, n]], {n, 2, 10^9}]; s (* Amiram Eldar, Jan 20 2019 *)
A126175
Larger member of an augmented infinitary amicable pair.
Original entry on oeis.org
1483785, 2479065, 2580105, 4895241, 7336455, 9100905, 10350345, 16367481, 17307105, 24829945, 15706090, 27866241, 15439545, 23872185, 53763535, 63075321, 41337555, 60923577, 51394665, 56802249, 110691295, 73809496, 89870985, 82771336, 92586585, 150672921, 108212055
Offset: 1
a(3)=2580105 because 2580105 is the larger member of the third augmented infinitary amicable pair, (2166136,2580105).
-
ExponentList[n_Integer, factors_List] := {#, IntegerExponent[n, # ]} & /@ factors; InfinitaryDivisors[1] := {1}; InfinitaryDivisors[n_Integer?Positive] := Module[ { factors = First /@ FactorInteger[n], d = Divisors[n] }, d[[Flatten[Position[ Transpose[ Thread[Function[{f, g}, BitOr[f, g] == g][ #, Last[ # ]]] & /@ Transpose[Last /@ ExponentList[ #, factors] & /@ d]], ?( And @@ # &), {1}]] ]] ] Null; properinfinitarydivisorsum[k] := Plus @@ InfinitaryDivisors[k] - k; AugmentedInfinitaryAmicableNumberQ[n_] := If[properinfinitarydivisorsum[properinfinitarydivisorsum[ n] + 1] == n - 1 && ! properinfinitarydivisorsum[n] + 1 == n, True, False]; AugmentedInfinitaryAmicablePairList[k_] := (anlist = Select[Range[k], AugmentedInfinitaryAmicableNumberQ[ # ] &]; prlist = Table[ Sort[{anlist[[n]], properinfinitarydivisorsum[anlist[[n]]] + 1}], {n, 1, Length[anlist]}]; amprlist = Union[prlist, prlist]); data = AugmentedInfinitaryAmicablePairList[10^7]; Table[Last[data[[k]]], {k, 1, Length[data]}]
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}]]; infs[n_] := Times @@ (fun @@@ FactorInteger[n]) - n; s = {}; Do[k = infs[n] + 1; If[k > n && infs[k] == n - 1, AppendTo[s, k]], {n, 2, 10^9}]; s (* Amiram Eldar, Jan 20 2019 *)
A306736
Exponential infinitary highly composite numbers: where the number of exponential infinitary divisors (A307848) increases to record.
Original entry on oeis.org
1, 4, 36, 576, 14400, 705600, 57153600, 6915585600, 1168733966400, 337764116289600, 121932845980545600, 64502475523708622400, 40314047202317889000000, 33904113697149344649000000, 32581853262960520207689000000, 44604557116992952164326241000000, 74980260513665152588232411121000000
Offset: 1
-
di[1] = 1; di[n_] := Times @@ Flatten[2^DigitCount[#, 2, 1] & /@ FactorInteger[n][[All, 2]]]; fun[p_, e_] := di[e]; a[1] = 1; a[n_] := Times @@ (fun @@@ FactorInteger[n]); s = {}; am = 0; Do[a1 = a[n]; If[a1 > am, am = a1; AppendTo[s, n]], {n, 1, 10^6}]; s (* after Jean-François Alcover at A037445 *)
A331109
The number of dual-Zeckendorf-infinitary divisors of n = Product_{i} p(i)^r(i): divisors d = Product_{i} p(i)^s(i), such that the dual Zeckendorf expansion (A104326) of each s(i) contains only terms that are in the dual Zeckendorf expansion of r(i).
Original entry on oeis.org
1, 2, 2, 2, 2, 4, 2, 4, 2, 4, 2, 4, 2, 4, 4, 4, 2, 4, 2, 4, 4, 4, 2, 8, 2, 4, 4, 4, 2, 8, 2, 4, 4, 4, 4, 4, 2, 4, 4, 8, 2, 8, 2, 4, 4, 4, 2, 8, 2, 4, 4, 4, 2, 8, 4, 8, 4, 4, 2, 8, 2, 4, 4, 8, 4, 8, 2, 4, 4, 8, 2, 8, 2, 4, 4, 4, 4, 8, 2, 8, 4, 4, 2, 8, 4, 4, 4
Offset: 1
a(32) = 4 since 32 = 2^5 and the dual Zeckendorf expansion of 5 is 110, i.e., its dual Zeckendorf representation is a set with 2 terms: {2, 3}. There are 4 possible exponents of 2: 0, 2, 3 and 5, corresponding to the subsets {}, {2}, {3} and {2, 3}. Thus 32 has 4 dual-Zeckendorf-infinitary divisors: 2^0 = 1, 2^2 = 4, 2^3 = 8, and 2^5 = 32.
-
fibTerms[n_] := Module[{k = Ceiling[Log[GoldenRatio, n*Sqrt[5]]], t = n, fr = {}}, While[k > 1, If[t >= Fibonacci[k], AppendTo[fr, 1]; t = t - Fibonacci[k], AppendTo[fr, 0]]; k--]; fr];
dualZeck[n_] := Module[{v = fibTerms[n]}, nv = Length[v]; i = 1; While[i <= nv - 2, If[v[[i]] == 1 && v[[i + 1]] == 0 && v[[i + 2]] == 0, v[[i]] = 0; v[[i + 1]] = 1; v[[i + 2]] = 1; If[i > 2, i -= 3]]; i++]; i = Position[v, _?(# > 0 &)]; If[i == {}, 1, 2^Total[v[[i[[1, 1]] ;; -1]]]]];
f[p_, e_] := dualZeck[e]; a[1] = 1; a[n_] := Times @@ f @@@ FactorInteger[n]; Array[a, 100]
Previous
Showing 41-50 of 118 results.
Next
Comments