Mathematica: How to obtain data points plotted by plot command?

非 Y 不嫁゛ 提交于 2019-12-02 16:00:02
tomd
f = Sin[t];
plot = Plot[f, {t, 0, 10}]

One way to extract points is as follows:

points = Cases[
   Cases[InputForm[plot], Line[___], 
    Infinity], {_?NumericQ, _?NumericQ}, Infinity];

ListPlot to 'take a look'

ListPlot[points]

giving the following:

EDIT Brett Champion has pointed out that InputForm is superfluous.

ListPlot@Cases[
  Cases[plot, Line[___], Infinity], {_?NumericQ, _?NumericQ}, 
  Infinity]

will work.

It is also possible to paste in the plot graphic, and this is sometimes useful. If,say, I create a ListPlot of external data and then mislay the data file (so that I only have access to the generated graphic), I may regenerate the data by selecting the graphic cell bracket,copy and paste:

ListPlot@Transpose[{Range[10], 4 Range[10]}]

points = Cases[
  Cases[** Paste_Grphic _Here **, Point[___], 
   Infinity], {_?NumericQ, _?NumericQ}, Infinity] 

Edit 2.

I should also have cross-referenced and acknowledged this very nice answer by Yaroslav Bulatov.

Edit 3

Brett Champion has not only pointed out that FullForm is superfluous, but that in cases where a GraphicsComplex is generated, applying Normal will convert the complex into primitives. This can be very useful.

For example:

lp = ListPlot[Transpose[{Range[10], Range[10]}], 
  Filling -> Bottom]; Cases[
 Cases[Normal@lp, Point[___], 
  Infinity], {_?NumericQ, _?NumericQ}, Infinity] 

gives (correctly)

{{1., 1.}, {2., 2.}, {3., 3.}, {4., 4.}, {5., 5.}, {6., 6.}, {7., 7.}, {8., 8.}, {9., 9.}, {10., 10.}}

Thanks to Brett Champion.

Finally, a neater way of using the general approach given in this answer, which I found here

The OP problem, in terms of a ListPlot, may be obtained as follows:

ListPlot@Cases[g, x_Line :> First@x, Infinity]

Edit 4

Even simpler

ListPlot@Cases[plot, Line[{x__}] -> x, Infinity]

or

ListPlot@Cases[** Paste_Grphic _Here **, Line[{x__}] -> x, Infinity]

or

ListPlot@plot[[1, 1, 3, 2, 1]]

This evaluates to True

plot[[1, 1, 3, 2, 1]] == Cases[plot, Line[{x__}] -> x, Infinity]

One way is to use EvaluationMonitor option with Reap and Sow, for example

In[4]:= 
(points = Reap[Plot[Sin[x],{x,0,4Pi},EvaluationMonitor:>Sow[{x,Sin[x]}]]][[2,1]])//Short

Out[4]//Short= {{2.56457*10^-7,2.56457*10^-7},<<699>>,{12.5621,-<<21>>}}
Sjoerd C. de Vries

In addition to the methods mentioned in Leonid's answer and my follow-up comment, to track plotting progress of slow functions in real time to see what's happening you could do the following (using the example of this recent question):

(* CPU intensive function *)
LogNormalStableCDF[{alpha_, beta_, gamma_, sigma_, delta_}, x_] :=
 Block[{u},
  NExpectation[
   CDF[StableDistribution[alpha, beta, gamma, sigma], (x - delta)/u], 
   u \[Distributed] LogNormalDistribution[Log[gamma], sigma]]]

(* real time tracking of plot process *)
res = {};
ListLinePlot[res // Sort, Mesh -> All] // Dynamic

Plot[(AppendTo[res, {x, #}]; #) &@
  LogNormalStableCDF[{1.5, 1, 1, 0.5, 1}, x], {x, -4, 6}, 
 PlotRange -> All, PlotPoints -> 10, MaxRecursion -> 4]

etc.

Alexey Popkov

Here is a very efficient way to get all the data points:

{plot, {points}} = Reap @ Plot[Last@Sow@{x, Sin[x]}, {x, 0, 4 Pi}]

Based on the answer of Sjoerd C. de Vries, I've now written the following code which automates a plot preview (tested on Mathematica 8):

pairs[x_, y_List]:={x, #}& /@ y
pairs[x_, y_]:={x, y}
condtranspose[x:{{_List ..}..}]:=Transpose @ x
condtranspose[x_]:=x
Protect[SaveData]
MonitorPlot[f_, range_, options: OptionsPattern[]]:=
  Module[{data={}, plot},
    Module[{tmp=#},
      If[FilterRules[{options},SaveData]!={},
        ReleaseHold[Hold[SaveData=condtranspose[data]]/.FilterRules[{options},SaveData]];tmp]]&@
    Monitor[Plot[(data=Union[data, {pairs[range[[1]], #]}]; #)& @ f, range,
                 Evaluate[FilterRules[{options}, Options[Plot]]]],
      plot=ListLinePlot[condtranspose[data], Mesh->All,
      FilterRules[{options}, Options[ListLinePlot]]];
      Show[plot, Module[{yrange=Options[plot, PlotRange][[1,2,2]]},
        Graphics[Line[{{range[[1]], yrange[[1]]}, {range[[1]], yrange[[2]]}}]]]]]]
SetAttributes[MonitorPlot, HoldAll]

In addition to showing the progress of the plot, it also marks the x position where it currently calculates.

The main problem is that for multiple plots, Mathematica applies the same plot style for all curves in the final plot (interestingly, it doesn't on the temporary plots).

To get the data produced into the variable dest, use the option SaveData:>dest

Just another way, possibly implementation dependent:

ListPlot@Flatten[
            Plot[Tan@t, {t, 0, 10}] /. Graphics[{{___, {_, y__}}}, ___] -> {y} /. Line -> List
         , 2]

Dima

Just look into structure of plot (for different type of plots there would be a little bit different structure) and use something like that:

plt = Plot[Sin[x], {x, 0, 1}];
lstpoint = plt[[1, 1, 3, 2, 1]];
易学教程内所有资源均来自网络或用户发布的内容,如有违反法律规定的内容欢迎反馈
该文章没有解决你所遇到的问题?点击提问,说说你的问题,让更多的人一起探讨吧!