12
$\begingroup$

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}
$\endgroup$
2
  • 1
    $\begingroup$ 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. $\endgroup$ Mar 22, 2013 at 11:21
  • $\begingroup$ @Cameron You're right, you should post that as an answer. $\endgroup$
    – Szabolcs
    Mar 22, 2013 at 13:45

5 Answers 5

13
$\begingroup$

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}}]
$\endgroup$
4
  • $\begingroup$ This runs in the same time as RM's but without parallelization, which makes it the fastest solution so far. $\endgroup$
    – Szabolcs
    Mar 22, 2013 at 13:58
  • 1
    $\begingroup$ A nice mastery of list manipulation demonstrated here. +1 $\endgroup$
    – Mr.Wizard
    Mar 22, 2013 at 16:23
  • $\begingroup$ The output doesn't seem exactly correct. The triangle edges are not groups into a list. $\endgroup$ Mar 22, 2013 at 23:16
  • 1
    $\begingroup$ 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 $\endgroup$
    – rcollyer
    Mar 23, 2013 at 1:23
4
$\begingroup$

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 *)
$\endgroup$
1
  • $\begingroup$ 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 :-) $\endgroup$
    – Szabolcs
    Mar 22, 2013 at 0:30
3
$\begingroup$

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}
*)
$\endgroup$
6
  • $\begingroup$ 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} $\endgroup$
    – rm -rf
    Mar 21, 2013 at 23:57
  • $\begingroup$ 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. $\endgroup$
    – einbandi
    Mar 22, 2013 at 0:01
  • $\begingroup$ btw, looking at your timing results, I should consider buying a new computer :) $\endgroup$
    – einbandi
    Mar 22, 2013 at 0:02
  • $\begingroup$ The Sort before Union shouldn't be necessary. $\endgroup$
    – Szabolcs
    Mar 22, 2013 at 0:04
  • $\begingroup$ Union already sorts the results, that should be sufficient. $\endgroup$
    – Szabolcs
    Mar 22, 2013 at 0:07
2
$\begingroup$

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

Union@Flatten[Sort /@ Subsets[#, {2}] & /@ triangles, 1]
$\endgroup$
1
$\begingroup$

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

Based on Simon Woods answer

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

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

Which seems like one of the fastest and simplest answers yet. But apparently not the desired result.

$\endgroup$
2
  • 1
    $\begingroup$ You've misunderstood the question. The requirement is for a list of all the edges in the whole triangulation, without any duplicates. So if the input data was {{1,2,3}, {3,2,5}} your code gives a total of six edges {{{1,2}, {2,3}, {1,3}}, {{3,2}, {2,5}, {3,5}}}. But the edge {3,2} in the second triangle is a duplicate of the edge {2,3} in the first triangle. The desired output is a list of the five unique edges {{1,2}, {2,3}, {1,3}, {2,5}, {3,5}} $\endgroup$ Mar 23, 2013 at 15:13
  • $\begingroup$ Ah I see. No worries then. $\endgroup$ Mar 24, 2013 at 4:34

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.