A072701 Number of ways to write n as the arithmetic mean of a set of distinct primes.

0, 1, 1, 2, 3, 4, 5, 10, 9, 18, 19, 40, 37, 80, 79, 188, 163, 385, 355, 855, 738, 1815, 1555, 3796, 3237, 8281, 6682, 17207, 13967, 35370, 28575, 74385, 58831, 153816, 119948, 312288, 244499, 643535, 495011, 1309267, 997381, 2629257, 2004295, 5334522

Offset

1,4

Comments

a(n) = #{ m | A072700(m)=n }.

a(n) < A066571(n).

Links

Alois P. Heinz, Table of n, a(n) for n = 1..100

Reinhard Zumkeller, Representing integers as arithmetic means of primes

Example

a(6) = 4, as 6 = (5+7)/2 = (2+3+13)/3 = (2+5+11)/3 = (2+3+5+7+13)/5;
a(7) = 5, as 7 = 7/1 = (3+11)/2 = (3+5+13)/3 = (3+7+11)/3 = (3+5+7+13)/4.

Maple

sp:= proc(i) option remember; `if`(i=1, 2, sp(i-1) +ithprime(i)) end: b:= proc(n, i, t) if n<0 then 0 elif n=0 then `if`(t=0, 1, 0) elif i=2 then `if`(n=2 and t=1, 1, 0) else b(n, i, t):= b(n, prevprime(i), t) +b(n-i, prevprime(i), t-1) fi end: a:= proc(n) local s, k; s:= `if`(isprime(n), 1, 0); for k from 2 while sp(k)/k<=n do s:= s +b(k*n, nextprime(k*n -sp(k-1)-1), k) od; s end: seq(a(n), n=1..28);  # Alois P. Heinz, Jul 20 2009

Mathematica

Needs["DiscreteMath`Combinatorica`"]; a = Drop[ Sort[ Subsets[ Table[ Prime[i], {i, 1, 20}]]], 1]; b = {}; Do[c = Apply[Plus, a[[n]]]/Length[a[[n]]]; If[ IntegerQ[c], b = Append[b, c]], {n, 1, 2^20 - 1}]; b = Sort[b]; Table[ Count[b, n], {n, 1, 20}]
t = Table[0, {200}]; k = 2; lst = Prime@Range@25; While[k < 2^25+1, slst = Flatten@Subsets[lst, All, {k}]; If[Mod[Plus @@ slst, Length@slst] == 0, t[[(Plus @@ slst)/(Length@slst)]]++ ]; k++ ]; t (* Robert G. Wilson v *)
sp[i_] := sp[i] = If[i == 1, 2, sp[i - 1] + Prime[i]];
b[n_, i_, t_] := b[n, i, t] = Which[n < 0, 0, n == 0, If[t == 0, 1, 0], i == 2, If[n == 2 && t == 1, 1, 0], True, b[n, NextPrime[i, -1], t] + b[n - i, NextPrime[i, -1], t - 1]];
a[n_] := Module[{s, k}, s = If[PrimeQ[n], 1, 0]; For[k = 2, sp[k]/k <= n, k++, s = s + b[k*n, NextPrime[k*n - sp[k - 1] - 1], k]]; s];
Table[a[n], {n, 1, 44}] (* Jean-François Alcover, Feb 13 2018, after Alois P. Heinz *)

Prog

(Haskell)
a072701 n = f a000040_list 1 n 0 where
   f (p:ps) l nl x
     | y > nl    = 0
     | y < nl    = f ps (l + 1) (nl + n) y + f ps l nl x
     | otherwise = if y `mod` l == 0 then 1 else 0
     where y = x + p
-- Reinhard Zumkeller, Feb 13 2013

Crossrefs

Cf. A072700, A072697, A072820, A072821.

Cf. A066571, A163974.

Sequence in context: A161657 A338749 A370893 * A261039 A266117 A037473

Adjacent sequences: A072698 A072699 A072700 * A072702 A072703 A072704

Keyword

nonn

Author

Reinhard Zumkeller, Jul 04 2002 and Jul 15 2002

Extensions

Corrected by John W. Layman, Jul 11 2002

More terms from Alois P. Heinz, Jul 20 2009

Status

approved