7
$\begingroup$

I am at a complete loss at this. I have a table with 2 columns and n lines. Some of the lines are repeated. What I want to do is add a new column that counts the number of repetitions of each line. Example

a={{1.1, 2.2},{1.1, 2.2}}

then I need something that will add a column {2,2} to the end of the table, resulting in

{{1.1, 2.2, 2},{1.1, 2.2, 2}}

Keeping in mind that I don't know in advance how many times a line will appear in the table. If it helps, the same line will always appear in subsequent positions Thanks

$\endgroup$
2
  • $\begingroup$ Ok, but how do I specify that the column to be inserted is the number of times that line is repeated in the table? $\endgroup$
    – bernie
    Commented Jun 10, 2014 at 18:19
  • 1
    $\begingroup$ Tally[a] // Map[Flatten] $\endgroup$ Commented Dec 19, 2014 at 15:27

14 Answers 14

12
$\begingroup$

Perhaps something like the following. Not very elegant but it should get the job done.

Generate some data for demonstration purposes...

SeedRandom[125];
data = Sort@RandomChoice[{1, 2}, {10, 3}]

Determine how many replicates there are.

reps = Join @@ Replace[Split[data], x_ :> ConstantArray[Length[x], Length[x]], {1}]

Join it all back together.

Transpose[Join[Transpose[data], {reps}]]

(*{{1, 1, 1, 1}, {1, 1, 2, 1}, {1, 2, 1, 2}, {1, 2, 1, 2}, {2, 1, 1, 
  1}, {2, 1, 2, 1}, {2, 2, 1, 1}, {2, 2, 2, 3}, {2, 2, 2, 3}, {2, 2, 
  2, 3}}*)
$\endgroup$
1
  • 3
    $\begingroup$ +1. This seems to be the fastest on my system for large arrays. $\endgroup$
    – RunnyKine
    Commented Jun 11, 2014 at 8:06
9
$\begingroup$
a = {{1.1, 2.2}, {1.1, 2.2}, {x, b}, {c, d}, {x, b}, {1, 2}}

# /. (Rule[First@#, Append @@ #] & /@ Tally[#]) &[a]

(*
{{1.1, 2.2, 2}, {1.1, 2.2, 2}, {x, b, 2}, {c, d, 1}, {x, b, 2}, {1, 2,1}}
*)

For huge lists:

# /. Dispatch[Rule[First@#, Append @@ #] & /@ Tally[#]] &[a];

Will speed things up nicely.

Also quite fast on large lists:

Partition[Flatten[Riffle[#, Join @@ ConstantArray @@@ Tally[#][[All, {2, 2}]]]], 3] &@a

Unlike the above (where order of elements does not matter), this takes advantage of the OP assumptions of same elements appearing in sequence.

Even faster on large arrays:

Block[{tmp = ArrayPad[#, {{0, 0}, {0, 1}}], t = Tally[#]},
       tmp[[All, 3]] = Join @@ ConstantArray @@@ t[[All, {2, 2}]];
       tmp] &[data]
$\endgroup$
3
  • $\begingroup$ +1 - would be even faster if one could use - somehow - Join instead of Append. $\endgroup$
    – eldo
    Commented Jun 10, 2014 at 22:34
  • $\begingroup$ These are clever, but in version 7 I'm not seeing the advantage over the more terse method I posted. e.g. given data = Join @@ RandomSample@Split@Sort@RandomInteger[500, {1000000, 2}]; both my code and your Block method take almost exactly two seconds on my machine. What kind of data are you using? -- Edit: in a fresh kernel yours is about 8 to 9 percent faster and both take a bit over one second. Still not worth the additional complexity in this particular test, IMHO. $\endgroup$
    – Mr.Wizard
    Commented Jun 11, 2014 at 7:12
  • 2
    $\begingroup$ @Mr.Wizard: I went for the "some of the lines are repeated" slant. So, using your generator above, with 200 distinct (all lines end up repeated), I see about the same timings, with 500 (most lines end up repeated) I see yours ~20% slower, with 1000 distinct (resulting in ~1/3 of the lines having repeats) yours times ~40% slower, and with 3000 (~5% have repeats) it's ~55% slower. Both are plenty fast (along with Andy's answer. The others seem to blow up time-wise with larger problems), just fiddled with it as an exercise... $\endgroup$
    – ciao
    Commented Jun 11, 2014 at 7:42
8
$\begingroup$

Transpose and Count might be your friend

SeedRandom[125];
data = Sort@RandomChoice[{1, 2}, {10, 2}]
counted = Count[data, #] & /@ data
Transpose@Append[Transpose@data, counted]

with sample data

{{1, 1}, {1, 1}, {1, 2}, {1, 2}, {1, 2}, {2, 1}, {2, 1}, {2, 2}, {2,
2}, {2, 2}}

output is (TableForm'd for clarity)

1   1   2
1   1   2
1   2   3
1   2   3
1   2   3
2   1   2
2   1   2
2   2   3
2   2   3
2   2   3

EDIT Timing-wise, this starts to get increasingly sluggish at ~4,000 records, so the approaches that use ..Array or Dispatch may be preferable.

$\endgroup$
7
$\begingroup$

Using Tally and rules:

SeedRandom[125];
data = Sort@RandomChoice[{1, 2}, {10, 2}];
data /. (Tally[data] /. {{a_, b_}, d_} :> ({a, b} -> {a, b, d})) // TableForm
(* Out:
1   1   2
1   1   2
1   2   3
1   2   3
1   2   3
2   1   2
2   1   2
2   2   3
2   2   3
2   2   3 *)

This is probably not very fast. On the upside it works even if the lines are not consecutive.

$\endgroup$
5
$\begingroup$

Variations on @AndyRoss's method (for sorted data):

appndCnts = Join @@
            (ConstantArray[Join[First@#, {Length@#}], Length@#] & /@ Split[#]) &;

appndCnts2 = Join @@ 
   (ConstantArray[
                 PadRight[First@#, 1 + Length@First@#, Length@#], Length[#]
                 ] & /@ Split[#]) &;

SeedRandom[125];
data = Sort@RandomChoice[{1, 2}, {10, 3}];

appndCnts@data 
(* {{1, 1, 1, 1},
    {1, 1, 2, 1},
    {1, 2, 1, 2}, {1, 2, 1, 2}, 
    {2, 1, 1, 1},
    {2, 1, 2, 1}, 
    {2, 2, 1, 1}, 
    {2, 2, 2, 3}, {2, 2, 2, 3}, {2, 2, 2, 3}}*)

appndCnts[data] == appndCnts2[data]
(* True *)
$\endgroup$
5
$\begingroup$

Yet another variation:

data = {{1, 2}, {0, 0}, {2, 0}, {0, 3}, {0, 3}, {3, 1}, {1, 3}, {1, 3}, {0, 1}, {0, 1}};

Join @@ (Append[##] ~ConstantArray~ #2 & @@@ Tally[data])
{{1, 2, 1}, {0, 0, 1}, {2, 0, 1}, {0, 3, 2}, {0, 3, 2},
 {3, 1, 1}, {1, 3, 2}, {1, 3, 2}, {0, 1, 2}, {0, 1, 2}}

A refactoring of Andy's fast method that a bit shorter and also a little faster on my machine:

With[{reps = ConstantArray[#, #] & /@ Length /@ Split[data]},
  Join[data\[Transpose], {Join @@ reps}]\[Transpose]
]

And a combination of Split and ArrayPad that is nearly as fast and shorter:

Join @@ (ArrayPad[#, {0, {0, 1}}, Length@#] & /@ Split[data])
$\endgroup$
3
$\begingroup$

Might as well join the fray.

list = RandomInteger[10, {100, 3}];
MapThread[Append, {list, list /. Rule @@@ Tally[list]}]
$\endgroup$
3
$\begingroup$

I'll just post this here as another option. This uses Reap and Sow.

rule = Dispatch[Reap[Sow[1, data], _, Rule[#1, Length@#2] &][[2]]];

Transpose @ Join[Transpose[data], {data /. rule}]

EDIT A relatively fast approach.

data = {{1, 2}, {0, 0}, {2, 0}, {0, 3}, {0, 3}, {3, 1}, {1, 3}, {1, 3}, {0, 1}, {0, 1}};

Transpose @ Join[Transpose[data], {data /. Dispatch[Rule @@@ Tally[data]]}]

{{1, 2, 1}, {0, 0, 1}, {2, 0, 1}, {0, 3, 2}, {0, 3, 2}, {3, 1, 1}, {1, 3, 2}, {1, 3, 2}, {0, 1, 2}, {0, 1, 2}}

$\endgroup$
3
$\begingroup$
SeedRandom[0];
list = Sort @ RandomChoice[{1, 2}, {10, 3}];

Using Splice (new in 13.1) and Counts (new in 10.0)

Replace[list, a_ :> {Splice @ a, a /. Counts @ list}, {1}]

{{1, 1, 1, 2}, {1, 1, 1, 2}, {1, 1, 2, 2}, {1, 1, 2, 2}, {1, 2, 1, 1}, {2, 1, 1, 2}, {2, 1, 1, 2}, {2, 1, 2, 1}, {2, 2, 1, 2}, {2, 2, 1, 2}}

$\endgroup$
3
$\begingroup$

Using the third argument of GroupBy and Repeated:

list = {{3, 2}, {0, 0}, {0, 0}, {2, 0}, {0, 3}, {0, 3}, {3, 1}, {1, 5}, {1, 5}};

f = Append @@@ Function[x, Transpose@{x, Array[Length@x &, Length@x]}]@# &;

Catenate@GroupBy[#, Repeated, f] &@list

(*{{3, 2, 1}, {0, 0, 2}, {0, 0, 2}, 
   {2, 0, 1}, {0, 3, 2}, {0, 3, 2}, 
   {3, 1, 1}, {1, 5, 2}, {1, 5, 2}}*)

Or using Counts:

Append @@@ Transpose@{#, # /. Counts[#]} &@list

(*{{3, 2, 1}, {0, 0, 2}, {0, 0, 2}, 
   {2, 0, 1}, {0, 3, 2}, {0, 3, 2}, 
   {3, 1, 1}, {1, 5, 2}, {1, 5, 2}}*)
$\endgroup$
3
$\begingroup$

Not sure if this counts as an independent solution, but here we go

SeedRandom[0];
list = Sort@RandomChoice[{1, 2}, {10, 3}];
Transpose[Insert[Transpose[list], list /. Counts[list], -1]]

{{1, 1, 1, 2}, {1, 1, 1, 2}, {1, 1, 2, 2}, {1, 1, 2, 2}, {1, 2, 1, 1}, {2, 1, 1, 2}, {2, 1, 1, 2}, {2, 1, 2, 1}, {2, 2, 1, 2}, {2, 2, 1, 2}}

$\endgroup$
3
$\begingroup$
lst={{1,1,1},{1,1,1},{1,1,1},{1,1,2},{1,2,1},{1,2,1},{2,2,1},
     {2,1,2},{2,1,2},{2,1,2},{2,1,2}}


MapThread[Prepend, {lst, lst/.Counts[lst]}]
(* {{3,1,1,1},{3,1,1,1},{3,1,1,1},
    {1,1,1,2},
    {2,1,2,1},{2,1,2,1},
    {1,2,2,1},
    {4,2,1,2},{4,2,1,2},{4,2,1,2},{4,2,1,2}
   } *)
$\endgroup$
2
$\begingroup$
SeedRandom[0];

list = Sort@ RandomChoice[{1, 2}, {10, 3}];

Using SequenceSplit (new in 11.3)

Flatten[
 Append[Length @ #] /@ # & /@
  SequenceSplit[list, a : {b_, b_} :> a],
 1]

{{1, 1, 1, 2}, {1, 1, 1, 2}, {1, 1, 2, 2}, {1, 1, 2, 2}, {1, 2, 1, 1}, {2, 1, 1, 2}, {2, 1, 1, 2}, {2, 1, 2, 1}, {2, 2, 1, 2}, {2, 2, 1, 2}}

$\endgroup$
1
$\begingroup$

Using Lookup:

SeedRandom[0];
data = Sort@RandomChoice[{1, 2}, {10, 3}]
lut = Rule @@@ Tally[data]

Append[#, Sequence @@ Lookup[lut, {#}]] & /@ data

{{1, 1, 1, 2}, {1, 1, 1, 2}, {1, 1, 2, 2}, {1, 1, 2, 2}, {1, 2, 1,
1}, {2, 1, 1, 2}, {2, 1, 1, 2}, {2, 1, 2, 1}, {2, 2, 1, 2}, {2, 2,
1, 2}}

$\endgroup$

Your Answer

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

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