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$
10
$\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$
  • 1
    $\begingroup$ thank you...learned a lot from this +1 :) $\endgroup$ – ubpdqn Oct 18 '15 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$ – Eric Towers Oct 19 '15 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$ – J. M. will be back soon Oct 20 '15 at 2:58
6
$\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$
  • $\begingroup$ neat and thank you for introducing me to ListStepPlot,+1 :) $\endgroup$ – ubpdqn Oct 18 '15 at 13:21

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.