5
$\begingroup$

Suppose that I have a set of points in a plane, which range from $x\in [0,20]$ and $y\in[0,10]$, and a curve given by a list of points in the same region:

data = Table[{RandomReal[20], RandomReal[10]}, {200}];
list = Table[{i, RandomReal[{5, 6}]}, {i, 0, 20}];

Now I want to select those points in data which are under the curve defined by list(where, for instance, such a curve is given by "step functions"). What is the fastest way of doing it?

$\endgroup$

4 Answers 4

11
$\begingroup$

Using the data and list as defined:

if = Interpolation[list, InterpolationOrder -> 1]
regm[{x_, y_}] := 0 <= x <= 20 && 0 <= y <= if[x]
Show[ListPlot[list, Joined -> True, PlotRange -> {0, 10}], 
 ListPlot[GatherBy[data, regm], 
  PlotStyle -> {Black, {Red, PointSize[0.02]}}, 
  PlotLegends -> {"Above", "Below"}], Frame -> True]

enter image description here

Here are 4 ways to get the points:

a1 = Cases[data, x_?(regm@# == True &)];
a2 = Select[data, regm@# == True &];
a3 = Pick[data, regm /@ data];
a4 = True /. GroupBy[data, regm];
$\endgroup$
8
$\begingroup$

This is likely equivalent to ubpdqn's answer internally, but I wanted to show off an answer with a "geometric" flavor:

BlockRandom[SeedRandom[42, Method -> "Legacy"]; (* for reproducibility *)
            data = Transpose[{RandomReal[20, 200], RandomReal[10, 200]}]; 
            list = MapIndexed[Append[#2 - 1, #1] &, RandomReal[{5, 6}, 21]]];

With[{xa = list[[All, 1]]}, (* cache abscissas *)
    underQ[pt_] := With[{k = GeometricFunctions`BinarySearch[xa, pt[[1]]]}, 
                        TrueQ[Det[PadRight[Append[list[[k + {0, 1}]], pt],
                                           {3, 3}, 1]] < 0]]]

ListLinePlot[list,
             Epilog -> Transpose[{{Directive[Red, AbsolutePointSize[4]],
                                   Directive[Black, AbsolutePointSize[2]]},
                                  Point /@ GatherBy[data, underQ]}],
             Frame -> True, PlotRange -> {0, 10}]

points above, points below

$\endgroup$
3
  • 1
    $\begingroup$ thank you...learned a lot from this +1 :) $\endgroup$
    – ubpdqn
    Commented Oct 18, 2015 at 13:19
  • $\begingroup$ ConvexHull (with appropriate points on the boundary of $[0,20] \times [0,10]$) would be another geometrical way to go... $\endgroup$ Commented Oct 19, 2015 at 2:38
  • $\begingroup$ Instead of using the signed area (that is, Det[PadRight[triangle, {3, 3}, 1]]) like I did here, one could use the signed distance from a point to a line; for some reason, that method was slower, so I settled on using signed area. $\endgroup$ Commented Oct 20, 2015 at 2:58
7
$\begingroup$

Your curve, plus two points makes a region.

Select[data, Element[#, Polygon[Join[list, {{20, 0}, {0, 0}}]]] &]

or

GatherBy[data, Element[#, reg] &]

where reg = Polygon[Join[list, {{20, 0}, {0, 0}}]] last two points defined by the range of $x$ and $y$.

Visual

Block[{reg = Polygon[Join[list, {{20, 0}, {0, 0}}]]},
 Show[
  ListPlot[
   {
    Select[data, ! Element[#, reg] &]
    , Select[data, Element[#, reg] &]
    }
   , PlotTheme -> "Scientific"
   , PlotStyle -> {Red, Blue}
   , PlotLegends -> {"Above", "Below"}
   ]
  , RegionPlot@reg
  ]
 ]

Mathematica graphics

Or

Block[
 {
  reg = Polygon@Join[list, {{20, 0}, {0, 0}}],
  },
 Show[
  ListPlot[
   GatherBy[data, Element[#, reg] &]
   , PlotTheme -> "Detailed"
   , PlotStyle -> {Red, Blue}
   , PlotLegends -> {"Above", "Below"}
   ]
  , RegionPlot@reg]
 ]

Mathematica graphics

$\endgroup$
5
$\begingroup$
Pick[data, UnitStep[data[[All, 2]] - Part[list[[All, 2]], Ceiling[data[[All, 1]]]]], 0]

Example:

data = Table[{RandomReal[20], RandomReal[10]}, {200}];
list = Table[{i, RandomReal[{5, 6}]}, {i, 0, 20}];

Show[{ListStepPlot[list, Right, Mesh -> Full],
  ListPlot[data, PlotStyle -> Black], 
  ListPlot[
   Pick[data, UnitStep[data[[All, 2]] - Part[list[[All, 2]], Ceiling[data[[All, 1]]]]], 0], 
 PlotStyle -> Red]}, PlotRange -> All, Frame -> True]

Example

$\endgroup$
1
  • $\begingroup$ neat and thank you for introducing me to ListStepPlot,+1 :) $\endgroup$
    – ubpdqn
    Commented Oct 18, 2015 at 13:21

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.