0
$\begingroup$

I'm working on an attempt at forming a sort of "Mandelbrot" set using Newton's method and randomly chosen points. Effectively I need to define a loop for Newton's method to determine whether my points represent converging starting points or diverging ones and color code based on this. I've tried appending within an If loop so that when starting points result in a divergence break, they are set to one color and converging starting points are set to a different one. This is my attempt so far.

f[x_] = x^3 - 1;

Bleh[n0_] :=
  Module[{iteration = 1000,
    error = 10^(-10),
    denominator = 10^(-10),
    i = 1,
    j = 1,
    n = n0},
   Pnts = {};
   Pnt = {};

   For[j = 1, j <= n, j++, X = Random[]; Y = Random[]; x0 = X + I*Y;

    While[
     i <= iteration, (y = f[x0]; x1 = x0 - y/f'[x0]; 
      If[Abs[f'[x0]] < denominator, 
       Pnts = Append[Pnts, {X, Y}] && Break[]]; 
      If[Abs[x1 - x0] < error, Pnt = Append[Pnt, {X, Y}] && Break[]]; 
      x0 = x1); i++];
    ];];


    PartFive[n0_] := Module[{}, Bleh[n0]; Pnt = Map[Point, Pnt];
      Pnts = Map[Point, Pnts];
      DOTSin = Graphics[{Red, PointSize[0.01], Pnt}];
      DOTSout = Graphics[{Green, PointSize[0.01], Pnts}];

      Show[DOTSin, DOTSout, Axes -> True]]

Where n0 is supposed to be the number of randomly chosen points. Any help is appreciated. Thanks!

$\endgroup$
  • $\begingroup$ How is your code used? $\endgroup$ – Taiki Apr 8 '15 at 16:09
  • $\begingroup$ f[x], Bleh and PartFive are all separately entered. The final output is used by defining the number of points you want to plot. For 100 points, it would be PartFive[100] $\endgroup$ – Steelser Apr 8 '15 at 16:13
  • $\begingroup$ Do you get what you need if you change && inside If[...] to ; and set a larger value for denaminator, say, denominator= 10^(-1)? $\endgroup$ – kglr Apr 8 '15 at 19:44
2
$\begingroup$

The fundametal problem is here:

 Pnt = Append[Pnt, {X, Y}] && Break[]

The Break is evaluated and exits before the assignment. Just do this:

 Pnt = Append[Pnt, {X, Y}] ;  Break[]

That said Reap/Sow is a better way to go:

 Bleh[n0_] := Module[{iteration = 1000, error = 10^(-10),
     denominator = 10^(-10)},
     Last@Reap[ Table[
     X = Random[]; Y = Random[];
     x0 = X + I*Y;
     i = 0;
     While[i <= iteration,
       y = f[x0];
       x1 = x0 - y/f'[x0];
      If[Abs[f'[x0]] < denominator, Sow[{X, Y}, "E1"]; Break[]];
      If[Abs[x1 - x0] < error, Sow[{X, Y}, "E2"];  Break[]];
       x0 = x1; i++], {j, n0}] , {"E1", "E2"}]];

  {pts, pts2} = Bleh[1000]

(Note every point ends up in the "E2" list.. not very interesting )

$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.