获取手动绘制点的坐标

Question

执行ListPlot[]函数后，我有了一个图表。 我可以通过将点移动到其他位置来手动编辑此图形 并使用Drawing Tools添加新点。

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

Answer 1

我不确定以下内容是否符合您的要求，但不过：

如果我按如下方式使用ListPlot：

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

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

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

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最初建议的一种非常有用的方法，可以找到here

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

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

您可以使用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。

Answer 3

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

以下是一些指数增长的数据，其中包含一些错误和数据点缺失

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

一个小格式化命令：

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

最后，这是制作可操作图形的代码。 New locators/data points are added使用Alt-Click（或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}]

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