18
$\begingroup$

Let's create some random sample data

data = Table[{RandomReal[{-10, 10}], RandomReal[{-10, 10}]}, {i, 1, 300}];

Then we plot them using ListPlot

L0 = ListPlot[data, Frame -> True, Axes -> False, AspectRatio -> 1]

And here is the output

enter image description here

Now, how can I select from the screen plot some date (those inside the red closed regions) using the mouse and then delete them form the list, thus creating a new list (data1)? Note here, that we don't know the equations of the red closed regions; they are completely arbitrary.

Any ideas?

$\endgroup$
8
  • $\begingroup$ What is your application? Would an Epilog that drew white shapes on top of the points you wanted to "delete" suffice? $\endgroup$
    – Verbeia
    Commented Nov 9, 2014 at 9:59
  • $\begingroup$ @Verbeia Just white space is not enough. I want to have the new list data1 (without the excluded points) ready for further manipulation. $\endgroup$
    – Vaggelis_Z
    Commented Nov 9, 2014 at 10:04
  • $\begingroup$ Ok, then I don't have time to work it out now (bedtime in Australia) but you probably do actually need some kind of equation for each regions, and then use DeleteCases to remove the points. $\endgroup$
    – Verbeia
    Commented Nov 9, 2014 at 10:08
  • $\begingroup$ I'm afraid that there are no known equations for these regions. They have to be selected by hand using the mouse to define the closed area. Anyway, if for example we wanted to exclude all data inside the circle of radius 1 how would we use DeleteCases? $\endgroup$
    – Vaggelis_Z
    Commented Nov 9, 2014 at 10:13
  • 1
    $\begingroup$ yes, this can be done, but not trivial. The first stage, is to select the points using the mouse. How would a complete region be determined to have been selected? What if the users does not close the circle around? How to decide if the free hand drawn circle is closed, how about if user decided to change and clear the region, etc.. there are many use cases issues to be decided first, ie. design stage, before even thinking of the implementation. An easier way to do it, would be to use the mouse to click on 2 places, and that will make a square with these as 2 corners. This is much easier. $\endgroup$
    – Nasser
    Commented Nov 9, 2014 at 10:19

4 Answers 4

20
$\begingroup$
data = Table[{RandomReal[{-10, 10}], RandomReal[{-10, 10}]}, {i, 1, 300}]; 
L0 = ListPlot[data, Frame -> True, Axes -> False, AspectRatio -> 1, 
  ImageSize -> 400, BaseStyle -> PointSize[.02]];

Using @rm-rf's function inPolyQ

inPolyQ[poly_, pt_] := Graphics`Mesh`PointWindingNumber[poly, pt] =!= 0

from this Q/A:

Deploy@ DynamicModule[{list = {}}, 
   Row[{EventHandler[Dynamic[Show[L0, Graphics[{Opacity[.7], Yellow, EdgeForm[Thick], 
                      Polygon[list], Purple, PointSize[.03], Point[list]}, 
                      PlotRange -> PlotRange[L0]]]],
          {"MouseDragged" :>  AppendTo[list, MousePosition["Graphics"]]}], 
       Dynamic@ListPlot[If[Length@list <= 2, data, 
                      Style[#, If[inPolyQ[list, #], Red, Blue]] & /@ data], 
                      BaseStyle -> PointSize[.02], Axes -> False, L0[[2]], 
               Prolog -> {Opacity[.5], Yellow, Polygon[list]}]}, Spacer[5]]]

enter image description here

Change the first argument of ListPlot to

If[Length@list <= 2, data, Pick[data, ! inPolyQ[list, #] & /@ data]]

to delete the points inside the selected polygon:

enter image description here

Note: As is, this can handle a single polygon. With some additional effort, it should be possible to handle multiple separate polygons.

$\endgroup$
6
  • $\begingroup$ On v10's you can replace inPolyQ with Element, with accepts a great deal of "regions" (besides Polygons, of course)! $\endgroup$
    – Aisamu
    Commented Nov 9, 2014 at 13:12
  • $\begingroup$ @Aisamu, good point; V10 has a number new functions that could be useful for the current task.. (I am still on v9 and the free Wolfram Programming Cloud is not too convenient to use:). $\endgroup$
    – kglr
    Commented Nov 9, 2014 at 13:18
  • 1
    $\begingroup$ As it turns out, there is even another, much faster function: RegionMember! $\endgroup$
    – Aisamu
    Commented Nov 9, 2014 at 17:34
  • $\begingroup$ @Aisamu, yes, i was aware of RegionMember; but, as i mentioned, it is a pain to use the free cloud version. Perhaps, you might consider posting an answer using RegionMember? $\endgroup$
    – kglr
    Commented Nov 9, 2014 at 17:48
  • 1
    $\begingroup$ Your inPolyQ test does not work in version 11 or 12. It should be replaced with: GraphicsPolygonUtilsPointWindingNumber, see mathematica.stackexchange.com/a/9417/45020. $\endgroup$
    – Kvothe
    Commented Dec 5, 2019 at 12:35
13
$\begingroup$

Here's a very simple example of a circular "eraser" which you can move around with the mouse and adjust the radius with a slider. Then click the button to remove points within the circle from data.

DynamicModule[{pt = {0, 0}, r = 3}, Column[{
   Slider[Dynamic[r], {0.1, 5}],
   Button["Delete", data = Select[data, EuclideanDistance[#, pt] > r &]],
   LocatorPane[Dynamic[pt],
    Dynamic[ListPlot[data, Frame -> True, Axes -> False, AspectRatio -> 1, 
      Epilog -> Circle[pt, r], ImageSize -> 300]], 
    Appearance -> None]}]]

enter image description here

$\endgroup$
5
$\begingroup$

I know it doesn't really answers the question (since it doesn't use a region or anything else) but you could do the following (which is based on that) to delete the points you wish to delete:

DynamicModule[{range = {-10, 10}, defpts = 100, pts, ptList = None, 
  ptCoord, selectedpt, ptPos, reset, create, selectpt, deselectpt, 
  deletept, firstPosition, export},
 firstPosition[list_, case_] := Position[list, case, 1, 1][[1, 1]];
 Panel@Column@{Button["Export Current data", export[], ImageSize -> 400],
    Panel[Graphics[{Dynamic[({EventHandler[{Dynamic[{If[selectedpt === #, 
                 deletept@selectedpt], Point[# /. ptCoord]}, 
               TrackedSymbols :> {selectedpt, ptCoord}]}, 
             {{"MouseDown", 1} :> (selectedpt = #;),
              {"MouseUp", 1} :> (selectedpt = deselectpt[];)}]} & /@ 
          ptList), TrackedSymbols :> {ptList}]}
      , PlotRange -> {range, range}, Frame -> True, 
      Background -> White], ImageSize -> 400, Background -> White]},
 Initialization :> (
   export[] := Export["~/test.dat", Last /@ ptCoord];
   selectpt[pt_] := (selectedpt = pt; ptPos = firstPosition[First /@ ptCoord, pt]);
   deselectpt[] := (selectedpt = ptPos = {});
   deletept[n_] := If[pts > 0, pts = pts - 1;
     ptList = DeleteCases[ptList, n];
     ptCoord = DeleteCases[ptCoord, _[n, _]];];
   reset[] := (selectedpt = {}; create@defpts;);
   create[n_] := (pts = n; ptList = Range@pts;
     ptCoord = Thread[ptList -> RandomReal[range, {defpts, 2}]];);
   reset[];)]

enter image description here

By clicking on "Export Current data" you would have in my case:

Import["~/test.dat"] // Length
87

It is unfortunately quite slow with bigger list, if anyone knows how to speed it up please let me know :)

$\endgroup$
3
  • $\begingroup$ Dear Öskå,very good solution! I'm wondering where in your code I can load my data... Thanks! $\endgroup$
    – meriens
    Commented Nov 20, 2014 at 13:39
  • $\begingroup$ @meriens Thank you :) Alas it doesn't exactly reply the question. But I found it quite handy (yet slow..). You need to load your data in the create[n_] := (pts = n; ptList = Range@pts; ptCoord = Thread[ptList -> RandomReal[range, {defpts, 2}]];); function. I use RandomReal here instead of a set of data. $\endgroup$
    – Öskå
    Commented Nov 20, 2014 at 13:41
  • $\begingroup$ @meriens You need to first define your data, then change defpts = Length@data and ptCoord = Thread[ptList -> data]: i.sstatic.net/OfECU.png $\endgroup$
    – Öskå
    Commented Nov 20, 2014 at 13:46
3
$\begingroup$

Try the function deletePoints[lst,imageSize] given below. Its first argument is the list of points, some of which you wish to delete, the second is the size of the image that you see on the screen for the convenience of working. The function shows the list on a LocatorPane, and you can select the points by Alt+LeftMouseClick, which brings up a locator in the vicinity of the point in question. You do not need to exactly hit the point in question. It is enough to place the locator closer to this point, than to the other ones. As soon as the points are selected, press the button in the bottom of the image. This generates two global variables: lstDeleted and lstSurvived. By evaluating them you get the both lists, and may then plot them, or do whatever else.

The function:

 deletePoints[lst_List, imageSize_Integer] := 
  DynamicModule[{pts = {}, lstNearest},
   lstNearest[a_List, b_List] := (Nearest[a, #, 1] // First) & /@ b;
   Column[{
     Dynamic@LocatorPane[
       Dynamic[pts],
       Dynamic@ListPlot[lst, ImageSize -> imageSize],
       LocatorAutoCreate -> True, ImageSize -> imageSize
       ],
     Button["Make the lists of survived and deleted points",
      Clear[lstDeleted, lstSurvived]; 
      lstDeleted = lstNearest[lst, pts];
      lstSurvived = 
       Delete[lst, First /@ (Position[lst, #] & /@ lstDeleted)]
      ]
     }]];

Example of its functioning. Let this be a list in question:

    lst = RandomReal[{-10, 5}, {10, 2}]

  (*  {{4.20383, -2.58995}, {-0.928284, -4.00225}, {1.61195, -9.17291},{-1.58935, 
      0.338292}, {-0.719281, -7.70116}, {-1.93687, -1.35842}, {-3.26784,-2.04274}, {-8.16471, -4.36758}, {-0.585342, -6.41022}, {-7.04512, 1.20394}}  *)

Apply the function:

deletePoints[lst, 400]

and select few points. I selected three that you can see in the image below. Press the button and evaluate the variables:

    lstSurvived
lstDeleted

(*  {{4.20383, -2.58995}, {1.61195, -9.17291}, {-1.58935, 
  0.338292}, {-0.719281, -7.70116}, {-3.26784, -2.04274}, {-0.585342,-6.41022}, {-7.04512, 1.20394}}

{{-0.928284, -4.00225}, {-1.93687, -1.35842}, {-8.16471, -4.36758}}  *)

enter image description here

Have fun!

$\endgroup$

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.