Mathematica 9 is now available
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: [mg72231] Re: circular infinity
  • From: dh <dh at metrohm.ch>
  • Date: Fri, 15 Dec 2006 07:06:27 -0500 (EST)
  • Organization: hispeed.ch
  • References: <elotg7$pe2$1@smc.vnet.net>

Hi,
this call for a recursive solution. We define a function that replaces 
one circle by itself and two contained circles and apply this function 
recursively.
fun[Circle[center_, rad_]] := Sequence[ Circle[center, rad], 
Circle[center + {0, rad/2}, rad/2], Circle[center - {0, rad/2}, rad/2]];
Now we apply this function e.g. 5 times:
n = 5;
res = Nest[(fun /@ #) &, {Circle[{0, 0}, 1]}, n];
Show[Graphics[res], AspectRatio -> Automatic]
Daniel

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. 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[
>>    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;
>> ]
>>
>> But it only ever renders a single outer circle. :/
>>
>> This fails with many errors:
>>
>> cx = 0;
>> cy = 0;
>> r = 1;
>>
>> SingleCircle = Show[
>>    Graphics[
>>        Circle[{cx, cy}, r]
>>    ], AspectRatio -> Automatic];
>>
>> while[r > 1/(1/16),
>>    cx=0 + r/2;
>>    r = r/2;
>>    SingleCircle[{cx, 0}, r];
>>    cx = 0 - r/2\;
>>    SingleCircle[{cx, 0}, r];
>> ]
>>
>> Any help would be appreciated. Thanks. 
> 


  • Prev by Date: Re: WebMathematica problem
  • Next by Date: Re: Re: FindRoot anomaly (example from Mathematica
  • Previous by thread: Re: circular infinity
  • Next by thread: Re: singular point list (NIntegrate)