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

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.

-
Perhaps you could consider MultiedgeStyle-> None? For example: GraphPlot[list, VertexLabeling -> True, MultiedgeStyle -> None] – TomD Feb 4 '12 at 23:01
Erik, would you review my answer and consider Accepting it instead? I feel that J.M.'s method is needlessly complicated. The choice is entirely yours of course. – Mr.Wizard Oct 17 '14 at 22:27

This seems to do what you want:

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

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

-
Wow! Thanks a lot! That works perfectly. I'm not sure I really understand how it works, but figuring that out is good practice for me. – Erik Tjernlund Feb 4 '12 at 14:04
It's not too hard; I temporarily turn all your Rule[]s to List[]s with Apply[] (that is, @@@), sort those List[]s, delete duplicates with Union[], and then change the List[]s back to Rule[]s. – J. M. Feb 4 '12 at 14:07
+1 for Composition – Szabolcs Feb 4 '12 at 16:10

Using Mathematica 7

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


giving

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

-

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"}
*)

-
One possibly problematic thing about this method is that DeleteDuplicates with explicit comparison function will switch to the quadratic-time pairwise-comparison-based algorithm, making this impractical even for moderately sized graphs. For example: DeleteDuplicates[Flatten@Outer[Rule, Range[50], Range[50]], CmpTrans]  takes about 5 seconds on my machine. – Leonid Shifrin Feb 4 '12 at 17:01
Thank you for the corrected function. Embarrassingly I didn't test my version with a False case. – Erik Tjernlund Feb 5 '12 at 17:05

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"}

-
"...do not mind changing your edge directions..." - as he wants to draw an undirected graph, he certainly doesn't. – J. M. Feb 4 '12 at 23:25
@J.M. I actually did notice that, but I thought it best to include that anyway. Questions do change themselves sometimes. ;-) – Mr.Wizard Feb 4 '12 at 23:29

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[foo @@@ list] /. foo -> Rule *)
(* or DeleteDuplicates[list /. Rule -> foo] /. foo -> Rule *)
(* {"A" -> "B","C" -> "D"} *)

-

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]
`

-