Take the 2-minute tour ×
Mathematica Stack Exchange is a question and answer site for users of Mathematica. It's 100% free, no registration required.

Assume that there are three different points in x-y coordinate like:

p1={4, -1};
p2={5, -2};
p3={1, 5};

In order to compare these points to each other in a specific criteria, I have first built List1 which includes the whole possible states:

List1={{{4, -1}, {5, -2}}, {{4, -1}, {1, 5}}, {{1, 5}, {5, -2}}};

The criteria is:

If any of these two points has an x value bigger than the x value of the other point and a y value smaller than the y value of the other point, add this point to a different list. Otherwise move on to the next pair of points. Give a number which shows how many times point1 from List1 satisfies the criteria.

In order to clarify the problem :

first element of List1 includes two points : {{4, -1}, {5, -2}} point1 = {4, -1} and point2 = {5, -2}. x1 = 4 < x2 = 5 and y1 = -1 > y2 = -2. So point {5, -2} dominates point {4, -1} : ( 5>4 and -2<-1 )

Now put point {5, -2} in a list and give a number which shows how many times point {5, -2} satisfy the criteria.

The final results have to be like bellow:

DominatePoint1 = {{5, -2},2}
DominatePoint2 = {{4, -1},1}
DominatePoint3 = {{1, 5},0}

How can this be implemented in Mathematica?

share|improve this question

4 Answers 4

up vote 3 down vote accepted

Here a very direct approach to the problem:

list1 = Subsets[{p1, p2, p3}, {2}];
f = Module[{x1 = #[[1, 1]], y1 = #[[1, 2]], x2 = #[[2, 1]], y2 = #[[2, 2]]},
     If[x1 > x2 && y1 < y2, 
      #[[1]], 
      #[[2]]]
     ] &;

and then

Tally[f /@ list1]

However, I'm not sure if the alternative is correct, as it wasn't specified.
If you also need the points with zero counts:

Reverse@SortBy[
  Map[{#, Count[f /@ list1, #]} &, Union@ArrayFlatten[list1, 1]], 
 Last]

Edit: for the clarified selection criteria the former function definition is no longer correct, but the following are:

More complex decisions can be implemented using Which instead of If, e.g.

f2 = Module[{x1 = #[[1, 1]], y1 = #[[1, 2]], x2 = #[[2, 1]], y2 = #[[2, 2]]},
      Which[
       x1 > x2 && y1 < y2, #[[1]],
       x2 > x1 && y2 < y1, #[[2]]
      ]
     ] &;

will return the point that satisfies the criterion and Null if none does.


An alternative approach is the use of a conditioned function definition:

f3[l_List]:=l[[1]] /; l[[1,1]] > l[[2,1]] && l[[1,2]] < l[[2,2]]
f3[l_List]:=l[[2]] /; l[[2,1]] > l[[1,1]] && l[[2,2]] < l[[1,2]]
share|improve this answer

A slightly different approach

Clear[dominateCount]

dominateCount[points : {_, _} ..] := 
 Module[{pairs, dominatePick, pickedPoints}, 
  pairs = Subsets[{points}, {2}];
  dominatePick[p1_List, p2_List] := Switch[p1 - p2,
    {_?NonNegative, _?NonPositive}, 
    p1, {_?NonPositive, _?NonNegative}, p2,
    _, Null];
  pickedPoints = dominatePick @@@ pairs;
  DeleteCases[
   Append[Tally@pickedPoints, 
    Append[Complement[{points}, pickedPoints], 0]], {Null, _}]
  ]

dominateCount[p1, p2, p3]     
(* {{{5, -2}, 2}, {{4, -1}, 1}, {{1, 5}, 0}} *)
share|improve this answer
    
will edit this later. Pasting from WolframCloud is horrible. –  seismatica Jul 31 at 22:00
1  
Don't worry, saved you the trouble. +1. –  RunnyKine Jul 31 at 22:05
    
For p1 = {4, 0}; p2 = {5, 0}; p3 = {10, 0}; p4 = {10, 1}; this code doesn't provide the correct output {{{10, 1}, 0}, {{10, 0}, 0}, {{5, 0}, 0}, {{4, 0}, 0}} –  Karsten 7. Aug 1 at 0:07
    
@RunnyKine Thanks so much! I edited my answer again to fix an issue in it. –  seismatica Aug 1 at 1:43

Not sure if I well understand the criterion, because for much more points my results are different from those obtained with f1 and f2 suggested by @Karsten 7. However, they agree with those obtained using dominateCount written by RunnyKine. So, I would have your suggestions about my solution.

dominate[l : {{_, _} ..}] :=
Module[{a, b},
       a = Sort[l]; 
       b = SortBy[l, Last]; 
       Map[{#, Length[Intersection[Cases[{b}, {___, #, vals__} :> vals], 
                                   Cases[{a}, {vals___, #, ___} :> vals]]]}&, b]]

dominate[{p1, p2, p3}]
gives
{{{5, -2}, 2}, {{4, -1}, 1}, {{1, 5}, 0}}

Note that dominateCount gives a result counting the frequency of Null, not sure this is needed. Here is a test of timing for a bigger dataser

AbsoluteTiming[res1 = dominate[l];]
{8.901509, Null}
AbsoluteTiming[res2 = dominateCount[l];]
{51.900968, Null}

For a big dataset my approach seems to be faster.

share|improve this answer
    
It's really brilliant!! –  Shellp Aug 1 at 8:35

I find the question confusing but piggybacking on Karsten's apparently correct answer you might consider:

p = {{4, -1}, {5, -2}, {1, 5}};
list1 = Subsets[p, {2}];

f4[{a_, b_}] := Null[, a, b,][[ Sign[a - b].{1, -1} ]]

# - {0, 1} & /@ Tally @ Join[p, f4 /@ list1]
{{{4, -1}, 1}, {{5, -2}, 2}, {{1, 5}, 0}}

A count of Null represents any case that did not match the pattern to be either a or b.

share|improve this answer
    
I wonder how it is possible to run the code for some identical points in p list. For example : p={{4, -1}, {5, -2}, {1, 5}, {1, 5}}; .Accordingly the correct answer is : {{{4, -1}, 1}, {{5, -2}, 2}, {{1, 5}, 0},{{1, 5}, 0}}. –  Shellp Aug 1 at 8:24

Your Answer

 
discard

By posting your answer, you agree to the privacy policy and terms of service.

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