6
$\begingroup$

I need to remove the reverse versions of lists from list of lists. I.e.: {{1,2},{2,2},{2,1},{a,1,2},{2,1,a}} I need to reduce to {{1,2},{2,2},{a,1,2}}. The requirement to remove only the reverse of a given list means that permutations other than the reverse will be conserved, so that

{{1,2,3},{2,1,3},{3,2,1},{1,2,2},{a,1,2},{2,1,a}}

should reduce to

{{1,2,3},{2,1,3},{1,2,2},{a,1,2}}

My try gives correct result but it use nested For which is not too nice. Does anyone know of a better way to do it?

$\endgroup$
7
  • 1
    $\begingroup$ Do you need to conserve the ordering in the sublists order? If not, you could map Sort on each one of them and then use Union to remove duplicates. As in Union[Sort /@ {{1, 2}, {2, 2}, {2, 1}, {a, 1, 2}}] $\endgroup$
    – Peltio
    Nov 8, 2013 at 13:36
  • $\begingroup$ @Peltio It's not so easy, {{1,2,3}, {3,1,2}} should not be reduced and it will be with your method. $\endgroup$
    – Kuba
    Nov 8, 2013 at 14:13
  • 1
    $\begingroup$ @Kuba But the basic idea is sane: find a canonical for for sublists, then use Union for an efficient solution. The question is: what efficiently computable canonical form can we use? (I.e. a way to unambiguously choose either list or Reverse[list] for each item.) $\endgroup$
    – Szabolcs
    Nov 8, 2013 at 14:19
  • $\begingroup$ @Szabolcs I can agree with you but Peltio's comment is not describing an idea which has to be improved, but the solution which fits only by a coincidence. Or I've missed something again? :) $\endgroup$
    – Kuba
    Nov 8, 2013 at 14:23
  • $\begingroup$ @Kuba, you're right, I did not consider other permutations. $\endgroup$
    – Peltio
    Nov 8, 2013 at 17:03

5 Answers 5

8
$\begingroup$

All right, this will be a linear-time solution:

ClearAll[removeReversed];
removeReversed[l_List] :=
   Module[{f},
     f[x_List] := (f[Reverse[x]] = Sequence[]; x);
     f /@ l]

For example:

lst = {{1, 2}, {2, 2}, {2, 1}, {a, 1, 2}, {2, 1, a}};

then:

removeReversed @ lst

(* {{1, 2}, {2, 2}, {a, 1, 2}} *)
$\endgroup$
14
  • $\begingroup$ Actually, this is not quite right... $\endgroup$ Nov 8, 2013 at 12:46
  • $\begingroup$ Try this list {{0,0,0,0,0,0}, {1,1,0,0,0,0}, {1,1,1,1,0,0}, {1,1,1,1,1,1}, {1,1,0,1,1,0}, {1,1,0,0,1,1}, {0,1,1,0,0,0}, {0,1,1,1,1,0}, {0,1,1,0,1,1}, {0,0,1,1,0,0}, {0,0,1,1,1,1}, {0,0,0,1,1,0}, {0,0,0,0,1,1}}. Artes' solutions works butter $\endgroup$ Nov 8, 2013 at 12:51
  • 1
    $\begingroup$ I was thinking about deleting the same elements with my method. I'm almost sure it must be done. Otherwise the filtering depends of main list order. For example: try removeReversed at lst = {{1, 2}, {1, 2}, {2, 1}}; and at Reverse[lst]. $\endgroup$
    – Kuba
    Nov 8, 2013 at 14:17
  • $\begingroup$ @Kuba Yes, surely it depends on main list order. Why should it not? These are just different problems. In the way the problem is specified now, it does not assume removal of duplicate lists. $\endgroup$ Nov 8, 2013 at 14:42
  • 1
    $\begingroup$ Well, it's natural for me it shouldn't unless specified explicitly. Unfortunatelly OP's example does not have this feature so we have to wait to check if you are right. But yes, there is no good reason why it shouldn't. $\endgroup$
    – Kuba
    Nov 8, 2013 at 14:50
4
$\begingroup$
list = {{1, 2}, {2, 2}, {2, 1}, {a, 1, 2}, {2, 1, a}};

There is an optional test argument in DeleteDuplicates:

DeleteDuplicates[ list, Reverse[#1] == #2 &]
{{1, 2}, {2, 2}, {a, 1, 2}}

alternatively we can use SameTest in Union:

Union[ list, SameTest -> (Reverse[#1] == #2 &)]
$\endgroup$
1
  • 2
    $\begingroup$ This is what came to my mind first, too. Alas, it will have quadratic complexity for large lists, because DeleteDuplicates will have to perform pairwise comparisons. $\endgroup$ Nov 8, 2013 at 12:43
2
$\begingroup$
GatherBy[list, Sort[{#, Reverse@#}] &][[;; , 1]]

I've deleted this answer because of Leonid's remark but now I think exact duplicates needs to be deleted to, otherwise the filtering depends of the order in main list.

Let's see that with Artes' solution:

list = {{1, 2}, {1, 2}, {2, 1}};
DeleteDuplicates[list, Reverse[#1] == #2 &]
DeleteDuplicates[Reverse@list, Reverse[#1] == #2 &]
{{1, 2}, {1, 2}}
{{2, 1}}
$\endgroup$
1
  • $\begingroup$ Actually, I was too fast to vote. This also removes the same lists occurring later on, not just their reverse versions. $\endgroup$ Nov 8, 2013 at 13:05
0
$\begingroup$

Another work around can be having a new list every time with reversed element removed.

   fun[l_List] := 
     Block[{k = l, 
       fin}, {fin = Quiet[Last[Table[If[MemberQ[k, Reverse[k[[i]]]] && 
             Hash[k[[i]]] != Hash[Reverse[k[[i]]]], 
             k = DeleteCases[k, Reverse[k[[i]]]], k], {i, 1, 
             Length[k]}]]]}; fin]


{{1,2,3},{2,1,3},{3,2,1},{1,2,2},{a,1,2},{2,1,a}}

{{1, 2, 3}, {2, 1, 3}, {1, 2, 2}, {a, 1, 2}}

{{0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 0, 0}, {1, 1, 1,
    1, 1, 1}, {1, 1, 0, 1, 1, 0}, {1, 1, 0, 0, 1, 1}, {0, 1, 1, 0, 0, 
   0}, {0, 1, 1, 1, 1, 0}, {0, 1, 1, 0, 1, 1}, {0, 0, 1, 1, 0, 0}, {0,
    0, 1, 1, 1, 1}, {0, 0, 0, 1, 1, 0}, {0, 0, 0, 0, 1, 1}}

{{0, 0, 0, 0, 0, 0}, {1, 1, 0, 0, 0, 0}, {1, 1, 1, 1, 0, 0}, {1, 1, 1, 1, 1, 1}, {1, 1, 0, 1, 1, 0}, {1, 1, 0, 0, 1, 1}, {0, 1, 1, 0, 0, 0}, {0, 1, 1, 1, 1, 0}, {0, 0, 1, 1, 0, 0}}

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

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

$\endgroup$
0
$\begingroup$

Just a variant (suffering from pairwise comparison growth):

fun[u_List]:=Tally[Union[u],#1===Reverse@#2&][[;;,1]]

Test lists:

list1={{1,2,3},{2,1,3},{3,2,1},{1,2,2},{a,1,2},{2,1,a}}
list2={{1, 2}, {1, 2}, {2, 1}}

Applying:

fun[list1]
fun[list2]

yields:

{{1, 2, 2}, {1, 2, 3}, {2, 1, 3}, {2, 1, a}}

{{1,2}}

To avoid double pairwise comparisons (Union, then Tally):

func[u_]:=Tally[u,#1===#2||#1===Reverse@#2&][[;;,1]]
$\endgroup$

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