7
$\begingroup$

Suppose I have the following data:

headers = {"Col A", "Col B", "Col C", "Col D", "Col E"};
list = {{"1", "2", "a", "4", "5"}, {"1", "2", "b", "4", "5"}, {"2", "1", "t", "6", "7"}, {"2", 
    "1", "a", "6", "7"}, {"2", "3", "t", "7", "7"}, {"2", "1", "z", "6", "7"}, {"3", "5", "a", 
    "5", "7"}};

I'm interested in returning (and subsequently replacing) partial matches in the dataset where only the value of "Col C" is different.

I would therefore like the list of partial matches:

partialMatches = {{"1", "2", "a", "4", "5"}, {"1", "2", "b", "4", "5"}, 
{"2", "1", "t", "6","7"}, {"2", "1", "z", "6", "7"}};

And to retain only the element for which "Col C" is alphabetically the last (i.e. "z" beats "a"), my output would therefore be:

cleanedData = {{"1", "2", "b", "4", "5"}, {"2", "3", "t", "7", 
"7"}, {"3", "5", "a", "5", "7"}, {"2", "1", "z", "6", "7"}};

Notes

  • I can guarantee in my data that "Col C" values are unique, i.e. you will not have {..., {"1", "2", "b", "4", "5"}, {"1", "2", "b", "4", "5"},...}

  • My actual data has 11,000+ rows and the columns all contain long strings, I need a solution that handles this larger a dataset but don't mind having an extra cup of coffee while it chugs along.

  • Elements may be unique by only one element in the other columns, additional example:

    list2 = {{"1", "2", "a", "4", "5"}, {"1", "2", "b", "4", "5"}, {"2", 
        "1", "t", "6", "7"}, {"2", "1", "a", "6", "7"}, {"2", "3", "t", 
        "7", "7"}, {"2", "1", "z", "6", "7"}, {"3", "5", "a", "5", 
        "7"}, {"New", "5", "a", "5", "7"}, {"New", "5", "z", "5", "7"}};
    cleaned2 = {{"2", "3", "t", "7", "7"}, {"2", "1", "z", "6", "7"}, {"3", "5", "a","5", "7"}, {"New", "5", "z", "5", "7"}, {"1", "2", "b", "4", "5"}}
    
  • The order of the unique terms does not matter.

  • I'm most interested in learning different solutions to this problem

$\endgroup$
  • $\begingroup$ If you're using a 10+ version of Mathematica look at "Dataset". $\endgroup$ – Ymareth Sep 18 '15 at 15:05
  • $\begingroup$ @Ymareth I'd happily use Dataset, most of the time I get annoyed with it and just use a list of associations instead. $\endgroup$ – Martin John Hadley Sep 18 '15 at 16:02
  • 1
    $\begingroup$ @MartinJohnHadley I'm confused by your cleanedData. Why does it contain both {"2", "1", "a", "6", "7"} and {"2", "1", "z", "6", "7"}? Shouldn't those two be considered duplicates, and only the latter be retained? $\endgroup$ – MarcoB Sep 18 '15 at 16:10
  • $\begingroup$ @MarcoB sorry about that, I wrote that by eye as it was before I'd coded up an acceptable solution myself - editing question now $\endgroup$ – Martin John Hadley Sep 18 '15 at 16:11
  • $\begingroup$ @MartinJohnHadley OK then I think I might have something for you. See my answer below. $\endgroup$ – MarcoB Sep 18 '15 at 16:15
8
$\begingroup$

Here is a way to do what you want. However, this method does not retain the original ordering of the elements in your list. You did not mention whether that was important, so I hope it won't be:

Reverse@SortBy[list, #[[3]] &];
DeleteDuplicatesBy[%, Drop[#, {3}] &]

(* Out: 
        {{"2", "1", "z", "6", "7"}, 
         {"2", "3", "t", "7", "7"}, 
         {"1", "2", "b", "4", "5"}, 
         {"3", "5", "a", "5", "7"}} 
*)

Here are timing results on your sampleData dataset:

SeedRandom[1111987];
sampleData = Table[FromCharacterCode /@ RandomInteger[{97, 109}, 5], {10000}];

RepeatedTiming[
 DeleteDuplicatesBy[Reverse@SortBy[sampleData, #[[3]] &], Drop[#, {3}] &];
]

(* Out: {0.031, Null} *)
$\endgroup$
  • $\begingroup$ Thanks for this, unfortunately it treats {{"3", "5", "a", "5", "7"}, {"New", "5", "a", "5", "7"}} as identical. I hadn't put my that in my original question, though $\endgroup$ – Martin John Hadley Sep 18 '15 at 19:13
  • 1
    $\begingroup$ @Martin, It should work properly by changing Drop[#, 3] to Drop[#, {3}]. (I guess it was just a typo.) $\endgroup$ – user31159 Sep 18 '15 at 19:27
  • $\begingroup$ Thanks Marco! Hope the back and forward is worth the accept :) $\endgroup$ – Martin John Hadley Sep 18 '15 at 19:44
  • $\begingroup$ @Xavier Indeed a set of curly braces had gone missing when I was editing the code to post it; I fixed that now. Thank you for pointing that out! $\endgroup$ – MarcoB Sep 18 '15 at 19:49
3
$\begingroup$

My take:

fn[list_, col_] := Module[{cr = Drop[Range@Length@list[[1]], {col}]},
   Split[list[[Ordering[list[[All, Append[cr, col]]]]]],
         SameQ[#1[[cr]], #2[[cr]]] &][[All, -1]]];

Second argument is the column that is "special" (3 in the OP example case).

This appears to be vastly more efficient than answers so far.

I generated data with

base = Table[FromCharacterCode /@ RandomInteger[{97, 109}, {5, 10}], {6000}];
testdata = 
  RandomSample@
   Flatten[Join[{#}, Table[ReplacePart[#, 3 -> 
                        (FromCharacterCode@RandomInteger[{97, 109}, 10])], 
                      {RandomInteger[{0, 2}]}]] & /@ base, 1];

This creates some base data of 5 colums of 10 char. strings (size of these had minimal effect on the tests, so I kept them small for checking data/results), then augments it with a random number of duplicates for each (from 0 to 2 in this case). The result is disordered by RandomSample. It creates these with the proper distinct "special" columns as specified in the OP, something the sampleData generator most assuredly does not do (not even close). There is a minuscule probability of a duplicate "special" with my generator, but it's so small I don't bother checking.

I then benchmarked using the data, taking successively larger chunks (usual loungebook timing caveats apply - expect 5-10X or better improvement for all on real hardware):

enter image description here

N.b: Since I no longer run V10.x, I used DeleteDuplicates[..., (Drop[#1, {3}] == Drop[#2, {3}]) &] in the code for the accepted answer since V9.x does not have DeleteDuplicatesBy. Nonetheless, I'm comfortable that it performs similarly, if not better, than the intrinsic based on the disastrously poor performance of DeleteDuplicatesBy I witnessed in my 10,x testing. Even if it's been improved in 10.2, the performance delta is so large here I doubt a material difference, it was faster on the loungebook than the accepted answer on assuredly faster hardware, but invite someone using 10.x to replicate the tests.

Edit: I'm not so sure the method I used to duplicate DeleteDuplicatesBy is optimal - in fact, I'm sure it's not, so take the result involving that with a grain of salt. Perhaps OP can test - would be nice to see that DeleteDuplcatesBy performance issues were fixed...

In any case, I probably over-thought this

GatherBy[sampleData[[Ordering[sampleData[[All, 3]]]]], #[[{1, 2, 4, 5}]] &][[All, -1]]

produces the same result as my code with better speed...

$\endgroup$
2
$\begingroup$

I'm posting what I have built as an answer, but feel there are inefficiencies so would like to see (and accept) other's solutions.

  • Find all unique elements (after dropping Col C):
  • Make an empty list, cleanedOutput.
  • Get the Col C values for each unique value, Sort and assign the Last element to colC.
  • Finds the Cases of each unique element and replace the 3rd element with colC:

uniqueFn[data_] := 
  Module[{
    uniques = GatherBy[data[[All, {1, 2, 4, 5}]]][[All, 1]],
    cleanedOutput = {}},
    With[{colC = Last @ Sort[Cases[data, Insert[#, a_, 3] :> a]]},
      AppendTo[
        cleanedOutput, 
        First @ Cases[data, Insert[#, a_, 3] :> Insert[#, colC, 3]]]]& 
      /@ 
        uniques;
      cleanedOutput]

Map function across all unique values:

uniqueFn[list]
{{1, 2, "b", 4, 5}, {2, 1, "z", 6, 7}, {2, 3, "t", 7, 7}, {3, 5, "a", 5, 7}}
uniqueFn[list2]
{{"1", "2", "b", "4", "5"}, {"2", "1", "z", "6", "7"}, {"2", "3", "t","7", "7"}, 
 {"3", "5", "a", "5", "7"}, {"New", "5", "z", "5", "7"}}

Timings

To compare solutions, I propose the following sample data:

SeedRandom[1111987];
sampleData = 
  Table[FromCharacterCode /@ RandomInteger[{97, 109}, 5], {10000}];

Timing:

AbsoluteTiming[uniqueFn[sampleData];]
(*{23.6261, Null}*)
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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