5
$\begingroup$

If there are some points in a figure, how can I exclude some points to make them more evenly in the figure? 'Evenly' here can be defined as the number of points in each $0.01*0.01$ box is at most one. Without loss of generality, we can produce some random data to copy with (we can also give data directly, which is too long and tedious to present them here. So, we do not talk about how to produce the data but how to copy with the given data)

ListPlot[RandomReal[{-1, 1}, {10000, 2}]]

enter image description here

Any help or suggestion will be appreciated!

Improve this question
$\endgroup$
6
  • 3
    $\begingroup$ Please define "more evenly" $\endgroup$
    – rm -rf ♦
    Sep 16, 2013 at 0:08
  • $\begingroup$ The points look reasonalby uniformly distributed to me. The greater spread along x-axis in the plot is due to scale distortion. Try adding AspectRatio -> Automatic to your plot. $\endgroup$
    – m_goldberg
    Sep 16, 2013 at 0:36
  • $\begingroup$ ListPlot[Table[{x, y}, {x, -1, 1, 0.05}, {y, -1, 1, 0.05}]~Flatten~1] $\endgroup$
    – s0rce
    Sep 16, 2013 at 0:42
  • $\begingroup$ I'm marking this as a duplicate unless and until this question is edited to specifically differentiate it from the linked one. $\endgroup$
    – Mr.Wizard
    Sep 16, 2013 at 1:22
  • $\begingroup$ @Mr.Wizard Thanks! The question here is not about how to produce the data but how to copy with the given data. I update the question. $\endgroup$
    – Eden Harder
    Sep 16, 2013 at 13:10

2 Answers 2

Reset to default
7
$\begingroup$

Starting with some data:

SeedRandom[1]
data = RandomReal[{-1, 1}, {10000, 2}];
ListPlot[data, AspectRatio -> Automatic]

enter image description here

We can gather points by their rounded positions and keep only the first:

data2 = First /@ GatherBy[data, Round[#, 0.02] &];

Producing this:

ListPlot[data2, AspectRatio -> Automatic]

enter image description here

Note that I rounded by 0.02 to better show the effect, but by your problem description this should have been 0.01. You could also use Floor or Ceiling in place of Round to control the position of the effective underlying grid.

I assumed that your specification "the number of points in each 0.01∗0.01 box is at most one," is describing a grid of boxes rather than infinitely many overlapping boxes. This means that at the margin of these boxes points may still crowd. It is possible with much slower processing to do a pairwise compare of all points and delete any that are too close:

data3 = DeleteDuplicates[data, EuclideanDistance[##] < 0.02 &];  (* slow *)

ListPlot[data3, AspectRatio -> Automatic]

enter image description here

See the bottom section of this answer for more examples and explanation of the slower behavior of the pairwise operation.

Inspired by ybeltukov's answer here is my own oversampling approach:

decimate[data_, grid_, steps_] :=
  Module[{filter},
    filter[d2_, jitter_] := First /@ GatherBy[d2, Round[# + jitter, grid] &];
    Fold[filter, data, Most @ Range[0, grid, grid/steps]]
  ]

steps controls the oversampling factor. For example 25X:

decimate[data, 0.02, 25];

ListPlot[%, AspectRatio -> Automatic]

enter image description here

Improve this answer
$\endgroup$
5
  • $\begingroup$ I think this is pretty close to what the OP was expecting. $\endgroup$
    – rm -rf ♦
    Sep 16, 2013 at 17:22
  • $\begingroup$ Do I understand correctly that your oversampling applies only in the direction (1,1) not (1,-1)? Like my f3. I called this effect as "anisotropy". $\endgroup$
    – ybeltukov
    Sep 17, 2013 at 0:30
  • $\begingroup$ @ybeltukov I may not understand. The offset or "jitter" as I called it (on reflection that would be more appropriate of it were random I think) is added equally to x and y values before rounding, so e.g. {1, 2} becomes {1.1, 2.1}. I think this is what you mean. I do not see how this causes a problem if offsets cover an evenly spaced range across the grid size. Am I mistaken? $\endgroup$
    – Mr.Wizard
    Sep 17, 2013 at 0:44
  • $\begingroup$ @Mr.Wizard Even with infinite number of steps the lower bound of minimal distance is grid/Sqrt[2] not grid as expected (you can check it with my mindist). It is because the equal addition to x and y. I suggest to take different pairs of (jitterX, jitterY). $\endgroup$
    – ybeltukov
    Sep 17, 2013 at 17:36
  • $\begingroup$ @ybeltukov Okay, I see what you mean. Thanks for taking the time to point it out. Your method, with sufficient steps, would better approximate the pairwise Euclidean distance. My method follows the "0.01∗0.01 box" description, it just overlaps them. $\endgroup$
    – Mr.Wizard
    Sep 17, 2013 at 22:27
5
$\begingroup$

I propose a compromise between rounding positions and pairwise comparisons of Mr.Wizard answer

data = RandomReal[{-1, 1}, {10000, 2}];
f1[data_, r_] := First /@ GatherBy[data, Round[#, r] &];
f2[data_, r_] := f1[# - ConstantArray[{r/2.0, 0.0}, Length[#]], r] &@
                 f1[# - ConstantArray[{0.0, r/2.0}, Length[#]], r] &@
                 f1[# + ConstantArray[{r/2.0, 0.0}, Length[#]], r] &@
                 f1[data + ConstantArray[{0.0, r/2.0}, Length[data]], r];
f3[data_, r_] := f1[# + r/3, r] &@f1[# + r/3, r] &@f1[data, r] - 2r/3;
data1 = f1[data, 0.02];
data2 = f2[data, 0.02];
data3 = f3[data, 0.02];

f3 is simpler than f2 but produce slight anisotropy. Now minimal pairwise distances are

mindist[data_] := 
  Sqrt@Min@Array[
     Min@Total[(data[[#]] - Transpose@data[[1 ;; # - 1]])^2] &, 
     Length[data] - 1, 2];
mindist /@ {data, data1, data2, data3}

{0.000165427, 0.000540778, 0.0102496, 0.00725789}

As you can see f2 and f3 give much greater minimal distance. The lower bound of minimal distance is 0 for f1, r/2 for f2, and r/3 for f3.

Visual comparison:

ListPlot[#, AspectRatio -> 1, ImageSize -> 350] & /@ {data, data1, data2, data3} // Row

enter image description here

Improve this answer
$\endgroup$
1
  • $\begingroup$ This is a natural extension of the rigid grid or window I used. +1 $\endgroup$
    – Mr.Wizard
    Sep 16, 2013 at 23:53

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.

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