Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
2006
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 2006

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: circular infinity

  • To: mathgroup at smc.vnet.net
  • Subject: [mg72189] Re: circular infinity
  • From: Jean-Marc Gulliet <jeanmarc.gulliet at gmail.com>
  • Date: Thu, 14 Dec 2006 05:49:03 -0500 (EST)
  • Organization: The Open University, Milton Keynes, UK
  • References: <elotg7$pe2$1@smc.vnet.net>

Eep² wrote:
 > "Jean-Marc Gulliet" <jeanmarc.gulliet at gmail.com> wrote in message 
news:12nvcd7lp01bte8 at corp.supernews.com...
 >> Eep² wrote:
 >>> Hi, I'm trying to create the image at 
http://tnlc.com/eep/circles.html in Mathematica but I don't have much 
programming (or math) experience and am wondering if anyone here could 
help me out. I tried posting in comp.soft-sys.math.mathematica but it's 
moderated and my posts STILL haven't shown up in days. Here's what I 
have so far:
 >>>
 >>> Manual:
 >>>
 >>> Show[Graphics[{
 >>> Circle[{0, 0}, 2],
 >>>
 >>> Circle[{-1, 0}, 1], Circle[{1, 0}, 1],
 >>>
 >>> Circle[{-1.5, 0}, .5], Circle[{1.5, 0}, .5],
 >>> Circle[{-.5, 0}, .5], Circle[{.5, 0}, .5],
 >>>
 >>> Circle[{-1.75, 0}, .25], Circle[{-1.25, 0}, .25],
 >>> Circle[{-.75, 0}, .25], Circle[{-.25, 0}, .25], Circle[{.25, 0}, .25],
 >>> Circle[{.75, 0}, .25], Circle[{1.25, 0}, .25], Circle[{1.75, 0}, .25],
 >>>
 >>> Circle[{-1.875, 0}, .125], Circle[{-1.625, 0}, .125],
 >>> Circle[{-1.375, 0}, .125], Circle[{-1.125, 0}, .125],
 >>> Circle[{-.875, 0}, .125], Circle[{-.625, 0}, .125],
 >>> Circle[{-.3725, 0}, .125], Circle[{-.125, 0}, .125],
 >>> Circle[{.375, 0}, .125], Circle[{.625, 0}, .125],
 >>> Circle[{.875, 0}, .125], Circle[{.125, 0}, .125],
 >>> Circle[{1.125, 0}, .125], Circle[{1.375, 0}, .125],
 >>> Circle[{1.625, 0}, .125], Circle[{1.875, 0}, .125],
 >>>
 >>> Circle[{-1.9375, 0}, .0625], Circle[{-1.8125, 0}, .0625],
 >>> Circle[{-1.6875, 0}, .0625], Circle[{-1.5675, 0}, .0625],
 >>> Circle[{-.875, 0}, .0625], Circle[{-.625, 0}, .0625],
 >>> Circle[{-.3725, 0}, .0625], Circle[{-.125, 0}, .0625],
 >>> Circle[{.375, 0}, .0625], Circle[{.625, 0}, .0625],
 >>> Circle[{.875, 0}, .0625], Circle[{.125, 0}, .0625],
 >>> Circle[{1.5675, 0}, .0625], Circle[{1.6875, 0}, .0625],
 >>> Circle[{1.8125, 0}, .0625], Circle[{1.9375, 0}, .0625]
 >>> }], AspectRatio -> Automatic]
 >>>
 >>> The last iteration needs spacing work still--I just got tired of 
writing it out manually...
 >>>
 >>> Based off the formula on 
http://local.wasp.uwa.edu.au/~pbourke/fractals/circles/ for POV-Ray:
 >>>
 >>> cx = 0;
 >>> cy = 0;
 >>> r = 1;
 >>>
 >>> SingleCircle = Show[
 >> --------------^^
 >> You have not defined a function: the parameters list is missing.
 >> Also, you should use := (SetDelayed).
 >>
 >>>     Graphics[
 >>>         Circle[{cx, cy}, r]
 >>>     ]
 >>>     , AspectRatio -> Automatic
 >>> ];
 >>>
 >>> loopradius = 1;
 >>> nn = 1;
 >>> iterations = 1;
 >>>
 >>> While [
 >>>     (iterations < 8),
 >>>     loopradius = loopradius/2;
 >>>     nn = 2*nn;
 >>>     n = -(nn - 1);
 >>>
 >>>     While[n <= nn - 1,
 >>>         SingleCircle[{-n/nn, 0}, loopradius];
 >>>         n = n + 2;
 >>>         ]
 >> -----------^
 >> A semi column marking the end of the inner loop is missing.
 >>
 >>>     iterations = iterations + 1;
 >>> ]
 >>>
 >>> But it only ever renders a single outer circle. :/
 >>>
 >>> This fails with many errors:
 >> So you could start with,
 >>
 >> cx = 0;
 >> cy = 0;
 >> r = 1;
 >>
 >> SingleCircle[{cx_, cy_}, r_] :=
 >>   Show[Graphics[Circle[{cx, cy}, r]], AspectRatio -> Automatic];
 >>
 >> loopradius = 1;
 >> nn = 1;
 >> iterations = 1;
 >>
 >> While[iterations < 8,
 >>   loopradius = loopradius/2;
 >>   nn = 2*nn;
 >>   n = -(nn - 1);
 >>   While[n <= nn - 1,
 >>     SingleCircle[{-n/nn, 0}, loopradius];
 >>     n = n + 2;
 >>   ];
 >>   iterations = iterations + 1;
 >> ]
 >
 > Thanks for the corrections but this gives the error:
 > SetDelayed::write: Tag Graphics in (-Graphics-)[{cx_, cy_}, r_] is 
Protected.
 >
 >>> cx = 0;
 >>> cy = 0;
 >>> r = 1;
 >>>
 >>> SingleCircle = Show[
 >> --------------^^
 >> You have not defined a function: the parameters list is missing.
 >> Also, you should use := (SetDelayed).
 >>
 >>>     Graphics[
 >>>         Circle[{cx, cy}, r]
 >>>     ], AspectRatio -> Automatic];
 >>>
 >>> while[r > 1/(1/16),
 >> --^ --------^^^^^^^^
 >> Mathematica function names are *always* capitalized.
 >> Moreover, you test r greater than 16, so you'll never enter the loop.
 >>
 >>>     cx=0 + r/2;
 >>>     r = r/2;
 >>>     SingleCircle[{cx, 0}, r];
 >>>     cx = 0 - r/2\;
 >> ------------------^
 >> Wrong place for a backslah here.
 >
 > Left in from having to edit out all of Mathematica's code after 
pasting...
 >
 >>>     SingleCircle[{cx, 0}, r];
 >>> ]
 >> The following expressions will give you better results although not 
yet what you are looking for:
 >>
 >> cx = 0;
 >> cy = 0;
 >> r = 1;
 >>
 >> SingleCircle[{cx_, cr_}, r_] :=
 >>   Show[Graphics[Circle[{cx, cy}, r]], AspectRatio -> Automatic];
 >>
 >> While[r > 1/16, cx = 0 + r/2;
 >>   r = r/2;
 >>   SingleCircle[{cx, 0}, r];
 >>   cx = 0 - r/2;
 >>   SingleCircle[{cx, 0}, r]; ]
 >
 > This also gives the same error as above.
 >

Try to run the code in a new Mathematica session. Both given expression 
works fine on my system. (They produce several graphics showing 
circles.) No warning nor error messages are displayed.

In[1]:=
cx = 0;
cy = 0;
r = 1;
SingleCircle[{cx_, cy_}, r_] :=
    Show[Graphics[Circle[{cx, cy}, r]],
     AspectRatio -> Automatic];
loopradius = 1;
nn = 1;
iterations = 1;
While[iterations < 8, loopradius = loopradius/2;
    nn = 2*nn; n = -(nn - 1); While[n <= nn - 1,
     SingleCircle[{-n/nn, 0}, loopradius];
      n = n + 2; ]; iterations = iterations + 1; ]

In[9]:=
cx = 0;
cy = 0;
r = 1;
SingleCircle[{cx_, cr_}, r_] :=
    Show[Graphics[Circle[{cx, cy}, r]],
     AspectRatio -> Automatic];
While[r > 1/16, cx = 0 + r/2; r = r/2;
    SingleCircle[{cx, 0}, r]; cx = 0 - r/2;
    SingleCircle[{cx, 0}, r]; ]

In[14]:=
$Version

Out[14]=
"5.2 for Microsoft Windows (June 20, 2005)"

Regards,
Jean-Marc


  • Prev by Date: Re: FindRoot anomaly (example from Mathematica Tutorial)
  • Next by Date: REPOSTING:RE: REPOSTING: PowerTower extended to real exponents
  • Previous by thread: Re: circular infinity
  • Next by thread: Re: circular infinity