How can I remove B -> A from a list if A -> B is in the list?

Question

I have a list of transformations like this:

list = {"A" -> "B", "B" -> "A", "C" -> "D"}

As this is used to plot an undirected graph with GraphPlot, I don't want to have an Edge between the vertices A-B and B-A. I just want one of them.

How do I remove either A -> B or B -> A from this list? In the end, I want the list to look like this:

{"A" -> "B", "C" -> "D"}

I've tried using DeleteDuplicates, but I don't think I understand the testing part of that function (I should add that I'm a Mathematica beginner ... )

I made a function that can compare two transformations:

CmpTrans[x_,y_] := (x[[1]]/.x) == y[[1]]

It returns True for CmpTrans[A->B, B->A], but I can't seem to use this is the testing part of DeleteDuplicates.

Answer 1

If you do not mind changing your edge directions and order, as J.M.'s answer does, this can be done much more simply since Sort works on arbitrary expressions:

Union[Sort /@ rules]

If you do not want to change the directions or order, you can use this:

First /@ GatherBy[rules, Sort]

Mathematica 10 introduced DeleteDuplicatesBy which may also be used:

DeleteDuplicatesBy[list, Sort]

{"A" -> "B", "C" -> "D"}

Answer 2

This seems to do what you want:

rules = {"A" -> "B", "B" -> "A", "C" -> "D"};

Rule @@@ Union[Composition[Sort, List] @@@ rules]
(* {"A" -> "B", "C" -> "D"} *)

Answer 3

Using Mathematica 7

Needs["GraphUtilities`"];
Rule @@@ DeleteDuplicates[Sort /@ EdgeList[list]]

giving

{"A" -> "B", "C" -> "D"}

Answer 4

Note that CmpTrans that you wrote isn't the correct test. Here's an example where it gives the wrong result:

CmpTrans["A" -> "B", "B" -> "C"]

(*
==> True
*)

Once we fix that, maybe with something like:

CmpTrans[x_, y_] := x === Reverse[y]

CmpTrans["A" -> "B", "B" -> "C"]

(*
==> False
*)

CmpTrans["A" -> "B", "B" -> "A"]

(*
==> True
*)

then we can simply use CmpTrans as the second argument to DeleteDuplicates:

list = {"A" -> "B", "B" -> "A", "B" -> "C", "C" -> "D"};

DeleteDuplicates[list, CmpTrans]

(*
==> {"A" -> "B", "B" -> "C", "C" -> "D"}
*)

Answer 5

You can use UndirectedGraph directly for your graph problem

list = {"A" -> "B", "B" -> "A", "C" -> "D"};

Graph[list, VertexLabels -> "Name"]

g = UndirectedGraph[Graph[list], VertexLabels -> "Name"]

EdgeList[g]

Answer 6

Update: For versions 10+ there is DeleteDuplicatesBy:

DeleteDuplicatesBy[Sort] @ list

{"A" -> "B", "B" -> "C", "C" -> "D"}

Original post:

You can also use an Orderless function foo.

In matching patterns with Orderless functions, all possible orders of arguments are tried.

list = {"A" -> "B", "B" -> "A", "C" -> "D"};

SetAttributes[foo, Orderless];

Rule @@@ DeleteDuplicates[foo @@@ list]   
(* or  DeleteDuplicates[bar @@@ list] /. bar-> Rule *)
(* or DeleteDuplicates[list /. Rule -> bar] /. bar -> Rule *)

{"A" -> "B","C" -> "D"}

Answer 7

Another approach is using pure pattern matching

{"A" -> "B", "B" -> "A", "C" -> "D"}
/. {before___, a_ -> b_, between___, b_ -> a_, after___} 
:> {before, a -> b, between, after}

which leaves the list in its original order.

If there are multiple duplicate entries one can use ReplaceRepeated (//.) instead of ReplaceAll(/.) to sweep the list until all duplicates are cleared

{"A" -> "B", "B" -> "A", "C" -> "D", "B" -> "A"} 
//. {before___, a_ -> b_, between___, b_ -> a_, after___}
:> {before, a -> b, between, after}

Answer 8

Yet another proposal. Short but probably not very efficient.

list = {"A" -> "B", "B" -> "A", "C" -> "D"}
DeleteDuplicates[list,  Function[{x, y} , x == Reverse[y]]]