A072701 - OEIS

%I #31 Feb 25 2023 06:04:10

%S 0,1,1,2,3,4,5,10,9,18,19,40,37,80,79,188,163,385,355,855,738,1815,

%T 1555,3796,3237,8281,6682,17207,13967,35370,28575,74385,58831,153816,

%U 119948,312288,244499,643535,495011,1309267,997381,2629257,2004295,5334522

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

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

%C a(n) < A066571(n).

%H Alois P. Heinz, <a href="/A072701/b072701.txt">Table of n, a(n) for n = 1..100</a>

%H Reinhard Zumkeller, <a href="/A072701/a072701.txt">Representing integers as arithmetic means of primes</a>

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

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

%p 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

%t 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 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_ *)

%t sp[i_] := sp[i] = If[i == 1, 2, sp[i - 1] + Prime[i]];

%t 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]];

%t 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];

%t Table[a[n], {n, 1, 44}] (* _Jean-François Alcover_, Feb 13 2018, after _Alois P. Heinz_ *)

%o (Haskell)

%o a072701 n = f a000040_list 1 n 0 where

%o    f (p:ps) l nl x

%o      | y > nl    = 0

%o      | y < nl    = f ps (l + 1) (nl + n) y + f ps l nl x

%o      | otherwise = if y `mod` l == 0 then 1 else 0

%o      where y = x + p

%o -- _Reinhard Zumkeller_, Feb 13 2013

%Y Cf. A072700, A072697, A072820, A072821.

%Y Cf. A066571, A163974.

%K nonn

%O 1,4

%A _Reinhard Zumkeller_, Jul 04 2002 and Jul 15 2002

%E Corrected by _John W. Layman_, Jul 11 2002

%E More terms from _Alois P. Heinz_, Jul 20 2009