2
$\begingroup$

I have a code that generates a region plot modeling an aperture. I would like to generate a table of ordered pairs (x,y) for a given u that manipulates my inequality. When I attempt to great a table all I get is true-false for each point. Is there a way to pull the data points that make up the region plot in the form of a table?

Manipulate[
RegionPlot[(x^2 + y^2 - u^2/10^2*x^2*y^2 <= 100), {x, -10, 
10}, {y, -10, 10}], {u, .1, .99999}]
$\endgroup$
0
2
$\begingroup$
pts = Flatten[#, 1] &@Table[{x, y}, {x, -10, 10, 0.5}, {y, -10, 10, 0.5}];
Manipulate[   
 \[ScriptCapitalR] = 
  ImplicitRegion[
   x^2 + y^2 - (u^2/10^2) x^2*y^2 <= 100 /. u -> k, {x, y}];
 (*Echo[\[ScriptCapitalR]];*)
 ptsinreg = 
  Pick[pts, ! RegionDisjoint[\[ScriptCapitalR], Point[#]] & /@ pts];
 (*Echo[ptsinreg];*)
 p1 = ListPlot[ptsinreg, PlotStyle -> Red, AspectRatio -> 1];
 p2 = RegionPlot[(x^2 + y^2 - (u^2/10^2)*x^2*y^2 <= 100), {x, -10, 
    10}, {y, -10, 10}];
 Show[p1, p2],
 {u, 0.1, 0.9, 0.1}
 ]

You can remove the comments from Echo statements to see your points. Also, you can generate pts with the resolution you want.

enter image description here

$\endgroup$
2
  • $\begingroup$ This is great and works perfectly for the model I am trying to build! thank you so much for your help. $\endgroup$
    – natedice
    Sep 29 at 15:38
  • $\begingroup$ My pleasure. Thanks for the accept and sorry about the late reply. $\endgroup$
    – Syed
    Oct 2 at 7:01
4
$\begingroup$

You can also use Reap and Sow.

For example:

f[x_, y_, u_] := x^2 + y^2 - u^2/10^2*x^2*y^2;
man[u_, t_, n_, d_] :=
 Module[{grid = Tuples[Range[-n, n, d], 2], pts},
  pts = Point[
    Reap[Sow[{##}, f[##, u] <= t] & @@@ grid, True][[2, 1]]];
  RegionPlot[f[x, y, u] <= t, {x, -n, n}, {y, -n, n}, Epilog -> pts]]

Then,

Manipulate[man[u, 100, 10, 1], {u, 0.1, 0.9, 0.1}, 
 ControlPlacement -> Top]

Unfortunately, rendering RegionPlot clunky...I am sure this can be smoothed. (posted just to illustrate Reap and Sow).

enter image description here

$\endgroup$
3
$\begingroup$
Clear["Global`*"]

$Version

(* "12.3.1 for Mac OS X x86 (64-bit) (June 19, 2021)" *)

SeedRandom[1234];

rgn3 = ImplicitRegion[
   x^2 + y^2 - u^2/10^2*x^2*y^2 <= 
    100, {{x, -10, 10}, {y, -10, 10}, {u, 0.1, 0.99999}}];

For random {x, y, u} points that are in the region rgn3

TableForm[
 pts3 = RandomPoint[rgn3, 10],
 TableHeadings -> {None, HoldForm /@ {x, y, u}},
 TableAlignments -> "."]

enter image description here

Verifying that the points are in the region

And @@ (RegionMember[rgn3] /@ pts3)

(* True *)

For random {x, y} points for a given u

rgn2 = With[{u = RandomReal[{0.1, 0.99999}]}, 
  rgn2 = ImplicitRegion[
    x^2 + y^2 - u^2/10^2*x^2*y^2 <= 100, {{x, -10, 10}, {y, -10, 10}}];
  Column@{
    StringForm["u = ``", NumberForm[u, {6, 3}]],
    TableForm[
     pts2 = RandomPoint[rgn2, 10],
     TableHeadings -> {None, HoldForm /@ {x, y, u}},
     TableAlignments -> "."],
    And @@ (RegionMember[rgn2] /@ pts2)}]

enter image description here

$\endgroup$

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.