Faster way to convert triangle list to edge list with no duplicates

I have a list of triangles returned by a Delaunay triangulator, in the following format:

triangles = {{1, 7, 9}, {11, 9, 5}, {1, 9, 6}, {6, 11, 4}, {11, 6, 9},
{4, 11, 8}, {9, 7, 13}, {5, 13, 10}, {13, 5, 9}, {2, 13, 7},
{13, 2, 10}, {8, 12, 3}, {12, 8, 5}, {10, 3, 12}, {12, 5, 10}, {5, 8, 11}}

The integers are point indices. I need to convert this triangle list into an edge list which has no duplicate edges. For example, the first triangle from the list has these three edges: {{1,7}, {7,9}, {9,1}}. My first naive approach was this:

trianglesToLines[tri_] :=
Union[Sort /@ Flatten[Partition[#, 2, 1, 1] & /@ tri, 1]]

This is not fast enough, unfortunately, so I came up with this ugly compiled alternative:

cf = Compile[{{tri, _Integer, 1}},
Module[{i, res},
res = Table[0, {2 Length[tri]}];
Do[
res[[6 i + 1]] = tri[[3 i + 1]];
res[[6 i + 2]] = tri[[3 i + 2]];
res[[6 i + 3]] = tri[[3 i + 2]];
res[[6 i + 4]] = tri[[3 i + 3]];
res[[6 i + 5]] = tri[[3 i + 1]];
res[[6 i + 6]] = tri[[3 i + 3]];,
{i, 0, Length[tri]/3 - 1}];
res
]
]

trianglesToLines2[tri_] := Union@Partition[cf@Flatten[Sort /@ tri], 2]

This is much faster but awfully ugly. Is there a better way to speed up the operation? I will accept an answer that is a bit slower than the compiled one if it is considerably more elegant.

Timings on my machine:

In[203]:= trianglesToLines[triangles]; // AbsoluteTiming
Out[203]= {1.302468, Null}

In[204]:= trianglesToLines2[triangles]; // AbsoluteTiming
Out[204]= {0.206924, Null}

Test data:

Summary and timings

The fastest solution on a single core was Simon Woods's one. R.M.'s is just as fast when run on 4 cores. I included both a parallelized and a non-parallel version of R.M.'s function, as well as a Simon's with parallelized Sort.

(* original *)

trianglesToLines[tri_] :=
Union[Sort /@ Flatten[Partition[#, 2, 1, 1] & /@ tri, 1]]

(* original compiled *)

cf = Compile[{{tri, _Integer, 1}},
Module[{i, res}, res = Table[0, {2 Length[tri]}];
Do[res[[6 i + 1]] = tri[[3 i + 1]];
res[[6 i + 2]] = tri[[3 i + 2]];
res[[6 i + 3]] = tri[[3 i + 2]];
res[[6 i + 4]] = tri[[3 i + 3]];
res[[6 i + 5]] = tri[[3 i + 1]];
res[[6 i + 6]] = tri[[3 i + 3]];, {i, 0, Length[tri]/3 - 1}];
res]];

trianglesToLines2[tri_] := Union@Partition[cf@Flatten[Sort /@ tri], 2]

(* einbandi *)

trianglesToLines3[tri_] :=
Union@(Sort /@
Flatten[Function[x, x[[#]] & /@ {{1, 2}, {2, 3}, {3, 1}}] /@ tri,
1])

(* R.M. *)
With[{part = CompileGetElement,
e = {{1, 2}, {2, 3}, {1, 3}}},
cfrm = Compile[{{tri, _Integer, 1}},
With[{t = Sort@tri}, Map[part[t, #] &, e, {2}]],
RuntimeOptions -> "Speed", RuntimeAttributes -> {Listable},
Parallelization -> False]];

trianglesToLinesRM[tri_] := Union[cfrm@tri~Flatten~1]

(* R.M. parallel *)

With[{part = CompileGetElement, e = {{1, 2}, {2, 3}, {1, 3}}},
cfrmp = Compile[{{tri, _Integer, 1}},
With[{t = Sort@tri}, Map[part[t, #] &, e, {2}]],
RuntimeOptions -> "Speed", RuntimeAttributes -> {Listable},
Parallelization -> True]];

trianglesToLinesRMp[tri_] := Union[cfrmp@tri~Flatten~1]

(* Simon Woods *)

trianglesToLinesSW[t_] :=
Union@Flatten[{{#1, #2}, {#2, #3}, {#1, #3}} & @@
Transpose[Sort /@ t], {{1, 3}, {2}}]

(* Simon Woods; parallel Sort *)

cs = Compile[{{x, _Integer, 1}}, Sort[x], RuntimeOptions -> "Speed",
RuntimeAttributes -> {Listable}, Parallelization -> True];

trianglesToLinesSWp[t_] :=
Union@Flatten[{{#1, #2}, {#2, #3}, {#1, #3}} & @@
Transpose[cs[t]], {{1, 3}, {2}}]

In[13]:= (* original *)
trianglesToLines[triangles]; // AbsoluteTiming

Out[13]= {1.075996, Null}

In[14]:= (* original compiled *)
trianglesToLines2[triangles]; // AbsoluteTiming

Out[14]= {0.208128, Null}

In[15]:= (* einbandi *)
trianglesToLines3[triangles]; // AbsoluteTiming

Out[15]= {0.397399, Null}

In[16]:= (* R.M. *)
trianglesToLinesRM[triangles]; // AbsoluteTiming

Out[16]= {0.261082, Null}

In[17]:= (* R.M. parallel *)
trianglesToLinesRMp[triangles]; // AbsoluteTiming

Out[17]= {0.136793, Null}

In[18]:= (* Simon Woods *)
trianglesToLinesSW[triangles]; // AbsoluteTiming

Out[18]= {0.146266, Null}

In[19]:= (* Simon Woods; parallel sort *)
trianglesToLinesSWp[triangles]; // AbsoluteTiming

Out[19]= {0.111575, Null}

Timings on Ubuntu 13.04 running on the same machine in VirtualBox with two assigned CPU cores. Note that all solutions run considerably faster (except the parallelized ones).

In[13]:= (*original*)
trianglesToLines[triangles]; // AbsoluteTiming

Out[13]= {0.869539, Null}

In[14]:= (*original compiled*)
trianglesToLines2[triangles]; // AbsoluteTiming

Out[14]= {0.188039, Null}

In[15]:= (*einbandi*)
trianglesToLines3[triangles]; // AbsoluteTiming

Out[15]= {0.317713, Null}

In[16]:= (*R.M.*)
trianglesToLinesRM[triangles]; // AbsoluteTiming

Out[16]= {0.197207, Null}

In[17]:= (*R.M.parallel*)
trianglesToLinesRMp[triangles]; // AbsoluteTiming

Out[17]= {0.150842, Null}

In[18]:= (*Simon Woods*)
trianglesToLinesSW[triangles]; // AbsoluteTiming

Out[18]= {0.119471, Null}

In[19]:= (*Simon Woods;parallel sort*)
trianglesToLinesSWp[triangles]; // AbsoluteTiming

Out[19]= {0.111481, Null}
-
The built-in function Subsets is exactly the function you describe Subsets[#, {2}] & /@ triangles; // AbsoluteTiming {0.468339, Null} Not sure if this can be tweaked for speed. – Cameron Murray Mar 22 '13 at 11:21
@Cameron You're right, you should post that as an answer. – Szabolcs Mar 22 '13 at 13:45

Here's a version with decent performance without Compile. The idea is to Transpose the data so that the vertex lists {{a,b},{b,c},{a,c}} can be created in one go instead of mapping over the list. The posh version of Flatten is used to reshape the list afterwards.

trianglesToLinesSW[t_] :=
Union@Flatten[{{#1, #2}, {#2, #3}, {#1, #3}} & @@ Transpose[Sort /@ t], {{1, 3}, {2}}]
-
This runs in the same time as RM's but without parallelization, which makes it the fastest solution so far. – Szabolcs Mar 22 '13 at 13:58
A nice mastery of list manipulation demonstrated here. +1 – Mr.Wizard Mar 22 '13 at 16:23
The output doesn't seem exactly correct. The triangle edges are not groups into a list. – Cameron Murray Mar 22 '13 at 23:16
I guess it really is time to learn how to use that form of Flatten. An interesting twist with your method is that Apply unpacks, but it doesn't seem to matter. Switching to {{#[[1]], #[[2]]}, {#[[2]], #[[3]]}, {#[[1]], #[[3]]}}& @ takes practically the same time. +1 – rcollyer Mar 23 '13 at 1:23

By moving the sorting operation inside Compile and doing it only once per triangle instead of 3 as in your code (by indexing in the right order), I could get it to be twice as fast as your compiled solution and is considerably cleaner in my opinion:

With[{part = Compile`GetElement, e = {{1, 2}, {2, 3}, {1, 3}}},
cfrm = Compile[{{tri, _Integer, 1}},
With[{t = Sort@tri}, Map[part[t, #] &, e, {2}]],
RuntimeOptions -> "Speed", RuntimeAttributes -> {Listable}
]
];

trianglesToLinesRM[tri_] := Union[cfrm@tri ~Flatten~ 1]

You can add CompilationTarget -> "C" for a slight increase in speed. Timings on my machine:

res1 = trianglesToLinesSZ[triangles]; // AbsoluteTiming
(* {0.217710, Null} *)

res2 = trianglesToLinesRM[triangles]; // AbsoluteTiming
(* {0.129866, Null} *)

res1 == res2
(* True *)
-
This is faster than my compiled version only when it can run in parallel, it seems. I tried this by running it in VirtualBox with 1 CPU assigned (there surely must be a better way, but this was simple). A very weird thing I noticed is that all solutions run considerable faster in VirtualBox on Linux, than on OS X (except yours, but that's only because I can't assign it all 8 cores). For example my first approach runs in 0.8 on Linux while it runs in 1.2 on OS X ... I'll accept tomorrow if there are no faster ones :-) – Szabolcs Mar 22 '13 at 0:30

On my machine, this takes about twice as much time as your compiled version (but is about three times faster than your first version):

trianglesToLines3[tri_] := Union@(Sort /@ Flatten[
Function[x, x[[#]] & /@ {{1, 2}, {2, 3}, {3, 1}}] /@ tri,
1])

Some timings:

trianglesToLines[triangles]; // AbsoluteTiming
trianglesToLines2[triangles]; // AbsoluteTiming
trianglesToLines3[triangles]; // AbsoluteTiming
(*
{2.9401405, Null}
{0.5510264, Null}
{1.0140485, Null}
*)
-
This is exactly what I did too :) Mine's twice as fast as Szabolcs's. Re: sorting, what I did was to sort the integers in each triangle list and ensure that the indexing did not change the ordering, which means that the last indexing element becomes {1,3} – R. M. Mar 21 '13 at 23:57
Funny. :) It's basically the first approach that I tried. I don't really know a lot about Compile though, so I just left it as it is. And it looks quite nice and clean in my opinion. – einbandi Mar 22 '13 at 0:01
btw, looking at your timing results, I should consider buying a new computer :) – einbandi Mar 22 '13 at 0:02
The Sort before Union shouldn't be necessary. – Szabolcs Mar 22 '13 at 0:04
Union already sorts the results, that should be sufficient. – Szabolcs Mar 22 '13 at 0:07

slight variation, maybe a little more elegant. I dont have the full data set to check timing.

Union@Flatten[Sort /@ Subsets[#, {2}] & /@ triangles, 1]
-

The built-in function Subsets does this using the second option {2} for subsets containing exactly 2 elements? With your test data I get

Subsets[#, {2}] & /@ triangles; // AbsoluteTiming

(* ==> {0.468339, Null} *)

With exactly the output you describe

{{{9, 1}, {9, 129}, {1, 129}}, {{129, 246}, {129, 128}, {246,
128}}, {{15, 129}, {15, 1}, {129, 1}}, {{1, 13}, {1, 15}, {13,
15}},...

If anyone knows if speeds of built-in functions can be improved, I'd be very interested in some tips.

EDIT