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:
triangles = Import["http://ge.tt/api/1/files/4ulWlnb/0/blob?download", "WDX"];
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 = 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},
Parallelization -> False]];
trianglesToLinesRM[tri_] := Union[cfrm@tri~Flatten~1]
(* R.M. parallel *)
With[{part = Compile`GetElement, 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}}]
Timings on OS X, quad-core i7 processor with hyperthreading:
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}
Subsets
is exactly the function you describeSubsets[#, {2}] & /@ triangles; // AbsoluteTiming
{0.468339, Null}
Not sure if this can be tweaked for speed. $\endgroup$