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.

Improve this question
$\endgroup$
5
  • $\begingroup$ What's r? It's not defined in the posted code. $\endgroup$ Commented Nov 30, 2015 at 17:19
  • $\begingroup$ Oh! Sorry. r=0.03 $\endgroup$ Commented 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$ Commented 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$ Commented Nov 30, 2015 at 17:29
  • $\begingroup$ OK, good to know! $\endgroup$ Commented Nov 30, 2015 at 17:36

3 Answers 3

Reset to default
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.

Improve this answer
$\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$ Commented 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$ Commented Nov 30, 2015 at 17:54
3
$\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

Improve this answer
$\endgroup$
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

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

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.