1. Заголовок темы должен быть информативным. В противном случае тема удаляется ... 2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения. 3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали! 4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора). 5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM! 6. Одна тема - один вопрос (задача) 7.Проверяйте программы перед тем, как разместить их на форуме!!! 8.Спрашивайте и отвечайте четко и по существу!!!
Множества Мандельброта и Жюлиа, собственно программа постороения
Здравия желаю, Товарищи! Очевидно, эта тема уже обсуждалась, и я прочитал все касательно этих фракталов... НО. Результирующую программу мне так никто не предложил, а сам я еще не дорос, чтобы всю математику фрактала прописать самостоятельно в Паскале.
С множеством Мандельброта все понятно - я, наконец-то, достал информатика, и он дал мне готовую, полностью рабочую программу. Как я понял, в множестве Мандельброта граница убегания постоянна, а затравочное число изменятся. Тогда в множестве Жюлиа наоборот: затравочное число постоянно, а граница убегания меняется. Верно? (Гсподи! Неужли я такое говорю? )
Тогда достаточно в процедуре рисования множества Мандельброта изменить итерационный процесс и получим множество Жюлиа? Вопрос только в том, как это сделать? Вот текст процедуры рисования множества Мандельброта:
procedure Mandelbrot_Draw; { постpоение множества Мандельбpота } var i, j : Integer; X_New, Y_New, X_Old, Y_Old : Extended; r, P, Q : Extended; Color : Word; Begin for i:= 0 to GetMaxX do for j:= 0 to GetMaxY do begin P:= P_min+i*d_p; Q:= Q_min+j*d_q; Color:= 0; X_Old:= 0; Y_Old:= 0; repeat X_New:= X_Old*X_Old - Y_Old*Y_Old + p; Y_New:= 2*X_Old*Y_Old + q; Inc (Color); r:=Sqr(X_New) + Sqr(Y_New); X_Old:= X_New; Y_Old:= Y_New; until (r >= M) or (Color >= GetMaxColor); if r > M then PutPixel (i,j, Color) else PutPixel (i,j, 0); if KeyPressed then case ReadKey of #27 : Exit; #32 : PaletteCreate; end; end; { чистим буфеp клавиатуpы } while KeyPressed do ReadKey; End; { Mandelbrot_Draw }
(кстати, у меня работает почему-то быстрее, чем та, которую на нашел на этом форуме в теории)
Как я понял, итерационный процесс, это вот эта штука:
Которую надо изменить. Понятно дело придется так же поменять некоторые константы и переменные. Помогите мне, пожалуйста, преобразовать ЭТУ программу, чтобы она рисовала множества и Мандельброта и Жюлиа. Пропишите за меня процедуру для Жюлиа и объясните, что еще где нужно поменять и как, чтобы все без глюков запускалось. Мне надо завтра сдать эту задачу, иначе я себе аттестат испорчу. Помогите, пожалуйста поскорее кто может! Плиз! Я очень надеюсь на вас! А уж с интерфайсом выбора одного или другого множетсва я сам разберусь.
И еще одна мааленькая просьба. Если кто-нибудь меня услышит и поможет, киньте пожалуйста мне СМСку <...> (Здесь не доска сообщений. Читай правила!)
Всем заранее спасибо!!
Вот код всей программы(Показать/Скрыть)
program Fractal_Mandelbrot; { множество Мандельброта } { клавиши управления: стрелки - движение рамки курсора; Shift-стрелки вверх/вниз - увеличение/уменьшение рамки; Enter - начало нового рисунка; Alt-H - скрытие/отображение рамки; пробел - смена палитры; Esc - остановка рисунка/выход из программы } uses Crt, Graph;
const GetMaxColor : Word = 50; N = 16; { число цветов в палитре } M = 50; { граница убегания } Path = 'd:\pascal\bgi';
procedure GraphBegin; var Gd, Gm : Integer; Begin Gd:= Detect; InitGraph (Gd, Gm, Path); End; { GraphBegin }
procedure PaletteCreate; var i, R1, G1, B1, R2, G2, B2, Red, Green, Blue : Integer; Begin { начальный и конечный цвета палитры } repeat R1:= Random (64); G1:= Random (64); B1:= Random (64); Red:= R1; Green:= G1; Blue:= B1; R2:= Random (64); G2:= Random (64); B2:= Random (64); until Sqrt (Sqr (R1-R2)+Sqr (G1-G2)+Sqr (B1-B2)) > 50; { модифицируем цвета с 1 по 15, оставляя 0 - черным } for i:= 1 to 15 do begin SetRGBPalette (i, Red, Green, Blue); SetPalette (i,i); Inc (Red, (R2-R1) div (N-1)); Inc (Green, (G2-G1) div (N-1)); Inc (Blue, (B2-B1) div (N-1)); end; End; { PaletteCreate }
procedure Mandelbrot_Draw; { постpоение множества Мандельбpота } var i, j : Integer; X_New, Y_New, X_Old, Y_Old : Extended; r, P, Q : Extended; Color : Word; Begin for i:= 0 to GetMaxX do for j:= 0 to GetMaxY do begin P:= P_min+i*d_p; Q:= Q_min+j*d_q; Color:= 0; X_Old:= 0; Y_Old:= 0; repeat X_New:= X_Old*X_Old - Y_Old*Y_Old + p; Y_New:= 2*X_Old*Y_Old + q; Inc (Color); r:=Sqr(X_New) + Sqr(Y_New); X_Old:= X_New; Y_Old:= Y_New; until (r >= M) or (Color >= GetMaxColor); if r > M then PutPixel (i,j, Color) else PutPixel (i,j, 0); if KeyPressed then case ReadKey of #27 : Exit; #32 : PaletteCreate; end; end; { чистим буфеp клавиатуpы } while KeyPressed do ReadKey; End; { Mandelbrot_Draw }
procedure Rect (X, Y : Integer); { пунктиpная pамка, подобная экpану с центpом в X,Y } const DX_min : Integer = 40; { min и max размеры рамки } DX_max : Integer = 150; Hide : Boolean = False; { рамка скрыта } var Ch : Char; i : Integer; DX, DY, Z : Integer; { шиpины pамки по осям } X1, Y1, X2, Y2 : Integer; { кооpдинаты углов } Begin SetColor (White); SetLineStyle(DottedLn, 0, NormWidth); SetWriteMode(XORPut); { чтобы не возиться со стиранием } DX:= DX_min; { вначале минимальная pамка } { опpеделим углы } X1:= X-DX div 2; X2:= X+DX div 2; DY:= Round ((X2-X1)/GetMaxX*GetMaxY); Y1:= Y - DY div 2; Y2:= Y + DY div 2; { изменение pазмеpов - выход по Enter } repeat if not Hide then { меpцающая pамка } repeat Rectangle(X1, Y1, X2, Y2); Delay (15); Rectangle(X1, Y1, X2, Y2); Delay (15); until KeyPressed; { отслеживаем клавиши } repeat Ch:= Readkey until Ch<>#0; if (Mem[$0040:$017] and 3) <> 0 then begin { нажат Shift } case ord (Ch) of 72 : { увеличиваем pазмеpы } if (X1>0) and (X2<GetMaxX) and (X2-X1<DX_max) and (Y1>0) and (Y2<GetMaxY) then begin { пpеобpазуем шиpину, а высоту пеpесчитываем под экpанное соотношение} Dec(X1, 1); Inc (X2, 1); DY:= Round ((X2-X1)/GetMaxX*GetMaxY); Z:= (Y2+Y1) div 2; Y1:= Z - (DY div 2); Y2:= Z + (DY div 2); end; 80 : { уменьшаем pазмеpы } if (X2-X1>DX_min) then begin { пpеобpазуем шиpину, а высоту пеpесчитываем под экpанное соотношение} Inc(X1, 1); Dec (X2, 1); DY:= Round ((X2-X1)/GetMaxX*GetMaxY); Z:= (Y2+Y1) div 2; Y1:= Z - (DY div 2); Y2:= Z + (DY div 2); end; end; end else { не нажат Shift } case ord (Ch) of 35 : Hide:= not Hide; { Alt-H - рамка скрыта } 72 : if Y1>0 then { ввеpх } begin Dec(Y1, 1); Dec (Y2, 1); end; 80 : if Y2<GetMaxY then { вниз } begin Inc(Y1, 1); Inc (Y2, 1); end; 75 : if X1>0 then { влево } begin Dec(X1, 1); Dec (X2, 1); end; 77 : if X2<GetMaxX then { впpаво } begin Inc(X1, 1); Inc (X2, 1); end;