How to construct a list of lengths efficiently

Question

Say I have a sorted list of integers

RandomInteger[{1, 100000}, 10000] // Sort // Short

I want to construct another list whose $m$-th element is the number of elements in the original list that are less than or equal to $m$:

Table[Length@Select[%, LessEqualThan[m]], {m, 10000}]

This is terribly inefficient, but for some reason I cannot come up with a better a approach. What's a better way to accomplish this? This seems to be a fairly standard exercise, so there should be plenty of duplicates, but I can find none. I am probably missing a key word...

Answer 1

You can use the usual UnitStep + Total tricks:

r1 = Table[Total[UnitStep[m-s]], {m,10000}]; //AbsoluteTiming

r2 = Table[Length@Select[s,LessEqualThan[m]],{m,10000}];//AbsoluteTiming

r1 === r2

{0.435358, Null}

{41.4357, Null}

True

Update

As @J42161217 points out, you can take advantage of the fact that the data is sorted to speed things up. He used Differences. Here is a version that uses Nearest instead:

mincounts[s_] := With[
    {
    unique = DeleteDuplicates@Nearest[s->"Element",s][[All,-1]],
    counts = Prepend[0] @ DeleteDuplicates@Nearest[s->"Index",s][[All,-1]]
    },
    With[{near = Nearest[unique->"Index", Range @ Length @ s][[All,1]]},
        counts[[1+near-UnitStep[unique[[near]]-Range@Length@s-1]]]
    ]
]

Comparison:

SeedRandom[1];
s=RandomInteger[{1,100000},10000]//Sort;

(* my first answer *)
r1 = Table[Total[UnitStep[m-s]], {m,10000}]; //AbsoluteTiming
(* J42161217's answer *)
r2 = Flatten[
    Join[
        {Table[0, s[[1]] - 1]}, 
        Table[Table[i, Differences[s][[i]]], {i, Length[Select[s, # <= 10000 &]]}]
    ]
][[;;10000]]; // AbsoluteTiming
(* using Nearest *)
r3 = mincounts[s]; //AbsoluteTiming

r1 === r2 === r3

{0.432897, Null}

{0.122198, Null}

{0.025923, Null}

True

Answer 2

BinCounts and Accumulate combination is faster than all the methods posted so far:

r4 = Accumulate @ BinCounts[s, {1, 1 + 10000, 1}]; // RepeatedTiming // First 

0.00069

versus Henrik Schumacher's mySparseArray, Carl Woll's mincounts and J42161217's Differences-based method:

r5 = Accumulate[mySparseArray[Partition[s, 1] -> 1, {s[[-1]]}, Total, 0][[
      1 ;; Length[s]]]
      ]; // RepeatedTiming // First

 0.00081

r3 = mincounts[s]; // RepeatedTiming // First

0.016

r2 = Flatten[Join[{Table[0, s[[1]] - 1]}, 
       Table[Table[i, Differences[s][[i]]], {i, 
             Length[Select[s, # <= 10000 &]]}]]][[;; 10000]]; // 
  RepeatedTiming // First 

0.149

r2 == r3 == r4 == r5

True

Answer 3

I think this is at least x3 faster than Mr. Carl Woll's answer
Can anybody compare my timing?

r3 = Flatten[Join[{Table[0, s[[1]] - 1]}, 
Table[Table[i, Differences[s][[i]]], {i, 
    Length[Select[s, # <= 10000 &]]}]]][[;;10000]]; // AbsoluteTiming   

{0.157123, Null}

Using MapThread the same code is way faster

r6 = Flatten[
 Join[{Table[0, s[[1]] - 1]}, 
  MapThread[
   Table, {Range[t = Length[Select[s, # <= 10000 &]]], 
    Differences[s][[1 ;; t]]}]]][[;; 10000]]; // AbsoluteTiming   

r6===r3    

{0.008387, Null}

True

Answer 4

s = Sort[RandomInteger[{1, 100000}, 10000]];

Let us just imagine for the moment that the target list r is supposed to have length 100000 (we can truncate it afterwards). Then for each entry i in the list s, the list r needs to have a jump of height 1 at position i. The jumps are the "derivative" of r (in a discrete sense) and the antiderivative can be obtained with Accumulate. In order to get the list of jumps, we need additive matrix assembly.

This can be done with this function:

mySparseArray[rules_, dims_, f_: Total, background_: 0.] := 
 If[(Head[rules] === Rule) && (rules[[1]] === {}),
  rules[[2]],
  With[{spopt = SystemOptions["SparseArrayOptions"]},
   Internal`WithLocalSettings[
    SetSystemOptions[
     "SparseArrayOptions" -> {"TreatRepeatedEntries" -> f}],
    SparseArray[rules, dims, background],
    SetSystemOptions[spopt]]
   ]
  ]

So, in total, r can be obtained as follows:

r4 = Accumulate[
 mySparseArray[Partition[s, 1] -> 1, {s[[-1]]}, Total, 0][[1 ;; Length[s]]]
 ]; // RepeatedTiming // First

0.00055

For comparison:

r3 = Flatten[
      Join[{Table[0, s[[1]] - 1]}, 
       Table[Table[i, Differences[s][[i]]], {i, 
         Length[Select[s, # <= 10000 &]]}]]][[;; 10000]]; // 
  RepeatedTiming // First
r3 == r4

0.116

True