How can I remove matching sublists from my list?

Question

I want to use DeleteCases (or any appropriate function) to remove elements of a list, which in turn are lists of fixed size. The rule I wish to apply is that any element of the list which already appear elsewhere in the list, up to any number of -1 is to be removed. But I don't know how to do this kind of tricky pattern matching. For example, I have the following list:

myData = {{h -> 255.155, c -> 0, s -> -10000.},
 {h -> -255.155, c -> 0, s -> 10000.}, 
 {h -> 0, c -> 0, s -> 10000.},
 {h -> 0, c -> 0, s -> -10000.}, 
 {h -> 255.155, c -> 0, s -> 10000.},
 {h -> -255.155, c -> 0, s -> -10000.},
 {h -> -255.155, c -> 1870.83, s -> 3535.53},
 {h -> 255.155, c -> -1870.83, s -> -3535.53},
 {h -> 0, c -> 1870.83, s -> 3535.53}, 
 {h -> 0, c -> -1870.83, s -> -3535.53},
 {h -> 255.155, c -> 1870.83, s -> 3535.53},
 {h -> -255.155, c -> -1870.83, s -> -3535.53},
 {h -> 255.155, c -> -4000., s -> 0},
 {h -> -255.155, c -> 4000., s -> 0},
 {h -> 0, c -> 4000., s -> 0}, 
 {h -> 0, c -> -4000., s -> 0},
 {h -> 255.155, c -> 4000., s -> 0},
 {h -> -255.155, c -> -4000., s -> 0}, 
 {h -> 255.155, c -> 1870.83, s -> -3535.53},
 {h -> -255.155, c -> -1870.83, s -> 3535.53}, 
 {h -> 0, c -> 1870.83, s -> -3535.53},
 {h -> 0, c -> -1870.83, s -> 3535.53},
 {h -> 255.155, c -> -1870.83, s -> 3535.53}, 
 {h -> -255.155, c -> 1870.83, s -> -3535.53},
 {h -> 255.155, c -> 0, s -> 0}, 
 {h -> -255.155, c -> 0, s -> 0},
 {h -> 0, c -> 0, s -> 0}}

As can be seen the first element myData[[1]] (which is a list of three items) is a duplicate (up to the minus signs) myData[[2]] myData[[5]] myData[[6]]. But I don't know how to get Mathematica to remove these.

As an added bonus, it would be nice that, among the ones that are duplicates up to -1, the one with the least number of negatives is kept, and all others are removed. (In the example above, myData[[5]] would be among those that would be kept.)

Answer 1

The problem with both Union - based and DeleteDuplicates - based solutions is that both functions have quadratic complexity in the size of the list, for an explicit comparison function. Here is code which should be much faster for larger lists:

Reap[
  Sow[#, Abs[{{h, c, s} /. #}]] & /@ myData, 
  _, 
  First@#2[[Ordering[UnitStep[-{h, c, s} /. #2]]]] &
][[2]]

(*
  {{h->255.155,c->0,s->10000.},{h->0,c->0,s->10000.},
  {h->255.155,c->1870.83,s->3535.53},{h->0,c->1870.83,s->3535.53},
  {h->255.155,c->4000.,s->0},{h->0,c->4000.,s->0},
  {h->255.155,c->0,s->0},{h->0,c->0,s->0}}
*)

It is based on tagging the list entries with some function of the entry that serves as an equivalence tag, and then postprocessing the resulting lists. It should have a near-linear complexity with respect to the length of the list.

Answer 2

If I have understood what you want, here is one approach:

DeleteDuplicates[myData, Abs@#1[[All, 2]] == Abs@#2[[All, 2]] &]

I get:

Here you don't have the order problem.

Answer 3

Here's my solution:

classes = GatherBy[myData, Abs[{h, c, s} /. #] &]
classes[[All, 1]]

To get the ones with the least number of negatives,

MaxBy[list_, fun_] := list[[First@Ordering[fun /@ list, -1]]]
MaxBy[#, Total[Sign /@ ({h, c, s} /. #)] &] & /@ classes

(I use this MaxBy function often, so I tend to think of solutions in terms of it.)

Answer 4

This does the first part of the job

Union[myData, SameTest -> (Abs[#1[[All, 2]]] == Abs[#2[[All, 2]]] &)]

I am looking into the ordering. Unfortunately Mathematica built-in sorting is from the smaller number to the greatest.

Answer 5

You can use DeleteDuplicates. Here is a version that explicitly uses the variable names h, c, s. Therefore the rules will be considered duplicates even if the ordering is different.

DeleteDuplicates[myData, SameQ @@ (Abs@{h, c, s} /. {#1, #2}) &]

{{h -> 255.155, c -> 0, s -> -10000.}, {h -> 0, c -> 0, s -> 10000.}, {h -> -255.155, c -> 1870.83, s -> 3535.53}, {h -> 0, c -> 1870.83, s -> 3535.53}, {h -> 255.155, c -> -4000., s -> 0}, {h -> 0, c -> 4000., s -> 0}, {h -> 255.155, c -> 0, s -> 0}, {h -> 0, c -> 0, s -> 0}}

To keep only the results you want you can Sort the list first, and then Reverse it (compare with the result from above):

DeleteDuplicates[Reverse@Sort@myData, SameQ @@ (Abs@{h, c, s} /. {#1, #2}) &]

{{h -> 255.155, c -> 4000., s -> 0}, {h -> 255.155, c -> 1870.83, s -> 3535.53}, {h -> 255.155, c -> 0, s -> 10000.}, {h -> 255.155, c -> 0, s -> 0}, {h -> 0, c -> 4000., s -> 0}, {h -> 0, c -> 1870.83, s -> 3535.53}, {h -> 0, c -> 0, s -> 10000.}, {h -> 0, c -> 0, s -> 0}}