Position in the list after a using a function

Question

I want to generate a list after using a function. In this list the original position is important.

listA = {{1, 1}, {2, 2}, {3, 1}, {4, 2}, {5, 3}, {6, 1}, {7, 2},
         {8, 7}, {9, 6}, {10, 5}};

The position is the first row (or field in each record). The position can be a number or a dataobject.

In this example I use the function BinList.

BinLists[listA[[All, 2]], 1]

which gives the output:

{{}, {1, 1, 1}, {2, 2, 2}, {3}, {}, {5}, {6}, {7}}

The desired output is:

{{{},0}, {{{1, 1},1}, {{3, 1},1},{{6, 1}},1}, {{{2, 2},2},{{4, 2},2},{{7, 2}},2},{ {5,3},3}, {{},4}, {{10, 5},5}, {{9, 6},6},{{8, 7},7}}

In the desired output I know the Bin-class and the original position. So the combination '{6,1}' belongs to de 1-class en is the 6 position of the original list.

Answer 1

Adding {3, 1.1} to test for realistic data.

listA = {{1, 1}, {2, 2}, {3, 1.1}, {4, 2}, {5, 3}, {6, 1},
   {7, 2}, {8, 7}, {9, 6}, {10, 5}};

u = BinLists[listA[[All, 2]], 1]

{{}, {1, 1.1, 1}, {2, 2, 2}, {3}, {}, {5}, {6}, {7}}

out = Module[{z = listA, t = {}, s = 0, w, y},
 Function[v, w = {};
   (y = FirstCase[z, {_, #}];
      z = DeleteCases[z, y];
      AppendTo[w, {y, s}]) & /@ v;
   AppendTo[t, w /. {} -> {{}, s}];
   s++] /@ u;
 t /. {{{a_, b_}, c_}} :> {{a, b}, c}]

{{{}, 0}, {{{1, 1}, 1}, {{3, 1.1}, 1}, {{6, 1}, 1}}, {{{2, 2}, 2}, {{4, 2}, 2}, {{7, 2}, 2}}, {{5, 3}, 3}, {{}, 4}, {{10, 5}, 5}, {{9, 6}, 6}, {{8, 7}, 7}}

Answer 2

This gives the desired output, but I'm not sure how the "xbins" argument should be chosen because ∞ doesn't work.

Replace[MapIndexed[{#, First[#2] - 1} &, #, {2}], {a_} -> a, {1}] &[
   First[BinLists[listA, 123123123, 1] /. {} -> {{}}]]

Answer 3

Using GroupBy:

KeyValueMap[Function[{k, v}, {#, k} & /@ v], GroupBy[listA, Round@*Last]]
(* {{{{1, 1}, 1}, {{3, 1.1}, 1}, {{6, 1}, 1}}, {{{2, 2}, 2}, {{4, 2}, 2}, {{7, 2}, 2}}, {{{5, 3}, 3}}, {{{8, 7}, 7}}, {{{9, 6}, 6}}, {{{10, 5}, 5}}} *)

(Using the modified list from @ChrisDegnen). This solution omits empty bins, let me know if you need them.

Timing wise: Using listA = Table[{i, RandomInteger[100]}, {i, 10000}]; & RepeatedTiming:

• This solution: 0.02
• @ChrisDegnen's solution: 8.0
• @Coolwater's solution: 0.035

Answer 4

Update: Using BinLists as the third argument of HistogramList to get both bin limits and the contents of each bin and organizing the results:

ClearAll[binListsAndLims, binListsAndLimsByCol, oneBin]
oneBin = Floor[Max[#] + #2, #2] - Ceiling[Min[#] - #2, #2]  + 2 #2 &;

binListsAndLims[d_, bspec_] := Module[{b = ReplacePart[{oneBin[#, 1]} & /@ Transpose[d],
     (-1) -> bspec]},
 Thread /@ (Transpose[{#2[[## &@@ConstantArray[1, Length[b] - 1]]], Most[#[[-1]]]}] & @@ 
   HistogramList[d, b, BinLists[d, ## & @@ Function[t, {#[[t]]}] /@ Range[Length@b]] &] /.
      {} -> {{}})]

binListsAndLimsByCol[d_, bspec_, col_] := Module[{r = Length[d[[1]]] - col}, 
  If[col == Length[d[[1]]], binListsAndLims[d, bspec], 
   Replace[binListsAndLims[RotateRight[#, r] & /@ d, 
     bspec], {a_List, b_} :> {RotateLeft[a, r], b}, {0, Infinity}]]]

Examples:

binListsAndLimsByCol[listA, {1}, 2]

{{{{}, 0}},
{{{1, 1}, 1}, {{3, 1}, 1}, {{6, 1}, 1}},
{{{2, 2}, 2}, {{4, 2}, 2}, {{7, 2}, 2}},
{{{5, 3}, 3}},
{{{}, 4}},
{{{10, 5}, 5}},
{{{9, 6}, 6}},
{{{8, 7}, 7}}}

Use a different bin spec:

binListsAndLimsByCol[listA, {.5}, 2]

{{{{}, 0.5}}, {{{1, 1}, 1.}, {{3, 1}, 1.}, {{6, 1}, 1.}}, {{{}, 1.5}}, {{{2, 2}, 2.}, {{4, 2}, 2.}, {{7, 2}, 2.}}, {{{}, 2.5}}, {{{5, 3}, 3.}}, {{{}, 3.5}}, {{{}, 4.}}, {{{}, 4.5}}, {{{10, 5}, 5.}}, {{{}, 5.5}}, {{{9, 6}, 6.}}, {{{}, 6.5}}, {{{8, 7}, 7.}}}

Bin by column 1:

binListsAndLimsByCol[listA, {1}, 1]

{{{{}, 0}}, {{{1, 1}, 1}}, {{{2, 2}, 2}}, {{{3, 1}, 3}}, {{{4, 2}, 4}}, {{{5, 3}, 5}}, {{{6, 1}, 6}}, {{{7, 2}, 7}}, {{{8, 7}, 8}}, {{{9, 6}, 9}}, {{{10, 5}, 10}}}

With more than 2 columns:

SeedRandom[12345]
dd = RandomInteger[{1, 9}, {20, 4}];
binListsAndLimsByCol[dd, {1}, 2]

{{{{}, 0}}, {{{2, 1, 9, 2}, 1}, {{4, 1, 3, 7}, 1}, {{2, 1, 1, 7}, 1}}, {{{6, 2, 4, 2}, 2}}, {{{8, 3, 8, 9}, 3}, {{7, 3, 8, 7}, 3}, {{6, 3, 7, 8}, 3}, {{7, 3, 5, 2}, 3}}, {{{9, 4, 4, 8}, 4}, {{3, 4, 4, 9}, 4}}, {{{6, 5, 8, 6}, 5}, {{2, 5, 6, 1}, 5}, {{9, 5, 6, 7}, 5}}, {{{}, 6}}, {{{8, 7, 9, 6}, 7}, {{2, 7, 5, 9}, 7}}, {{{4, 8, 4, 7}, 8}, {{8, 8, 3, 9}, 8}, {{9, 8, 9, 7}, 8}}, {{{7, 9, 7, 2}, 9}, {{4, 9, 4, 5}, 9}}}

Original answer:

Table[Thread[{Pick[#, #[[All, 2]], i] /. {} -> {{}}, i}], {i, 0, Max[#[[All, 2]]]}]&@listA

{{{}, 0}, {{{1, 1}, 1}, {{3, 1}, 1}, {{6, 1}, 1}}, {{{2, 2}, 2}, {{4, 2}, 2}, {{7, 2}, 2}}, {{{5, 3}, 3}}, {{}, 4}, {{{10, 5}, 5}}, {{{9, 6}, 6}}, {{{8, 7}, 7}}}

If you have to use BinLists as input:

bl = MapIndexed[If[# == {} , #2[[1]] - 1, #]&, BinLists[listA[[All, 2]], 1]] 
pick = Pick[listA, listA[[All, 2]], #] & /@ Range[0, Max[listA[[All, 2]]]]
thread = If[Head[#[[2]]] === List, Thread @ #, #]&;
thread /@ Transpose @ {pick, bl} 

same result