4
$\begingroup$

I have the following code:

max = 4000; 
Clear[cnt]; 
cnt[_] = 0; 
Do[
    b = Binomial[n , k]; 
    If[b <= max, cnt[b] += 1], 
    {n, 0, max}, 
    {k, 1, n - 1}
]; 
sel = Select[
    Table[{b, cnt[b]}, {b, 1, max}], 
    #[[2]] >= 1 &
];
a[n_] := Select[
    sel, 
    #[[2]] >= n
][[1, 1]]; 
Quiet@Array[a, 10^3] /. {}[[1, 1]] -> Nothing

The code is finding the number of appearances that a number turns up in a certain list of numbers. Is there a way to speed up this calculation, because it takes a while.

$\endgroup$

1 Answer 1

5
$\begingroup$
ClearAll[groupedByCounts]

groupedByCounts[max_] := GroupBy[
    Tally[Join @@ Map[Select[# <= max &]]@
       Join[Table[Binomial[n, Range[n - 1]], {n, 0, Ceiling[(3 + Sqrt[1 + 8 max])/2]}], 
        ConstantArray[Range[1 + Ceiling[(3 + Sqrt[1 + 8 max])/2], max], 2]]], 
    Last -> First]

Examples:

groupedByCounts[100]
<|1 -> {2}, 
 2 -> {3, 4, 5, 7, 8, 9, 11, 12, 13, 14, 16, 17, 18, 19, 22, 23, 24, 
     25, 26, 27, 29, 30, 31, 32, 33, 34, 37, 38, 39, 40, 41, 42, 43, 44,
     46, 47, 48, 49, 50, 51, 52, 53, 54, 57, 58, 59, 60, 61, 62, 63, 
     64, 65, 67, 68, 69, 71, 72, 73, 74, 75, 76, 77, 79, 80, 81, 82, 83,
     85, 86, 87, 88, 89, 90, 92, 93, 94, 95, 96, 97, 98, 99, 100}, 
3 -> {6, 20, 70}, 
4 -> {10, 15, 21, 35, 28, 56, 36, 84, 45, 55, 66, 78, 91}|>
Short/ @ groupedByCounts[1000]

![enter image description here

groupedByCounts[4000] // AbsoluteTiming // First
 0.015644
Short /@ groupedByCounts[4000]

enter image description here

Keys @ groupedByCounts[4000]
{1, 2, 3, 4, 6, 8}
Length /@ groupedByCounts[4000]
<|1 -> 1, 2 -> 3871, 3 -> 6, 4 -> 117, 6 -> 3, 8 -> 1|>
Keys @ groupedByCounts[10^6]
{1, 2, 3, 4, 6, 8}
Length /@ groupedByCounts[10^6]
<|1 -> 1, 2 -> 998266, 3 -> 10, 4 -> 1715, 6 -> 6, 8 -> 1|>

You can define your function a using groupedByCounts[4000]:

ClearAll[a]
a[n_] := Join @@ KeySelect[# >= n &]@groupedByCounts[4000]

{#, a @ #} & /@ {3, 4, 5, 6} // Grid[#, Dividers -> All] &

enter image description here

$\endgroup$
7
  • $\begingroup$ Thanks for your answer. I made a little mistake in my question (I edited it now), but I need Binomial[n+2 , k+1] to be Binomial[n , k]. $\endgroup$ Oct 25, 2020 at 16:33
  • $\begingroup$ Can you help me with editing your code? $\endgroup$ Oct 25, 2020 at 16:44
  • $\begingroup$ @Jan, please see the updated version. $\endgroup$
    – kglr
    Oct 25, 2020 at 17:04
  • $\begingroup$ thank you very very much! When I tried to calculate groupByCounts[10^9] it takes again long, is there a way to speed your code and calculation up? Thank you again $\endgroup$ Oct 25, 2020 at 18:18
  • $\begingroup$ is there a way you know about to speed of up? $\endgroup$ Oct 25, 2020 at 19:48

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

Not the answer you're looking for? Browse other questions tagged or ask your own question.