A318360
Number of set multipartitions (multisets of sets) of a multiset whose multiplicities are the prime indices of n.
Original entry on oeis.org
1, 1, 1, 2, 1, 2, 1, 5, 3, 2, 1, 6, 1, 2, 3, 15, 1, 9, 1, 6, 3, 2, 1, 21, 4, 2, 16, 6, 1, 10, 1, 52, 3, 2, 4, 35, 1, 2, 3, 22, 1, 10, 1, 6, 19, 2, 1, 83, 5, 13, 3, 6, 1, 66, 4, 22, 3, 2, 1, 41, 1, 2, 20, 203, 4, 10, 1, 6, 3, 14, 1, 153, 1, 2, 26, 6, 5, 10, 1
Offset: 1
The a(12) = 6 set multipartitions of {1,1,2,3}:
{{1},{1,2,3}}
{{1,2},{1,3}}
{{1},{1},{2,3}}
{{1},{2},{1,3}}
{{1},{3},{1,2}}
{{1},{1},{2},{3}}
-
nrmptn[n_]:=Join@@MapIndexed[Table[#2[[1]],{#1}]&,If[n==1,{},Flatten[Cases[FactorInteger[n]//Reverse,{p_,k_}:>Table[PrimePi[p],{k}]]]]];
sqfacs[n_]:=If[n<=1,{{}},Join@@Table[Map[Prepend[#,d]&,Select[sqfacs[n/d],Min@@#>=d&]],{d,Select[Rest[Divisors[n]],SquareFreeQ]}]];
Table[Length[sqfacs[Times@@Prime/@nrmptn[n]]],{n,80}]
-
permcount(v) = {my(m=1,s=0,k=0,t); for(i=1,#v,t=v[i]; k=if(i>1&&t==v[i-1],k+1,1); m*=t*k;s+=t); s!/m}
sig(n)={my(f=factor(n)); concat(vector(#f~, i, vector(f[i,2], j, primepi(f[i,1]))))}
count(sig)={my(n=vecsum(sig), s=0); forpart(p=n, my(q=prod(i=1, #p, 1 + x^p[i] + O(x*x^n))); s+=prod(i=1, #sig, polcoef(q,sig[i]))*permcount(p)); s/n!}
a(n)={if(n==1, 1, my(s=sig(n)); if(#s<=2, if(#s==1, 1, min(s[1],s[2])+1), count(sig(n))))} \\ Andrew Howroyd, Dec 10 2018
A305936
Irregular triangle whose n-th row is the multiset spanning an initial interval of positive integers with multiplicities equal to the n-th row of A296150 (the prime indices of n in weakly decreasing order).
Original entry on oeis.org
1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 1, 2, 3, 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 2, 2, 1, 2, 3, 4, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 2, 3, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 2, 3, 1, 1, 1, 1, 2, 2, 1
Offset: 1
Row 90 is {1,1,1,2,2,3,3,4} because 90 = prime(3)*prime(2)*prime(2)*prime(1).
Triangle begins:
1:
2: 1
3: 1 1
4: 1 2
5: 1 1 1
6: 1 1 2
7: 1 1 1 1
8: 1 2 3
9: 1 1 2 2
10: 1 1 1 2
11: 1 1 1 1 1
12: 1 1 2 3
13: 1 1 1 1 1 1
Row lengths are
A056239. Number of distinct elements in row n is
A001222(n). Number of distinct multiplicities in row n is
A001221(n).
-
nrmptn[n_]:=Join@@MapIndexed[Table[#2[[1]],{#1}]&,If[n==1,{},Flatten[Cases[FactorInteger[n]//Reverse,{p_,k_}:>Table[PrimePi[p],{k}]]]]];
Array[nrmptn,30]
A318361
Number of strict set multipartitions (sets of sets) of a multiset whose multiplicities are the prime indices of n.
Original entry on oeis.org
1, 1, 0, 2, 0, 1, 0, 5, 1, 0, 0, 4, 0, 0, 0, 15, 0, 5, 0, 1, 0, 0, 0, 16, 0, 0, 8, 0, 0, 2, 0, 52, 0, 0, 0, 23, 0, 0, 0, 7, 0, 0, 0, 0, 5, 0, 0, 68, 0, 1, 0, 0, 0, 40, 0, 1, 0, 0, 0, 14, 0, 0, 1, 203, 0, 0, 0, 0, 0, 0, 0, 111, 0, 0, 4, 0, 0, 0, 0, 41, 80, 0, 0
Offset: 1
The a(24) = 16 sets of sets with multiset union {1,1,2,3,4}:
{{1},{1,2,3,4}}
{{1,2},{1,3,4}}
{{1,3},{1,2,4}}
{{1,4},{1,2,3}}
{{1},{2},{1,3,4}}
{{1},{3},{1,2,4}}
{{1},{4},{1,2,3}}
{{1},{1,2},{3,4}}
{{1},{1,3},{2,4}}
{{1},{1,4},{2,3}}
{{2},{1,3},{1,4}}
{{3},{1,2},{1,4}}
{{4},{1,2},{1,3}}
{{1},{2},{3},{1,4}}
{{1},{2},{4},{1,3}}
{{1},{3},{4},{1,2}}
-
nrmptn[n_]:=Join@@MapIndexed[Table[#2[[1]],{#1}]&,If[n==1,{},Flatten[Cases[FactorInteger[n]//Reverse,{p_,k_}:>Table[PrimePi[p],{k}]]]]];
sqfacs[n_]:=If[n<=1,{{}},Join@@Table[Map[Prepend[#,d]&,Select[sqfacs[n/d],Min@@#>d&]],{d,Select[Rest[Divisors[n]],SquareFreeQ]}]];
Table[Length[sqfacs[Times@@Prime/@nrmptn[n]]],{n,90}]
-
permcount(v) = {my(m=1, s=0, k=0, t); for(i=1, #v, t=v[i]; k=if(i>1&&t==v[i-1], k+1, 1); m*=t*k; s+=t); s!/m}
sig(n)={my(f=factor(n)); concat(vector(#f~, i, vector(f[i, 2], j, primepi(f[i, 1]))))}
count(sig)={my(r=0, A=O(x*x^vecmax(sig))); for(n=1, vecsum(sig)+1, my(s=0); forpart(p=n, my(q=prod(i=1, #p, 1 + x^p[i] + A)); s+=prod(i=1, #sig, polcoef(q, sig[i]))*(-1)^#p*permcount(p)); r+=(-1)^n*s/n!); r/2}
a(n)={if(n==1, 1, my(s=sig(n)); if(#s==1, s[1]==1, count(sig(n))))} \\ Andrew Howroyd, Dec 18 2018
A330972
Sorted list containing the least number with each possible nonzero number of factorizations into factors > 1.
Original entry on oeis.org
1, 4, 8, 12, 16, 24, 36, 48, 60, 72, 96, 120, 128, 144, 180, 192, 216, 240, 256, 288, 360, 384, 420, 432, 480, 576, 720, 768, 840, 864, 900, 960, 1024, 1080, 1152, 1260, 1440, 1680, 1728, 1800, 1920, 2048, 2160, 2304, 2520, 2592, 2880, 3072, 3360, 3456, 3600
Offset: 1
Factorizations of n for n = 4, 8, 12, 16, 24, 36, 48, 60:
4 8 12 16 24 36 48 60
2*2 2*4 2*6 2*8 3*8 4*9 6*8 2*30
2*2*2 3*4 4*4 4*6 6*6 2*24 3*20
2*2*3 2*2*4 2*12 2*18 3*16 4*15
2*2*2*2 2*2*6 3*12 4*12 5*12
2*3*4 2*2*9 2*3*8 6*10
2*2*2*3 2*3*6 2*4*6 2*5*6
3*3*4 3*4*4 3*4*5
2*2*3*3 2*2*12 2*2*15
2*2*2*6 2*3*10
2*2*3*4 2*2*3*5
2*2*2*2*3
Includes all highly factorable numbers
A033833.
The least number with n factorizations is
A330973(n).
Cf.
A001222,
A002033,
A007716,
A045778,
A318284,
A325238,
A330935,
A330936,
A330976,
A330977,
A330989,
A330991,
A330992.
-
nn=1000;
facs[n_]:=If[n<=1,{{}},Join@@Table[Map[Prepend[#,d]&,Select[facs[n/d],Min@@#>=d&]],{d,Rest[Divisors[n]]}]];
nds=Length/@Array[facs,nn];
Table[Position[nds,i][[1,1]],{i,First/@Gather[nds]}]
A045782
Number of factorizations of n for some n (image of A001055).
Original entry on oeis.org
1, 2, 3, 4, 5, 7, 9, 11, 12, 15, 16, 19, 21, 22, 26, 29, 30, 31, 36, 38, 42, 45, 47, 52, 56, 57, 64, 66, 67, 74, 77, 92, 97, 98, 101, 105, 109, 118, 135, 137, 139, 141, 162, 165, 171, 176, 181, 189, 195, 198, 203, 212, 231, 249, 250, 254, 257, 267, 269, 272, 289
Offset: 1
Factorizations are
A001055 with image this sequence and complement
A330976.
The least number with exactly a(n) factorizations is
A045783(n).
The least number with exactly n factorizations is
A330973(n).
Cf.
A002033,
A007716,
A033833,
A318284,
A325238,
A330935,
A330936,
A330977,
A330989,
A330991,
A330992,
A330997.
-
terms = 61; m0 = 10^5; dm = 10^4;
f[1, ] = 1; f[n, k_] := f[n, k] = Sum[f[n/d, d], {d, Select[Divisors[n], 1 < # <= k &]}];
Clear[seq]; seq[m_] := seq[m] = Sort[Tally[Table[f[n, n], {n, 1, m}]][[All, 1]]][[1 ;; terms]]; seq[m = m0]; seq[m += dm]; While[Print[m]; seq[m] != seq[m - dm], m += dm];
seq[m] (* Jean-François Alcover, Oct 04 2018 *)
A035310
Let f(n) = number of ways to factor n = A001055(n); a(n) = sum of f(k) over all terms k in A025487 that have n factors.
Original entry on oeis.org
1, 4, 12, 47, 170, 750, 3255, 16010, 81199, 448156, 2579626, 15913058, 102488024, 698976419, 4976098729, 37195337408, 289517846210, 2352125666883, 19841666995265, 173888579505200, 1577888354510786, 14820132616197925, 143746389756336173, 1438846957477988926
Offset: 1
a(3) = 12 because there are 3 terms in A025487 with 3 factors, namely 8, 12, 30; and f(8)=3, f(12)=4, f(30)=5 and 3+4+5 = 12.
From _Gus Wiseman_, Dec 31 2019: (Start)
The a(1) = 1 through a(3) = 12 multiset partitions of strongly normal multisets:
{{1}} {{1,1}} {{1,1,1}}
{{1,2}} {{1,1,2}}
{{1},{1}} {{1,2,3}}
{{1},{2}} {{1},{1,1}}
{{1},{1,2}}
{{1},{2,3}}
{{2},{1,1}}
{{2},{1,3}}
{{3},{1,2}}
{{1},{1},{1}}
{{1},{1},{2}}
{{1},{2},{3}}
(End)
Sequence
A035341 counts the ordered cases. Tables
A093936 and
A095705 distribute the values; e.g. 81199 = 30 + 536 + 3036 + 6181 + 10726 + 11913 + 14548 + 13082 + 21147.
The case with empty intersection is
A317755.
The case of strict parts is
A330783.
Multiset partitions of integer partitions are
A001970.
Unlabeled multiset partitions are
A007716.
-
with(numtheory):
g:= proc(n, k) option remember;
`if`(n>k, 0, 1) +`if`(isprime(n), 0,
add(`if`(d>k, 0, g(n/d, d)), d=divisors(n) minus {1, n}))
end:
b:= proc(n, i, l)
`if`(n=0, g(mul(ithprime(t)^l[t], t=1..nops(l))$2),
`if`(i<1, 0, add(b(n-i*j, i-1, [l[], i$j]), j=0..n/i)))
end:
a:= n-> b(n$2, []):
seq(a(n), n=1..10); # Alois P. Heinz, May 26 2013
-
g[n_, k_] := g[n, k] = If[n > k, 0, 1] + If[PrimeQ[n], 0, Sum[If[d > k, 0, g[n/d, d]], {d, Divisors[n] ~Complement~ {1, n}}]]; b[n_, i_, l_] := If[n == 0, g[p = Product[Prime[t]^l[[t]], {t, 1, Length[l]}], p], If[i < 1, 0, Sum[b[n - i*j, i-1, Join[l, Array[i&, j]]], {j, 0, n/i}]]]; a[n_] := b[n, n, {}]; Table[Print[an = a[n]]; an, {n, 1, 13}] (* Jean-François Alcover, Dec 12 2013, after Alois P. Heinz *)
-
EulerT(v)={Vec(exp(x*Ser(dirmul(v, vector(#v, n, 1/n))))-1, -#v)}
D(p, n)={my(v=vector(n)); for(i=1, #p, v[p[i]]++); my(u=EulerT(v)); Vec(1/prod(k=1, n, 1 - u[k]*x^k + O(x*x^n))-1, -n)/prod(i=1, #v, i^v[i]*v[i]!)}
seq(n)={my(s=0); forpart(p=n, s+=D(p,n)); s} \\ Andrew Howroyd, Dec 30 2020
-
from sympy.core.cache import cacheit
from sympy import divisors, isprime, prime
from operator import mul
@cacheit
def g(n, k):
return (0 if n > k else 1) + (0 if isprime(n) else sum(g(n//d, d) for d in divisors(n)[1:-1] if d <= k))
@cacheit
def b(n, i, l):
if n==0:
p = reduce(mul, (prime(t + 1)**l[t] for t in range(len(l))))
return g(p, p)
else:
return 0 if i<1 else sum([b(n - i*j, i - 1, l + [i]*j) for j in range(n//i + 1)])
def a(n):
return b(n, n, [])
for n in range(1, 11): print(a(n)) # Indranil Ghosh, Aug 19 2017, after Maple code
A045783
Least value with A045782(n) factorizations.
Original entry on oeis.org
1, 4, 8, 12, 16, 24, 36, 60, 48, 128, 72, 96, 120, 256, 180, 144, 192, 216, 420, 240, 1024, 384, 288, 360, 2048, 432, 480, 900, 768, 840, 576, 1260, 864, 720, 8192, 960, 1080, 1152, 4620, 1800, 3072, 1680, 1728, 1920, 1440, 32768, 2304, 2592, 6144
Offset: 1
From _Gus Wiseman_, Jan 11 2020: (Start)
Factorizations of n = 1, 4, 8, 12, 16, 24, 36, 60, 48:
{} 4 8 12 16 24 36 60 48
2*2 2*4 2*6 2*8 3*8 4*9 2*30 6*8
2*2*2 3*4 4*4 4*6 6*6 3*20 2*24
2*2*3 2*2*4 2*12 2*18 4*15 3*16
2*2*2*2 2*2*6 3*12 5*12 4*12
2*3*4 2*2*9 6*10 2*3*8
2*2*2*3 2*3*6 2*5*6 2*4*6
3*3*4 3*4*5 3*4*4
2*2*3*3 2*2*15 2*2*12
2*3*10 2*2*2*6
2*2*3*5 2*2*3*4
2*2*2*2*3
(End)
Includes all highly factorable numbers
A033833.
The least number with exactly n factorizations is
A330973(n).
A321912
Tetrangle where T(n,H(u),H(v)) is the coefficient of m(v) in e(u), where u and v are integer partitions of n, H is Heinz number, m is monomial symmetric functions, and e is elementary symmetric functions.
Original entry on oeis.org
1, 0, 1, 1, 2, 0, 0, 1, 0, 1, 3, 1, 3, 6, 0, 0, 0, 0, 1, 0, 1, 0, 2, 6, 0, 0, 0, 1, 4, 0, 2, 1, 5, 12, 1, 6, 4, 12, 24, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 5, 0, 0, 0, 1, 0, 3, 10, 0, 0, 1, 5, 2, 12, 30, 0, 0, 0, 2, 1, 7, 20, 0, 1, 3, 12, 7, 27, 60, 1, 5
Offset: 1
Tetrangle begins (zeroes not shown):
(1): 1
.
(2): 1
(11): 1 2
.
(3): 1
(21): 1 3
(111): 1 3 6
.
(4): 1
(22): 1 2 6
(31): 1 4
(211): 2 1 5 12
(1111): 1 6 4 12 24
.
(5): 1
(41): 1 5
(32): 1 3 10
(221): 1 5 2 12 30
(311): 2 1 7 20
(2111): 1 3 12 7 27 60
(11111): 1 5 10 30 20 60 20
For example, row 14 gives: e(32) = m(221) + 3m(2111) + 10m(11111).
This is a regrouping of the triangle
A321742.
Cf.
A005651,
A008480,
A056239,
A124794,
A124795,
A215366,
A318284,
A318360,
A319191,
A319193,
A321854,
A321738,
A321913-
A321935.
A317829
Number of set partitions of multiset {1, 2, 2, 3, 3, 3, ..., n X n}.
Original entry on oeis.org
1, 1, 4, 52, 2776, 695541, 927908528, 7303437156115, 371421772559819369, 132348505150329265211927, 355539706668772869353964510735, 7698296698535929906799439134946965681, 1428662247641961794158621629098030994429958386, 2405509035205023556420199819453960482395657232596725626
Offset: 0
For n = 2 we have a multiset {1, 2, 2} which can be partitioned as {{1}, {2}, {2}} or {{1, 2}, {2}} or {{1}, {2, 2}} or {{1, 2, 2}}, thus a(2) = 4.
A000142 counts submultisets of the same multiset.
A022915 counts permutations of the same multiset.
A006939 lists superprimorials or Chernoff numbers.
A076716 counts factorizations of factorials.
-
g:= proc(n, k) option remember; uses numtheory; `if`(n>k, 0, 1)+
`if`(isprime(n), 0, add(`if`(d>k or max(factorset(n/d))>d, 0,
g(n/d, d)), d=divisors(n) minus {1, n}))
end:
a:= n-> g(mul(ithprime(i)^i, i=1..n)$2):
seq(a(n), n=0..5); # Alois P. Heinz, Jul 26 2020
-
chern[n_]:=Product[Prime[i]^(n-i+1),{i,n}];
facs[n_]:=If[n<=1,{{}},Join@@Table[Map[Prepend[#,d]&,Select[facs[n/d],Min@@#>=d&]],{d,Rest[Divisors[n]]}]];
Table[Length[facs[chern[n]]],{n,3}] (* Gus Wiseman, Aug 21 2020 *)
-
\\ See A318284 for count.
a(n) = {if(n==0, 1, count(vector(n,i,i)))} \\ Andrew Howroyd, Aug 31 2020
A318286
Number of strict multiset partitions of a multiset whose multiplicities are the prime indices of n.
Original entry on oeis.org
1, 1, 1, 2, 2, 3, 2, 5, 5, 5, 3, 9, 4, 7, 9, 15, 5, 18, 6, 16, 14, 10, 8, 31, 17, 14, 40, 25, 10, 34, 12, 52, 21, 19, 27, 70, 15, 25, 31, 59, 18, 57, 22, 38, 80, 33, 27, 120, 46, 67, 44, 56, 32, 172, 42, 100, 61, 43, 38, 141, 46, 55, 143, 203, 64, 91, 54, 80
Offset: 1
-
nrmptn[n_]:=Join@@MapIndexed[Table[#2[[1]],{#1}]&,If[n==1,{},Flatten[Cases[FactorInteger[n]//Reverse,{p_,k_}:>Table[PrimePi[p],{k}]]]]];
strfacs[n_]:=If[n<=1,{{}},Join@@Table[Map[Prepend[#,d]&,Select[strfacs[n/d],Min@@#>d&]],{d,Rest[Divisors[n]]}]];
Table[Length[strfacs[Times@@Prime/@nrmptn[n]]],{n,60}]
-
permcount(v) = {my(m=1, s=0, k=0, t); for(i=1, #v, t=v[i]; k=if(i>1&&t==v[i-1], k+1, 1); m*=t*k; s+=t); s!/m}
sig(n)={my(f=factor(n)); concat(vector(#f~, i, vector(f[i, 2], j, primepi(f[i, 1]))))}
count(sig)={my(r=0, A=O(x*x^vecmax(sig))); for(n=1, vecsum(sig)+1, my(s=0); forpart(p=n, my(q=1/prod(i=1, #p, 1 - x^p[i] + A)); s+=prod(i=1, #sig, polcoef(q, sig[i]))*(-1)^#p*permcount(p)); r+=(-1)^n*s/n!); r/2}
a(n)={if(n==1, 1, count(sig(n)))} \\ Andrew Howroyd, Dec 18 2018
Showing 1-10 of 55 results.
Comments