-1
$\begingroup$

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?

Improve this question
$\endgroup$
0

4 Answers 4

Reset to default
4
$\begingroup$

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]]
Improve this answer
$\endgroup$
0
2
$\begingroup$

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.

Improve this answer
$\endgroup$
1
  • $\begingroup$ It's really brilliant!! $\endgroup$ Commented Aug 1, 2014 at 8:35
2
$\begingroup$

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.

Improve this answer
$\endgroup$
1
  • $\begingroup$ 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}}. $\endgroup$ Commented Aug 1, 2014 at 8:24
2
$\begingroup$

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}} *)
Improve this answer
$\endgroup$
4
  • $\begingroup$ will edit this later. Pasting from WolframCloud is horrible. $\endgroup$ Commented Jul 31, 2014 at 22:00
  • 1
    $\begingroup$ Don't worry, saved you the trouble. +1. $\endgroup$ Commented Jul 31, 2014 at 22:05
  • $\begingroup$ 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}} $\endgroup$ Commented Aug 1, 2014 at 0:07
  • $\begingroup$ @RunnyKine Thanks so much! I edited my answer again to fix an issue in it. $\endgroup$ Commented Aug 1, 2014 at 1:43

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.