Форум программистов, компьютерный форум, киберфорум
Free Pascal
Форум программистов и сисадминов Киберфорум > Форум программистов > Pascal (Паскаль) > Free Pascal
Войти
Регистрация
Восстановить пароль
Карта форума Темы раздела Блоги Сообщество Поиск Заказать работу  
 
Рейтинг 4.91/11: Рейтинг темы: голосов - 11, средняя оценка - 4.91
0 / 0 / 0
Регистрация: 15.11.2013
Сообщений: 12
1

Фрактал Жюлиа

15.11.2013, 23:13. Показов 2300. Ответов 11
Метки нет (Все метки)
Author24 — интернет-сервис помощи студентам
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

program J2;
 
uses Graph, Crt;
 
type
TComplex = record
X : Real;
Y : Real;
end;
 
const
iter = 50;
max  = 16;
 
var
z, t, c : TComplex;
x, y, n : Integer;
Cancel  : Boolean;
gd, gm  : Integer;
mx, my  : Comp;
 
begin
Cancel := false;
Randomize;
gd := Detect;
InitGra ph(gd,gm,'c:\bp\bgi');
Mx := GetMaxX div 2;
My := GetMaxY div 2;
for y := -0.9 to 1.1 do
for x := -1.0 to 0.7 do 
begin
n := 0;
z.x := x * 0.005;
z.y := y * 0.005;
c.x := 0.11;
c.y := -0.66;
while (sqr(z.x) + sqr(z.y) < max) and (n < iter) do 
begin
t := z;
{z^2 + c}
z.x := sqr(t.x) - sqr(t.y) + c.x;
z.y := 2*t.x*t.y + c.y;
Inc(n);
if keypressed then 
cancel := true;
end;
if n < iter then 
begin
PutPixel(mx + x,my + y,16 - (n mod 16));
end;
if cancel then 
exit;
end;
Readkey;
CloseGraph;
end.
0
Лучшие ответы (1)
Сообщение: #5344975
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
 15.11.2013, 23:13
Ответы с готовыми решениями:

Фрактал кривая Пеано
Столкнулся с проблемой. Нужно написать программу, которая выводит кривую Пеано, а грамотного кода,...

Рекурсия: фрактал Кривая Минковского
Необходимо реализовать фрактал - кривая Минковского с помощью рекурсии. Заранее спасибо

Фрактал рекурсия - прокомментировать код
пожалуйста прокоментируйте весь этот код, я хочу в нем разобраться. unit Unit1; {$mode...

Написать рекурсивную программу строящую фрактал "Т-квадрат"
Уважаемые форумчане, помогите пожалуйста написать рекурсивную программу строящую фрактал...

11
Супер-модератор
6192 / 2938 / 1300
Регистрация: 04.03.2013
Сообщений: 5,780
Записей в блоге: 1
15.11.2013, 23:22 2
У меня компилируется:
Миниатюры
Фрактал Жюлиа  
0
Супер-модератор
6192 / 2938 / 1300
Регистрация: 04.03.2013
Сообщений: 5,780
Записей в блоге: 1
15.11.2013, 23:30 3
Не тот скрин скинул, извиняюсь, программа, правда кривая...
0
0 / 0 / 0
Регистрация: 15.11.2013
Сообщений: 12
15.11.2013, 23:38  [ТС] 4
А ты в чем компелировал ???
0
Супер-модератор
6192 / 2938 / 1300
Регистрация: 04.03.2013
Сообщений: 5,780
Записей в блоге: 1
15.11.2013, 23:41 5
Да не компилируется
Цитата Сообщение от sanyasas Посмотреть сообщение
А ты в чем компелировал ???
Да не компилируется, там вообще всё криво, несоответствие типов данных вопиющее. Исправлял пока исправлялось, но в момент, когда я дошел и увидел, что в цикле for стоят дробные числа на месте счетчиков, я забил=)
0
0 / 0 / 0
Регистрация: 15.11.2013
Сообщений: 12
15.11.2013, 23:47  [ТС] 6
а что с этим можно сделать , куда там тогда значения присваивать ???

Добавлено через 1 минуту
начальный вариант такой ,, числа подставил сам
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56

program J2;
 
uses Graph, Crt;
 
type
TComplex = record
X : Real;
Y : Real;
end;
 
const
iter = 50;
max  = 16;
 
var
z, t, c : TComplex;
x, y, n : Integer;
Cancel  : Boolean;
gd, gm  : Integer;
mx, my  : Integer;
 
begin
Cancel := false;
Randomize;
gd := Detect;
InitGraph(gd,gm,'c:\bp\bgi');
Mx := GetMaxX div 2;
My := GetMaxY div 2;
for y := -my to my do
for x := -mx to mx do 
begin
n := 0;
z.x := x * 0.005;
z.y := y * 0.005;
c.x := 0.11;
c.y := -0.66;
while (sqr(z.x) + sqr(z.y) < max) and (n < iter) do 
begin
t := z;
{z^2 + c}
z.x := sqr(t.x) - sqr(t.y) + c.x;
z.y := 2*t.x*t.y + c.y;
Inc(n);
if keypressed then 
cancel := true;
end;
if n < iter then 
begin
PutPixel(mx + x,my + y,16 - (n mod 16));
end;
if cancel then 
exit;
end;
Readkey;
CloseGraph;
end.
0
Почетный модератор
64300 / 47595 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
16.11.2013, 11:52 7
Это делается так
Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76

uses graph;
type TComplex = record
                    x : Real;
                    y : Real;
                end;
const   iter = 30;
        max  = 16;
var z, t, c : TComplex;
    n, i : integer;
    gd, gm  : integer;
    mx, my  : integer;
    x0,xn,y0,yn,x,y,ms:real;
    s:string;
begin
gd := detect;
initgraph(gd,gm,'d:\bp\bgi');
x0:=-1.0;
xn:=0.7;
y0:=-0.9;
yn:=1.1;
mx := round(getmaxX*abs(x0)/(xn-x0));{центр по Х}
my := round(getmaxY*yn/(yn-y0));{центр по Y}
ms:=(getmaxY-40)/(yn-y0);{масштаб}
y:=y0;
while y<=yn do
 begin
  x:=x0;
  while x<=xn do
   begin
    n := 0;
    c.x := x;
    c.y := y;
    z.x := 0;
    z.y := 0;
    while (sqr(z.x) + sqr(z.y) < max) and (n < iter) do
     begin
        t := z;
        z.x := sqr(t.x) - sqr(t.y) + c.x;
        z.y := 2 * t.x * t.y+ c.y;
        inc(n);
     end;
      if n < iter then
    putpixel(mx + round(ms*x),my - round(ms*y),16 - (n mod 16));
    x:=x+0.01;
   end;
  y:=y+0.01;
 end;
setcolor(15);
line(0,my,getmaxX,my);{оси}
line(mx,0,mx,getmaxY);
{центр}
outtextXY(mx+5,my+10,'0');
{подписи концов осей}
outtextXY(getmaxX-10,my-10,'X');
outtextXY(mx+5,10, 'Y');
for i:=1 to 11{trunc(x0*10)+1} do{максимальное количество засечек в одну сторону}
  begin
    line(mx-3,my-round(i*ms/10),mx+3,my-round(i*ms/10));{засечки на оси У}
    line(mx-3,my+round(i*ms/10),mx+3,my+round(i*ms/10));
    line(mx+round(i*ms/10),my-3,mx+round(i*ms/10),my+3); {засечки на оси Х}
    line(mx-round(i*ms/10),my-3,mx-round(i*ms/10),my+3);
    str(i/10:0:1,s);
    if i mod 2=0 then
     begin
      {подпись оси У}
      settextstyle(0,0,1);
      outtextXY(mx-30,my-round(i*ms/10),s);{соответственно засечкам}
      outtextXY(mx-35,my+round(i*ms/10),'-'+s);
      {подпись оси Х}
      settextstyle(0,1,1);
      outtextXY(mx+round(i*ms/10),my+10,s);
      outtextXY(mx-round(i*ms/10),my+10,'-'+s);
     end;
  end;
readln
end.
0
0 / 0 / 0
Регистрация: 15.11.2013
Сообщений: 12
16.11.2013, 18:27  [ТС] 8
Спасибо , но это не тот фрактал , нужен был Жюлия (
0
Почетный модератор
64300 / 47595 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
16.11.2013, 19:26 9
Лучший ответ Сообщение было отмечено ildwine как решение

Решение

Pascal
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75

uses graph;
type TComplex = record
        x : Real;
                y : Real;
                end;
const   iter = 15;
        max  = 16;
      k=16;
var z, t : TComplex;
    n, i : integer;
    gd, gm  : integer;
    mx, my  : integer;
    x0,xn,y0,yn,x,y,ms:real;
    s:string;
begin
gd := detect;
initgraph(gd,gm,'d:\bp\bgi');
x0:=-1.0;
xn:=0.7;
y0:=-0.9;
yn:=1.1;
mx := round(getmaxX*abs(x0)/(xn-x0));{центр по Х}
my := round(getmaxY*yn/(yn-y0));{центр по Y}
ms:=(getmaxY-40)/(yn-y0);{масштаб}
y:=y0;
while y<=yn do
 begin
  x:=x0;
  while x<=xn do
   begin
    n := 0;
    z.x := x*ms*0.005;
    z.y := y*ms*0.005;
    while (sqr(z.x) + sqr(z.y) < max) and (n < iter) do
     begin
        t := z;
        z.x := cos(t.y)*(exp(t.x)+exp(-t.x))/2;
        z.y := sin(t.y)*(exp(t.x)-exp(-t.x))/2;
        inc(n);
     end;
      if n < k then
    putpixel(mx + round(ms*x),my - round(ms*y),16 - (n mod 16));
    x:=x+0.01;
   end;
  y:=y+0.01;
 end;
setcolor(15);
line(0,my,getmaxX,my);{оси}
line(mx,0,mx,getmaxY);
{центр}
outtextXY(mx+5,my+10,'0');
{подписи концов осей}
outtextXY(getmaxX-10,my-10,'X');
outtextXY(mx+5,10, 'Y');
for i:=1 to 11{trunc(x0*10)+1} do{максимальное количество засечек в одну сторону}
  begin
    line(mx-3,my-round(i*ms/10),mx+3,my-round(i*ms/10));{засечки на оси У}
    line(mx-3,my+round(i*ms/10),mx+3,my+round(i*ms/10));
    line(mx+round(i*ms/10),my-3,mx+round(i*ms/10),my+3); {засечки на оси Х}
    line(mx-round(i*ms/10),my-3,mx-round(i*ms/10),my+3);
    str(i/10:0:1,s);
    if i mod 2=0 then
     begin
      {подпись оси У}
      settextstyle(0,0,1);
      outtextXY(mx-30,my-round(i*ms/10),s);{соответственно засечкам}
      outtextXY(mx-35,my+round(i*ms/10),'-'+s);
      {подпись оси Х}
      settextstyle(0,1,1);
      outtextXY(mx+round(i*ms/10),my+10,s);
      outtextXY(mx-round(i*ms/10),my+10,'-'+s);
     end;
  end;
readln
end.
1
0 / 0 / 0
Регистрация: 15.11.2013
Сообщений: 12
16.11.2013, 20:17  [ТС] 10
а как сделатьо чтобы на осях х,у отажались правильно номера засечек , а то т ам иероглифы ???
0
Почетный модератор
64300 / 47595 / 32743
Регистрация: 18.05.2008
Сообщений: 115,181
16.11.2013, 20:38 11
У меня нормально.
Вот скрин, не могу загрузить на форум

http://zalil.ru/34816206
0
0 / 0 / 0
Регистрация: 15.11.2013
Сообщений: 12
17.11.2013, 00:16  [ТС] 12
ну а у меня , вместо цифр хрень какая то ... x..нь

Добавлено через 14 минут
http://zalil.ru/34816348

Добавлено через 1 час 36 минут
.
0
17.11.2013, 00:16
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
 17.11.2013, 00:16
Помогаю со студенческими работами здесь

Фрактал по типу множества Жюлиа
Здравствуйте уважаемые программисты. Проверьте пожалуйста и укажите на ошибки. Нужно получить...

множества Жюлиа
Здравствуйте! Помогите пожалуйста реализовать в PascalABC этот алгоритм Алгоритм построения...

Множество Жюлиа
Что именно нужно исправить в данном коде, чтобы он заработал на PascalABC.NET? (Множество Жюлиа для...

Построение множества Жюлиа
Постройте множество Жюлиа для функции h(z)=f(z)*g(z), где f(z)=z2+0,1+0,1i и g(z)=z2-2. Если я...

Фрактал
Хочу написать программу, рисующую фракталы, но пишет что нельзя преобразовать тип real к integer,...

Фрактал
Помогите пжл. изменить программу, чтобы получился фрактал показанный на изображении. PROGRAM...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
12
Ответ Создать тему
КиберФорум - форум программистов, компьютерный форум, программирование
Поддержать - Реклама - Обратная связь
Powered by vBulletin
Copyright ©2000 - 2024, CyberForum.ru