10
$\begingroup$

I am trying to do a first order interpolation on a multidimensional data set containing duplicate abscissa values (which Mathematica does not like), like this one:

{{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}}

After playing around with DeleteDuplicates and Union I found that DeleteDuplicates does not work on multidimensional data, at least not when represented like above. I found that Union could delete the duplicates by using the SameTest-option, like this:

Union[{{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}}, SameTest -> (#1[[1]] == #2[[1]] &)]

which returns

{{{1, 2, 3}, 10}, {{1, 2, 4}, 30}}

However, it is very slow with larger data sets, which I have, so that is not an option.

What I really would like is a function that will make an average of the duplicates, so that

{{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}}

will turn into

{{{1, 2, 3}, 15}, {{1, 2, 4}, 30}}

I am by no means an expert in Mathematica programming, so I could really use some help.

The solution has to be reasonable fast. My data set is not sorted in any way but I guess it can be sorted quickly before the duplicates are combined if that is needed.

Thanks in advance :-)

$\endgroup$

marked as duplicate by Mr.Wizard Sep 29 '14 at 15:54

This question has been asked before and already has an answer. If those answers do not fully address your question, please ask a new question.

  • $\begingroup$ The first issue regarding SameTest has been addressed many times on this site; personally here at least: (17041), (21711), (28696), (30328). The second part, the actual question, I believe to be yet another duplicate of (4332) $\endgroup$ – Mr.Wizard Sep 29 '14 at 15:53
13
$\begingroup$

DeleteDuplicatesBy may be faster if used as follows:

DeleteDuplicatesBy[{{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}}, First]
{{{1, 2, 3}, 10}, {{1, 2, 4}, 30}}

For your second need:

lis = GatherBy[{{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}}, First];
mean = Mean /@ Map[Last, lis, {2}];

Then:

Transpose[{lis[[All, 1, 1]], mean}]
{{{1, 2, 3}, 15}, {{1, 2, 4}, 30}}

As a function:

delDupMean[data_] := With[{lis = GatherBy[data, First]},
  Transpose[{lis[[All, 1, 1]], Mean /@ Map[Last, lis, {2}]}]
 ]

Use:

delDupMean[{{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}}]
{{{1, 2, 3}, 15}, {{1, 2, 4}, 30}}
$\endgroup$
6
$\begingroup$
lst = {{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}};

DeleteDuplicates[lst, First@#1 == First@#2 &]
(* {{{1,2,3},10},{{1,2,4},30}} *)

First /@ GatherBy[lst, First]
(* {{{1,2,3},10},{{1,2,4},30}} *)

{#[[1, 1]], Mean[#[[All, 2]]]} & /@ GatherBy[lst, First]
(* or {#[[1, 1]], Mean[#[[All, 2]]]} & /@Gather[lst, First@#1 == First@#2 &]  *)
(* {{{1,2,3},15},{{1,2,4},30}} *)
$\endgroup$
2
$\begingroup$

Just an approach with Reap and Sow. Probably not be efficient.

data = {{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}};
Last@Reap[Sow[#2, w[#1]] & @@@data, _, {ReplacePart[#1, 0 -> Identity], Mean@#2} &]

yields:

(*{{{1, 2, 3}, 15}, {{1, 2, 4}, 30}}*)
$\endgroup$
2
$\begingroup$
lis = GatherBy[{{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}}, First];

Plus @@@ lis/Length /@ lis

Plus @@ #/Length@# & /@ lis

Plus[##]/Length@{##} & @@@ lis

(*{{{1, 2, 3}, 15}, {{1, 2, 4}, 30}}*)
$\endgroup$
1
$\begingroup$
list = {{{1, 2, 3}, 10}, {{1, 2, 3}, 20}, {{1, 2, 4}, 30}};

result = GroupBy[list, First -> Last, Mean]

enter image description here

Normal @ result /. Rule -> List

enter image description here

OR

Thread[{Keys @ #, Mean /@ Values @ #}] &[GroupBy[list, First -> Last]]

enter image description here

$\endgroup$

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