Построить фрактал Множество Аполлона "Представьте себе окружность, а затем впишите в нее еще три окружности наибольшего возможного радиуса, конгруэнтные друг другу: повторите аналогичную операцию с каждой из этих окружностей и с каждым промежутком между ними. А теперь вообразите, что этот процесс продолжен до бесконечности..." - так впервые в письме Лейбница к де Броссу была описана конструкция, в последствии названная Бенуа Мандельбротом Упаковкой Лейбница. А теперь программа построения множества Аполлона, используя нелинейные преобразования. Program Apollony; Uses CRT, Graph; Var //объявляем переменные gd, gm: Integer; x, y, a, b: Real; r: Real; a0, b0: Real; a1, b1, a2, b2: Real; f1x, f1y: Real; x1, y1: Real; Begin gd:=detect; InitGraph(gd, gm, 'c:\bp\bgi'); //инициализируем графику x:=0.2; y:=0.3; a:=0; b:=0; Randomize; //подключаем генератор случайных чисел r:=Sqrt(3); //задаём радиус круга While not KeyPressed Do Begin //цикл будет работать,пока не нажата клавиша a:=random; a0:=3*(1+r-x)/(sqr(1+r-x)+sqr(y))-(1+r)/(2+r); b0:=3*y/(sqr(1+r-x)+sqr(y)); If (a<=1/3) and (a>=0) Then Begin x1:=a0; y1:=b0; End; //в цикле производим вычисления a1:=-1/2; b1:=r/2; a2:=-1/2; b2:=-r/2; f1x:=a0/(sqr(a0)+sqr(b0)); f1y:=-b0/(sqr(a0)+sqr(b0)); If (a<=2/3) And (a>1/3) Then Begin x1:=f1x*a1-f1y*b1; y1:=f1x*b1+f1y*a1; End; If (a<= 3/3) and (a>2/3) Then Begin x1:=f1x*a2-f1y*b2; y1:=f1x*b2+f1y*a2; End; x:=x1; y:=y1; PutPixel(320+Round(x*50), 240+Round(y*50), 15); //рисуем множество End; ReadLn; CloseGraph; End.
Ключевые слова:
фрактал, множество аполлона
|
|||||||