获取手动绘制点的坐标

Question

我有一个执行 ListPlot[] 函数的结果图。 我可以通过将点移动到不同的位置来手动编辑此图 并使用绘图工具添加新点。

如何从编辑后的图形中获取新点和更改点的坐标？

Answer 1

我不确定以下是否是您想要的，但是：

如果我使用 ListPlot 如下：

lp1 = Labeled[
   ListPlot[Diagonal@Table[{x, y}, {x, 0, 5}, {y, 5}], 
    PlotStyle -> {Directive[Red, PointSize[Large]]}], "lp1"];

通过双击其中一个红点两次将选择范围设置为然后，我可以移动各个点，例如，使这些点位于曲线（而不是直线）上。我现在想要提取这些点（并说在新的 ListPlot 中使用它们）[参见下面的图]

如果我单击绘图图形的括号并使用“显示表​​达式”（命令 Shift E 上Mac），我可以“看到”修改点的坐标，然后可以提取这些坐标。例如：

expr = Cell[
   BoxData[GraphicsBox[{RGBColor[1, 0, 0], PointSize[Large], 
      PointBox[{{0., 1.}, {0.8254488458250212, 
         2.886651181634783}, {1.9301795383300084`, 
         3.925201233010209}, {3.046546974446661, 
         4.597525796319094}, {4., 5.}}]}, 
     AspectRatio -> NCache[GoldenRatio^(-1), 0.6180339887498948], 
     Axes -> True, PlotRange -> Automatic, 
     PlotRangeClipping -> True]], "Input", 
   CellChangeTimes -> {{3.504427833788156*^9, 3.50442786823486*^9}}];

修改 Yaroslav Bulatov 最初建议的非常有用的方法，可以在 此处

modpoints = Flatten[Cases[expr, PointBox[___], Infinity][[All, 1]], {{2, 1}}]

编辑

正如belisarius所指出的，希望能够提取“手动”添加的点（可以使用绘图工具选项板中的“点”将其添加到生成的图中）。更好的提取方法（在“显示表达式”之后...）可能如下：

modpoints = Cases[Cases[expr, PointBox[___], 
  Infinity], {_?NumericQ, _?NumericQ}, Infinity]

当然，“显示表达式”不是唯一的方法。
InputForm 是另一种可能性。例如，

expr2 = InputForm[ListPlotGraphic]

modpoints = Cases[Cases[expr, Point[___], 
  Infinity], {_?NumericQ, _?NumericQ}, Infinity]

“ListPlotGraphic”是修改后的图形（通过“复制和粘贴”插入），也将起作用。

示例图

附录

上述内容可以通过一些笔记本编程实现自动化：

lp1 = Labeled[
  ListPlot[Diagonal@Table[{x, y}, {x, 0, 5}, {y, 5}], 
   PlotStyle -> {Directive[Red, PointSize[Large]]}],
  Button["Print points",
   With[{nb = ButtonNotebook[]},
    SelectionMove[nb, All, CellContents];
    Print[Cases[NotebookRead[nb], 
       PointBox[{{_?NumericQ, _?NumericQ} ..}] | 
       PointBox[{_?NumericQ, _?NumericQ}], Infinity]]]]]

运行上述内容，移动最后两个原始内容 (红色）点并使用绘图工具添加几个蓝色的额外点，然后按按钮产生

您可以看到原始数据有一个 PointBox ，每个添加的点都有一个新的 PointBox 。当然，通过修改上面的代码，你可以做的不仅仅是简单地打印出原始点坐标。

Answer 2

这种方法使每个数据点都成为可以移动的定位器。可以根据需要添加新定位器并删除旧定位器。每次更改后都会更新最佳拟合和方差。

这是一些指数增长的数据，有一些错误，并且缺少一个数据点

data = Delete[Table[{t, (1 + RandomReal[{-.2, .2}])Exp[t]}, {t, 0, 2, .2}], 6];

一些格式化命令：

nForm = NumberForm[#, {2, 2}, NumberPadding -> {"", "0"}] &;

最后，这是制作可操作图形的代码。 使用 Alt-Click 添加新定位器/数据点code>（或 Linux 上的 Ctrl-Alt-Click）。如果单击左侧的点列表，则会打开一个新窗口，其中包含输入表单中的点。

Manipulate[
 LocatorPane[Dynamic[pts, {None, Temporary, Automatic}],
  nlm = Block[{a,b,t}, NonlinearModelFit[Sort[pts], a Exp[t] + b, {a, b}, t]]; 
  Show[Plot[{Exp[t], nlm[t]}, {t, 0, 2}, 
    PlotStyle -> {{Thick, LightGray}, Dotted}, PlotRangePadding -> Scaled[0.1]], 
   ListPlot[data, PlotStyle -> Blue], AxesLabel -> Block[{t,f}, {t, f[t]}]],
  LocatorAutoCreate -> True, Appearance -> Style["\[CircleDot]", Red]],
 {nlm, None}, {{pts, data}, None},
 Dynamic[Pane[EventHandler[
    nForm@Grid[Prepend[pts, {"x", "y"}], Dividers -> {False, 2 -> True}], 
    {"MouseClicked" :> (CreateDocument[{ExpressionCell[nlm["Data"], "Output"]}, 
     WindowTitle -> "Data"])}], ImageSize -> {100, 250}, 
   ImageSizeAction -> "Scrollable", Scrollbars -> {False, True}]],
 Pane[Dynamic[nForm@Row@{nlm,Row[{"\tvariance = ",nlm["EstimatedVariance"]}]}]],
 ControlPlacement -> {Left, Left, Left, Top}]

在上面，我使用定位器纠正了几个异常值并恢复了丢失的数据点。

Answer 3

最简单的选择是使用“获取坐标”菜单选项。如果右键单击图形，在弹出菜单中您将看到“获取坐标”，它允许您将鼠标悬停在某个点上并查看该点的坐标。当然，这不会很准确……但是您编辑图形的方式也不是很准确。

您可以使用 InputForm （或 FullForm）函数，但我不确定它的效果如何......

In[1]:= a = ListPlot[{{1, 0}, {0, 1}, {1, 1}}];
        a // InputForm

Out[2]//InputForm=
Graphics[{{{}, {Hue[0.67, 0.6, 0.6], Point[{{1., 0.}, {0., 1.}, {1., 1.}}]}, 
   {}}}, {AspectRatio -> GoldenRatio^(-1), Axes -> True, AxesOrigin -> {0, 0}, 
  PlotRange -> {{0., 1.}, {0., 1.}}, PlotRangeClipping -> True, 
  PlotRangePadding -> {Scaled[0.02], Scaled[0.02]}}]

您会注意到有一个 Point 表达式在那里。

我猜第三个选项是以某种方式使用 Locator 。