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