0
$\begingroup$

I'm trying to speed up the following, but implementing efficient pattern matching isn't intuitive to me yet, even with lots of examples.

I have a list of ((x1,y1,z1), (x2,y2,z2)) pairs, and I want to make a new list selecting the (x,y,z) from the pair where the z value is greatest. The following works, but is slow. What is an efficient way to do this?

points={
{{30.7058, -2326.85, 420000.}, {31.4061, -1391.63, 479968.}},
{{47.2775, -2326.72, 479960.}, {48.4709, -1391.63, 420090.}},
{{36.9202, -2326.81, 479968.}, {37.8054, -1391.65, 420000.}},
{{51.4203, -2326.67, 420090.}, {52.7372, -1391.6,  479908.}},
{{34.8488, -2326.83, 420090.}, {35.6723, -1391.65, 479968.}}
}
set1=Position[points[[;; , 1, 3]], s_ /; s >450000];
set2=Position[points[[;; , 2, 3]], s_ /; s >450000];
Join[Extract[points[[;;,1]],set1],Extract[points[[;;,2]],set2]]

{
{31.4061, -1391.63, 479968.},
{47.2775, -2326.72, 479960.},
{36.9202, -2326.81, 479968.},
{52.7372, -1391.6,  479908.},
{35.6723, -1391.65, 479968.}
}

In case it prompts an answer where I can get the right xyz values to start with, these pairs are the solutions of the intersection of a bunch of lines with a sphere, where all the lines intersect the sphere twice: 

Solve[(x - x0)/mx == (y - y0)/my == (z - z0) / mz && (x - xs0)^2 + (y - ys0)^2 + (z - zs0)^2 == rs^2, {x, y, z}]

The solutions I need is sometimes the first or second one. If I include && z > 450000 in the Solve it also works, but solves much more slowly than without that, so I thought I should extract them after the Solve.

Improve this question
$\endgroup$

3 Answers 3

Reset to default
1
$\begingroup$

You said you were interested in an efficient solution. I think the following should be pretty efficient:

maxZ[pts_] := Total[
    pts Transpose[{#, 1-#}& @ UnitStep[pts . {0, 0, 1} . {1, -1}]],
    {2}
]

For your example:

maxZ[points]

{{31.4061, -1391.63, 479968.}, {47.2775, -2326.72, 479960.}, {36.9202, -2326.81, 479968.}, {52.7372, -1391.6, 479908.}, {35.6723, -1391.65, 479968.}}

For a larger dataset:

SeedRandom[1];
pts = RandomReal[1, {10^6, 2, 3}];
r1 = maxZ[pts]; //AbsoluteTiming

r1[[;;10]]

{0.266662, Null}

{{0.817389, 0.11142, 0.789526}, {0.700474, 0.211826, 0.748657}, {0.422851, 0.247495, 0.977172}, {0.128821, 0.306427, 0.712012}, {0.390582, 0.819967, 0.325351}, {0.316876, 0.789804, 0.011978}, {0.391276, 0.458902, 0.458845}, {0.481571, 0.738297, 0.203011}, {0.544772, 0.562659, 0.767697}, {0.46418, 0.278197, 0.548402}}

Compare to J42161217's answer:

r2 = Last @ SortBy[#, Last]& /@ pts; //AbsoluteTiming
r2[[;;10]]

{3.26462, Null}

{{0.817389, 0.11142, 0.789526}, {0.700474, 0.211826, 0.748657}, {0.422851, 0.247495, 0.977172}, {0.128821, 0.306427, 0.712012}, {0.390582, 0.819967, 0.325351}, {0.316876, 0.789804, 0.011978}, {0.391276, 0.458902, 0.458845}, {0.481571, 0.738297, 0.203011}, {0.544772, 0.562659, 0.767697}, {0.46418, 0.278197, 0.548402}}

So, about an order of magnitude faster.

Improve this answer
$\endgroup$
2
  • 1
    $\begingroup$ The more I see answers as useful as this, the more I realize I should spend more time formulating the question in a way to make it easier to search for topics in the future. This is the most appropriate answer to the question now. (sorry J42161217!) $\endgroup$
    – DrBubbles
    May 8, 2019 at 0:43
  • $\begingroup$ @DrBubbles that's ok! Carl Woll always comes up with fast algorithms and comparisons. Although I was an order of magnitude faster at answering ;-) $\endgroup$
    – ZaMoC
    May 8, 2019 at 1:16
1
$\begingroup$

you can use 

Last@SortBy[#,Last]&/@points

{{31.4061, -1391.63, 479968.},
{47.2775, -2326.72, 479960.},
{36.9202, -2326.81, 479968.},
{52.7372, -1391.6, 479908.},
{35.6723, -1391.65, 479968.}}

Improve this answer
$\endgroup$
1
$\begingroup$

One way is to Select the ones you want. You can Select by the maximum of each triplet

Select[Flatten[points, 1], Max[#] > 450000 &]

{{31.4061, -1391.63, 479968.}, {47.2775, -2326.72, 479960.}, 
 {36.9202, -2326.81, 479968.}, {52.7372, -1391.6, 479908.}, 
 {35.6723, -1391.65, 479968.}}

or by the third element explicitly:

Select[Flatten[points, 1], #[[3]] > 450000 &]
Improve this answer
$\endgroup$
1
  • 1
    $\begingroup$ This and @J42161217 's answer are both much faster solutions than mine and are themselves similar in speed. So each is a great solution, I'll vote J42161217 's as the answer as it was first. Real life examples like this are so useful for helping understand the syntax. $\endgroup$
    – DrBubbles
    May 7, 2019 at 22:46

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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