Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

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.

share|improve this question
1  
Perhaps you could consider MultiedgeStyle-> None? For example: GraphPlot[list, VertexLabeling -> True, MultiedgeStyle -> None] –  TomD Feb 4 '12 at 23:01

4 Answers 4

up vote 13 down vote accepted

This seems to do what you want:

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

Rule @@@ Union[Composition[Sort, List] @@@ rules]  
{"A" -> "B", "C" -> "D"}
share|improve this answer
    
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
1  
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
2  
+1 for Composition –  Szabolcs Feb 4 '12 at 16:10

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

Union[Sort /@ rules]

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

First /@ GatherBy[rules, Sort]
share|improve this answer
    
"...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

Using Mathematica 7

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

giving

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

share|improve this answer

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"}
*)
share|improve this answer
2  
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

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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