Получение координат нарисованных вручную точек

Question

У меня есть график в результате выполнения функции ListPlot[].Я могу вручную редактировать этот график, перемещая точки в другое место, а также добавляя новые точки, используя Инструменты рисования .

Как получить координаты новых и измененных точек из отредактированной графики?

Answer 1

Я не уверен, что то, что вам нужно, похоже на следующее, но тем не менее:

Если я использую ListPlot следующим образом:

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

Двойным щелчком мыши на одномиз красных точек дважды, чтобы получить выделение на уровне точек, я могу затем переместить отдельные точки, например, чтобы точки лежали на кривой (а не на прямой линии).Теперь я хочу извлечь эти точки (и, скажем, использовать их в новом ListPlot) [см. Графики ниже]

Если я нажму на скобку графического изображения и использую «Показать выражение» (Command 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}}];

Изменение очень полезного подхода, первоначально предложенного Ярославом Булатовым, который можно найти здесь

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

РЕДАКТИРОВАТЬ

Как указал Велизарий, желательно иметь возможность извлекать «добавленные вручную точки» (которые можно добавить к сгенерированному графику, используя «точку» из палитры «Инструменты рисования»).Лучший способ извлечения (после «Показать выражение» ...), вероятно, следующий:

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 (или Ctrl-Alt-Click в Linux).Если вы щелкнете по списку точек слева, откроется новое окно, содержащее точки в форме ввода.

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, как мне кажется.