如何在Mathematica中从椭圆图形的列表绘图中收集数据点？

Question

如何在Mathematica中从椭圆图形的列表绘图中收集数据点？

wolfram-mathematica

3

更新：

我有一组数据的列表图，我想在Mathematica中收集圆形图形特定边界内重叠于列表图中的所有数据点。

这种操作可能吗？

我制作的椭圆形式为

{c, s, \[Theta]} = 
 1 /. ComponentMeasurements[f, {"Centroid", "SemiAxes", "Orientation"}]
Show[Rasterize[p], Graphics[{Red, Rotate[Circle[c, s], \[Theta]]}]]

您能帮我将您的最底层解决方案适配成一个表单，以便我可以输入我的椭圆的重心、半轴长度和旋转角度属性吗？

- tquarton

1个回答

网页内容由stack overflow 提供, 点击上面的

可以查看英文原文，
原文链接

- Dr. belisarius · Accepted Answer

data = RandomReal[{0, 1}, {100, 2}]
r = 1/5;
center = {1/6, 1/4};
sd = Select[data, EuclideanDistance[#, center] < r &]
Show[ListPlot@data, 
     Graphics@Circle[center, r], 
     Graphics[{Red, PointSize[Large], Point@sd}], AspectRatio -> 1]

Mathematica graphics

编辑

对于一个椭圆，

data = RandomReal[{0, 1}, {100, 2}]
r = 1/5;
f1 = {1/6, 1/4};
f2 = {1/3, 1/5};
sd = Select[data, EuclideanDistance[#, f1] + EuclideanDistance[#, f2] < r &]
Show[ListPlot@data, 
     RegionPlot[EuclideanDistance[{x, y},f1] + EuclideanDistance[{x, y},f2] <r, 
                {x, 0, 1}, {y, 0, 1}], 
     Graphics[{Red, PointSize[Large], Point@sd}], AspectRatio -> 1]

Mathematica 图形

编辑 2

更好的代码

data = RandomReal[{0, 1}, {100, 2}]
r = 1/5;
f1 = {1/6, 1/4};
f2 = {1/3, 1/5};
inside[{x_, y_}, {f1_, f2_}] := Sum[EuclideanDistance[{x, y}, i], {i, {f1, f2}}];
sd = Select[data, inside[#, {f1, f2}] < r &];
Show[ListPlot@data,
     RegionPlot[inside[{x, y}, {f1, f2}] < r, {x, 0, 1}, {y, 0, 1}],
     Graphics[{Red, PointSize[Large], Point@sd}],
  AspectRatio -> 1]

编辑 3

这里将整个内容翻译为您的 ComponentMeasurements 输出

(*{c,s,t}=1/.ComponentMeasurements[f,{"Centroid","SemiAxes",\
"Orientation"}] *)
c = {.3, .4}
s = {.4, .2}
t = Pi/8

{s1, s2} = s
center = {cx, cy} = c
f = Sqrt[s1 s1 - s2 s2]
f1 = {f1x, f1y} = {cx + f Cos[t], cy - f Sin[t]}
f2 = {f2x, f2y} = {cx - f Cos[t], cy + f Sin[t]}
r = 2 Sqrt[f f + s2 s2]

data = RandomReal[{0, 1}, {100, 2}];

sd = Select[data, EuclideanDistance[#, f1] + EuclideanDistance[#, f2] < r &];
Show[
 ListPlot@data, 
 RegionPlot[ EuclideanDistance[{x, y}, f1] + EuclideanDistance[{x, y}, f2] < r,
              {x, 0, 1}, {y, 0, 1}], 
 Graphics[{Red, PointSize[Large], Point@sd}], 
AspectRatio -> 1]

Mathematica graphics