Re: Cool example with ContourPlot+EvaluationMonitor
- To: mathgroup at smc.vnet.net
- Subject: [mg125636] Re: Cool example with ContourPlot+EvaluationMonitor
- From: "djmpark" <djmpark at comcast.net>
- Date: Fri, 23 Mar 2012 01:34:06 -0500 (EST)
- Delivered-to: l-mathgroup@mail-archive0.wolfram.com
- References: <jk1fpb$4v0$1@smc.vnet.net> <5294367.38019.1332229314965.JavaMail.root@m06>
I've been following this, trying to think of something to add or some
improvement without success but Kevin's example finally helped me think of
something useful.
The problem with the examples so far is that they are all centered on the
circle because it was easy to draw that with an Epilog option. With
Presentations I devised the following code that allows arbitrary contour
equations and easy adjustment of the parameters. Sometimes it's instructive
to show many points and then again with many fewer points to see where the
algorithm is concentrating its effort. Here are three examples:
<< Presentations`
DynamicModule[
{data = {},
freeze = 0.005,
eqn = 8 x y == 1,
prange = 1.6,
points = 15,
recursion = 4,
maxDataPoints = 500,
contourFunction},
contourFunction[monitor : (True | False)][expr_] :=
ContourDraw[expr, {x, -prange, prange}, {y, -prange, prange},
PlotPoints -> points, MaxRecursion -> recursion,
EvaluationMonitor :>
If[monitor, (AppendTo[data, {x, y}];
If[Length[data] >= maxDataPoints, data = Drop[data, 1]];
Pause[freeze]), None]];
Print@
Draw2D[
{contourFunction[False][eqn],
Blue,
Dynamic[ListDraw[data]]
},
Frame -> True,
PlotRange -> 1.6];
contourFunction[True][eqn];
]
DynamicModule[
{data = {}, freeze = 0.0005,
eqn = Sin[5 x + 6 y^2] Cos[5 y^2 + 10 x] == 0.2,
prange = 0.7,
points = 30,
recursion = 3,
maxDataPoints = 2000,
contourFunction},
contourFunction[monitor : (True | False)][expr_] :=
ContourDraw[expr, {x, -prange, prange}, {y, -prange, prange},
PlotPoints -> points, MaxRecursion -> recursion,
EvaluationMonitor :>
If[monitor, (AppendTo[data, {x, y}];
If[Length[data] >= maxDataPoints, data = Drop[data, 1]];
Pause[freeze]), None]];
Print@
Draw2D[
{contourFunction[False][eqn],
Blue,
Dynamic[ListDraw[data]]
},
Frame -> True,
PlotRange -> prange];
contourFunction[True][eqn];
]
DynamicModule[
{data = {}, freeze = 0.0005,
eqn = Sin[5 x + 6 y^2] Cos[5 x^2 + 10 y] == 0.2,
prange = 0.7,
points = 30,
recursion = 3,
maxDataPoints = 2000,
contourFunction},
contourFunction[monitor : (True | False)][expr_] :=
ContourDraw[expr, {x, -prange, prange}, {y, -prange, prange},
PlotPoints -> points, MaxRecursion -> recursion,
EvaluationMonitor :>
If[monitor, (AppendTo[data, {x, y}];
If[Length[data] >= maxDataPoints, data = Drop[data, 1]];
Pause[freeze]), None]];
Print@
Draw2D[
{contourFunction[False][eqn],
Blue,
Dynamic[ListDraw[data]]
},
Frame -> True,
PlotRange -> prange];
contourFunction[True][eqn];
]
Watching these plots, it appears that the algorithm follows a two phase
strategy. First it attempts to divide the domain into regions that isolate
the contour lines. The sample points are heavily concentrated in the regions
between the actual contours and are nowhere near the contours. It seems to
spend an inordinate amount of time on this. Then, only after the contours
have been isolated, does the algorithm move to generating points on or near
the contour lines. One wonders if there is a theorem that, given enough
recursion and a fine enough starting mesh and some conditions on the
function, the algorithm will always isolate and refine the contour lines.
David Park
djmpark at comcast.net
http://home.comcast.net/~djmpark/index.html
From: Kevin J. McCann [mailto:kjm at KevinMcCann.com]
Another variation on a very cool theme.
f[x_, y_, freeze_] := (Pause[freeze]; x^2 + y^2) data = {}; freeze = 0.01;
Dynamic[
ListPlot[data, Frame -> True, AspectRatio -> 1, PlotStyle -> Blue,
PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}}, Epilog -> Circle[{0, 0}]]
]
ContourPlot[f[x, y, freeze] == 1, {x, -1.5, 1.5}, {y, -1.5, 1.5},
PlotPoints -> 30,
EvaluationMonitor :> {AppendTo[data, {x, y}],
If[Length[data] >= 600, data = Drop[data, 1]]}];
On 3/17/2012 3:51 AM, psycho_dad wrote:
> f[x_, y_, freeze_] := (Pause[freeze]; (x^2 + y^2)) data = {}; freeze =
> 0.04; Dynamic[ListPlot[data, Frame -> True, AspectRatio -> 1,
> PlotStyle -> Blue, PlotRange -> {{-1.6, 1.6}, {-1.6, 1.6}},
> Epilog -> Circle[{0, 0}]]]
> ContourPlot[f[x, y, freeze] == 1, {x, -1.5, 1.5}, {y, -1.5, 1.5},
> EvaluationMonitor :> AppendTo[data, {x, y}]];