手作業で描かれた点の座標を取得する

Question

ListPlot[]関数を実行した結果としてグラフがあります。 ポイントを別の場所に移動して を手動で編集し、Drawing Toolsを使用して新しいポイントを追加することで、このグラフを手動で編集できます。

編集したグラフィックスから新規ポイントと変更ポイントの座標を取得するにはどうすればよいですか？

Answer 1

この方法では、すべてのデータポイントが移動可能なロケータになります。新しいロケータを追加したり、古いロケータを適切に削除したりすることができます。最適化と分散は、変更が行われるたびに更新されます。

は、ここではいくつかのエラーが発生しているいくつかの指数関数的な成長と

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}] 

私は、外れ値のカップルを修正するためにロケータを使用して欠落したデータポイントを回復してきました。

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表現があることに気づくでしょう。

第3の選択肢は、何らかの形でLocatorを使用することです。

Answer 3

私はそれにもかかわらず、次のあなたが望むようなものがあるかどうかわからないんだけど、：

次のように私はListPlotを使用する場合：

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

をダブルクリックすると、赤点の一つに二回ポイントのレベルに選択を得るために、ポイントを（直線ではなく）カーブ上に置くなど、個々のポイントを移動することができます。 []を使用したいと思っています（下のプロットを参照してください）

プロットグラフィックの括弧をクリックして "Show Expression"（MacではCommand Shift E）を使用すると、 、私は、次に抽出されるかもしれない修正された点の座標を「見る」ことができます。例えば：元々ベリサリウスによって指摘したように、できることが望ましいhere

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

EDIT

を見出すことができるヤロスラフBulatov、によって示唆非常に有用なアプローチの変更

expr = Cell[ 
    BoxData[GraphicsBox[{RGBColor[1, 0, 0], PointSize[Large], 
     PointBox[{{0., 1.}, {0.8254488458250212, 
     2.886651181634783}, {1.9301795383300084`, 
     3.9252}, {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}}]; 

手動で追加された点を抽出することができます（これは、描画ツールパレットの '点'を使用して生成された図に追加されます）。より良い抽出方法は、おそらく次のとおりです：

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

もちろん、 '表現式'だけではありません。
InputFormも可能です。例えば、 "ListPlotGraphic"が修正されたグラフィック（ 'copy and paste'によって挿入された）である場合には、

expr2 = InputForm[ListPlotGraphic] 

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

のようになります。

例プロット

補遺

上記少しノートプログラミングを自動化することができる：最後の2つの元の（赤色）を移動させる、上記の実行

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]]]]] 

ポイントを追加し、描画ツールで青色の余分なポイントを2つ追加した後、ボタンを押すと

あなたは、元のデータと追加された点の各々のための新たなPointBoxのための単一のPointBoxがあることがわかります。もちろん、上記のコードを変更することで、単純に元の座標をプリントアウトする以外のことを行うことができます。