2
$\begingroup$

I have the following list of centers of disks.

r=0.03;
pts = {{0.10420089319018544`, -0.024872674177014872`}, \
{0.9743669105930046`, 0.9169054125547074`}, {0.028760526736240563`, 
    0.45959879163736717`}, {-0.0059035632830851115`, 
    0.2922099255180086`}, {0.41615337459441437`, 
    0.9928402345083696`}, {0.23798002911834915`, 
    0.028922198016334083`}, {0.9439796979256947`, 
    0.014706790894535735`}, {1.0038820168274474`, 
    0.677501854561434`}, {0.5927003061040934`, 
    1.0077273741847754`}, {1.0067437297432018`, 
    0.9752013154551493`}, {0.6938266053169369`, 
    1.0266240439258578`}, {0.98338794538608`, 
    0.26086568952319356`}, {0.9782652227588948`, 
    0.5171196676396621`}, {0.2545283903372031`, 
    1.0169130378365447`}, {-0.004475792541620699`, 
    0.08252251782338371`}, {0.0792067543327557`, 
    1.0190929886159708`}, {0.01012007453604613`, 
    0.9742793220312869`}, {0.37795635641517067`, 
    0.0006807388703829187`}, {0.16475658437291774`, 
    1.0073414058455288`}, {0.7109091765268767`, 
    0.010031721670787197`}, {0.751636715216994`, 
    0.9718377389063747`}, {-0.02868599270782108`, 
    0.8001977126969162`}, {0.9951076171959166`, 
    0.06361811727917832`}, {0.48856448143911413`, 
    0.9822360639397044`}, {0.8498119226349552`, 
    0.9954192191276157`}, {0.9343505459643862`, 
    1.026090808866221`}, {-0.02352512434168942`, 
    0.3638162649853829`}, {0.015464116868890446`, 
    0.8880954853506882`}, {0.5397449644933747`, 
    0.0075650003442971625`}, {1.0124037284145468`, 
    0.3445056232122783`}, {0.012611151682823951`, 
    0.22876062170703393`}, {0.01349201390129795`, 
    0.012484449700555664`}, {1.0287174186840569`, 
    0.4444472847751937`}, {1.0148117241333423`, 
    0.8423869907442485`}, {0.028166977268371904`, 
    0.749683634621167`}, {0.17535597671574954`, \
-0.02307375065511537`}, {0.6373054881521303`, -0.02231729523620847`}, \
{0.9791564983854446`, 0.7765347566257843`}, {-0.028389156500012468`, 
    0.7133375307394074`}, {0.47391260398278434`, \
-0.0029577636868491908`}, {0.009099484184960496`, 
    0.5770732674239099`}, {1.013402544772932`, 
    0.17610957824632423`}, {0.9714646177489623`, 
    0.6166237906203449`}, {0.30769518373972393`, \
-0.008573400690361568`}, {0.8261937637371302`, 
    0.001386073976981178`}, {0.8914586354858451`, \
-0.026330731282082395`}, {0.02725861951844763`, 
    0.6605283794945094`}, {-0.026575383043093995`, 
    0.5203231079582309`}, {0.004468178226517766`, 
    0.16296092728164324`}, {0.3189756417708023`, 0.9723496550714829`}};

Graphics[{FaceForm@Lighter[Blue, 0.8], 
  EdgeForm[{Thickness[0.004], Black}], Disk[#, r] & /@ pts}, 
 Background -> Lighter[Gray], Frame -> True, 
 PlotRange -> {{0, 1}, {0, 1}}]

I want to delete from this list the centers that are above the line in the figure below

enter image description here

I use

ptsxy = DeleteCases[
   pts, {x_, 
     y_} /; (0.05 <= x <= 1 && y >= 0.9) || (0 <= y <= 1 && x >= 0.9)];
Graphics[{FaceForm@Lighter[Blue, 0.8], 
  EdgeForm[{Thickness[0.004], Black}], Disk[#, r] & /@ ptsxy}, 
 Background -> Lighter[Gray], Frame -> True, 
 PlotRange -> {{0, 1}, {0, 1}}]

enter image description here

But I am sure that there are better ways.

$\endgroup$
5
  • $\begingroup$ What's r? It's not defined in the posted code. $\endgroup$
    – Pillsy
    Nov 30, 2015 at 17:19
  • $\begingroup$ Oh! Sorry. r=0.03 $\endgroup$
    – Dimitris
    Nov 30, 2015 at 17:21
  • $\begingroup$ Also, do you have an actual equation for the line? The region you've (implicitly) defined using DeleteCases isn't it.... $\endgroup$
    – Pillsy
    Nov 30, 2015 at 17:24
  • $\begingroup$ No I don't have a particular equation for the line. It's just to visualize which disks I want to get rid of. Thr line was adding with DrawingTools after the creation of the Graphic. $\endgroup$
    – Dimitris
    Nov 30, 2015 at 17:29
  • $\begingroup$ OK, good to know! $\endgroup$
    – Pillsy
    Nov 30, 2015 at 17:36

3 Answers 3

3
$\begingroup$

You can use geometry property. Let's say your equation of line is x+y-1=0. You can distinguish whether a point lies on same side as that of the origin by substituting the points into the equation of line. If the value is same that when origin 0,0 is substituted, then the point lies on the same side.

Here is a simple code that you can use:

eqline = (x + y - 1);
snOrigin = Sign[(eqline /. {x -> 0, y -> 0})];
Select[pts, (eqline /. {x -> First@#,y -> Last@#})*snOrigin > 0 &];

This should give you all the points which lie on the side of the line containing the origin.

$\endgroup$
2
  • $\begingroup$ Nice. Actually I want the lower side but it is very. Just change your code to eqline = (x + y - 1); Select[pts, (eqline /. {x -> First@#,y -> Last@#})*(eqline /. {x -> 0, y -> 0}) > 0 &]; Thanks! $\endgroup$
    – Dimitris
    Nov 30, 2015 at 17:48
  • $\begingroup$ Also, you can use some other point as reference, if you are not very fond of origin! $\endgroup$
    – Marvin
    Nov 30, 2015 at 17:54
2
$\begingroup$

Given the definition of the circle centres in pts, and a line parameterised by y=m*x+b.

Manipulate[
   Module[{r = 0.03, x = pts[[All, 1]], y = pts[[All, 2]], p},
      p = Pick[pts, UnitStep[y - m*x - b], 0];
      Graphics[{
         EdgeForm[{Thickness[0.004], Black}], FaceForm[Lighter[Blue, 0.8]],
         Map[Disk[#, r] &, p],
         Thin, Map[Circle[#, r] &, pts],
         Red, Line[Select[Transpose[{x, m*x + b}], -0.4 < #[[2]] < 1.4 &]]
         }, PlotRange -> {{-0.1, 1.1}, {-0.1, 1.1}}, Frame -> True]],
  {{m, -1.0}, -10., 10., Appearance -> "Labeled"},
  {{b, 1.0}, -5., 5., Appearance -> "Labeled"}
]

delete circles

$\endgroup$
1
  • $\begingroup$ Thanks for the answer. Unfortunately, I cannot select all of the answers. $\endgroup$
    – Dimitris
    Dec 1, 2015 at 10:15
2
$\begingroup$

This is a good place to use RegionMember and HalfPlane. First, I reproduced your diagram, after explicitly drawing the square and tweaking the formatting a bit:

square = {
   FaceForm[{Lighter@Gray, Opacity[0.2]}],
   EdgeForm[{Thickness[0.002], Black}],
   Rectangle[{0.0, 0.0}, {1.0, 1.0}]};

disks[pts_] := {
   EdgeForm[{Thickness[0.001], Black}],
   Disk[#, r] & /@ its};

Graphics[{
  square,
  {FaceForm[{Lighter@Blue, Opacity[0.2]}],
   disks[pts]}}]

disks

Then I used the drawing tools to draw a line similar to the one you provided, and assigned the edited Graphics object to a variable using copy and paste:

illustration

This allowed me to use cases to pick out the points defining that line, and then construct a RegionMember function to see which centers were in the HalfPlane above it:

With[{hp = FirstCase[pic, Line[ps_] :> HalfPlane[ps, {0, 1}], 
    Missing["NotFound"], Infinity]}, With[{fn = RegionMember[hp]}, 
  With[{split = GroupBy[pts, fn]}, 
   Graphics[
    {square, 
     {EdgeForm[{Red, Thick}], Opacity[0.2], 
      Darker[Gray], hp}, 
     {FaceForm[{Lighter[Green], Opacity[0.3]}], 
      disks[split[False]]}, 
     {FaceForm[{Lighter[Red], Opacity[0.3]}], 
      disks[split[True]]}}]]]]

Here, I used GroupBy to allow me to separate members from non-members in one swell foop. I also drew the HalfPlane, and drew the rejected disks in red instead of just omitting them.

enter image description here

$\endgroup$

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.