20
$\begingroup$

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.

$\endgroup$
1
  • 1
    $\begingroup$ Perhaps you could consider MultiedgeStyle-> None? For example: GraphPlot[list, VertexLabeling -> True, MultiedgeStyle -> None] $\endgroup$
    – user1066
    Commented Feb 4, 2012 at 23:01

9 Answers 9

18
$\begingroup$

This seems to do what you want:

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

Rule @@@ Union[Composition[Sort, List] @@@ rules]
(* {"A" -> "B", "C" -> "D"} *)
$\endgroup$
3
  • $\begingroup$ 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. $\endgroup$ Commented Feb 4, 2012 at 14:04
  • 2
    $\begingroup$ 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. $\endgroup$ Commented Feb 4, 2012 at 14:07
  • 1
    $\begingroup$ It's seem Union[Sort /@ rules] work,too. $\endgroup$
    – yode
    Commented Dec 26, 2016 at 3:22
28
$\begingroup$

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"}
$\endgroup$
2
  • 1
    $\begingroup$ "...do not mind changing your edge directions..." - as he wants to draw an undirected graph, he certainly doesn't. $\endgroup$ Commented Feb 4, 2012 at 23:25
  • $\begingroup$ @J.M. I actually did notice that, but I thought it best to include that anyway. Questions do change themselves sometimes. ;-) $\endgroup$
    – Mr.Wizard
    Commented Feb 4, 2012 at 23:29
12
$\begingroup$

Using Mathematica 7

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

giving

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

$\endgroup$
11
$\begingroup$

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"}
*)
$\endgroup$
2
  • 3
    $\begingroup$ 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. $\endgroup$ Commented Feb 4, 2012 at 17:01
  • $\begingroup$ Thank you for the corrected function. Embarrassingly I didn't test my version with a False case. $\endgroup$ Commented Feb 5, 2012 at 17:05
10
$\begingroup$

You can use UndirectedGraph directly for your graph problem

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

Graph[list, VertexLabels -> "Name"]

enter image description here

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

enter image description here

EdgeList[g]

enter image description here

$\endgroup$
4
$\begingroup$

Yet another proposal. Short but probably not very efficient.

list = {"A" -> "B", "B" -> "A", "C" -> "D"}
DeleteDuplicates[list,  Function[{x, y} , x == Reverse[y]]]
$\endgroup$
4
$\begingroup$

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

$\endgroup$
2
  • $\begingroup$ I don't think TransitiveReductionGraph does what the OP has asked (unless I misunderstood something). $\endgroup$
    – Szabolcs
    Commented Feb 19, 2018 at 19:48
  • $\begingroup$ @Szabolcs, deleted that part. $\endgroup$
    – kglr
    Commented Feb 21, 2018 at 23:27
2
$\begingroup$

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}
$\endgroup$
2
$\begingroup$
list = {"A" -> "B", "B" -> "A", "C" -> "D"};

Updated to reflect cvgmt's comment

Using SequenceSplit (new in 11.3)

Sort @ Map[First] @
  SequenceSplit[Sort[list, #1[[1]] == #2[[2]] &], 
   x : {a_ -> b_, b_ -> a_} :> x]

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

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

Sort @ Map[First] @
      SequenceSplit[Sort[list, #1[[1]] == #2[[2]] &], 
       x : {a_ -> b_, b_ -> a_} :> x]

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

$\endgroup$
2
  • $\begingroup$ Seems does not work for list = {"A" -> "B", "D" -> "C", "B" -> "A", "C" -> "D"}; $\endgroup$
    – cvgmt
    Commented Apr 30 at 8:33
  • $\begingroup$ Thanks, cvgmt, I will try to delete my answer $\endgroup$
    – eldo
    Commented Apr 30 at 8:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

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