Форум программистов, компьютерный форум, киберфорум
PascalABC.NET
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.88/8: Рейтинг темы: голосов - 8, средняя оценка - 4.88
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
1

Кривые Серпинсого

26.12.2016, 19:25. Показов 1557. Ответов 16
Метки нет (Все метки)

На рисунке изображены кривые Серпинского 1 и 2-го порядков. Составить программу построения кривых 1, 2, 3, 4 и 5-го порядков, так чтобы центры этих кривых совпадали.
0

Помощь в написании контрольных, курсовых и дипломных работ здесь.

Миниатюры
Кривые Серпинсого  
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
26.12.2016, 19:25
Ответы с готовыми решениями:

На рисунке изображены кривые Коха 1 и 2-го порядка
На рисунке изображены кривые Коха 1 и 2-го порядка.Составить программу построения кривой N-го...

Построить кривые по заданному параметрическому представлению: строфоида
Строфоида : x=a*(t^2-1)/(T^2+1), y=a*t*(t^2-1)/(t^2+1) t принадлежит от...

Построить кривые по заданному параметрическому представлению или заданному в полярных координатах:
Построить кривые по заданному параметрическому представлению или заданному в полярных координатах:

Кривые на С++
Добрый день. Есть такая задача: имеются 4 точки на плоскости, их координаты известны. При условии,...

16
Эксперт Pascal/Delphi
6646 / 4471 / 4749
Регистрация: 05.06.2014
Сообщений: 21,975
27.12.2016, 12:14 2
http://информатика.1сентября.рф/1999/art/zlat2.htm
0
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
27.12.2016, 15:23  [ТС] 3
Подскажите, выдает ошибку: "Неизвестное имя 'detect'"

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
Program LLLL;
uses
graphABC, crt;
const 
del=5000;{Время задержки} 
Var d,r: integer; 
n: byte; 
Xlu,Ylu,Hscr,Wscr,A,x0,y0,h,Z: word; 
PrA:real; 
function calcZ(i:byte):word; 
   {Функция, рекурсивно вычисляющая коэффициент 
    диагонали кривой Серпинского} 
begin 
   if i=0 then calcZ:=1 
     else calcZ:=2*calcZ(i-1)+3; 
end; 
  {Процедуры рисования наклонных, горизонтальных и вертикальных отрезков кривой} 
Procedure SegmBC;
begin 
Linerel(h, h) 
end; 
Procedure SegmDE; 
begin 
Linerel(-h, h) 
end; 
Procedure SegmFG; 
begin 
Linerel(-h, -h) 
end; 
Procedure SegmHA; 
begin 
Linerel(h, -h) 
end; 
Procedure SegmEast; 
begin 
Linerel(2*h, 0) 
end; 
Procedure SegmSouth; 
begin 
Linerel(0, 2*h)
end; 
Procedure SegmWest; 
begin 
Linerel(-2*h, 0) 
end; 
Procedure SegmNord; 
begin 
Linerel(0, -2*h)
 end; 
  {Pекурсивные процедуры рисования четырех 
   частей кривой Серпинского} 
Procedure LineCD(i: byte); forward; 
Procedure LineGH(i: byte); forward; 
Procedure LineEF(i: byte); forward; 
Procedure LineAB(i: byte); 
begin 
    if i>0 then begin 
      LineAB(i-1); SegmBC; LineCD(i-1); SegmEast; 
      LineGH(i-1); SegmHA; LineAB(i-1); delay(del); 
    end 
end; 
Procedure LineCD; 
  begin 
   if i>0 then begin 
    LineCD(i-1); SegmDE; LineEF(i-1); SegmSouth; 
    LineAB(i-1); SegmBC; LineCD(i-1); delay(del); 
   end 
  end; 
Procedure LineEF; 
  begin 
   if i>0 then begin 
    LineEF(i-1); SegmFG; LineGH(i-1); SegmWest; 
    LineCD(i-1); SegmDE; LineEF(i-1); delay(del); 
  end 
end; 
Procedure LineGH;
  begin 
   if i>0 then begin 
    LineGH(i-1); SegmHA; LineAB(i-1); SegmNord; 
    LineEF(i-1); SegmFG; LineGH(i-1); delay(del); 
   end 
end; 
BEGIN {Основной программы} 
  clrscr; {Чистка экрана} 
  write('Введите длину стороны опорного квадрата'); 
  write('в % от высоты экрана '); 
  readln(PrA); 
  write('Введите порядок кривой '); 
  readln(n); 
  d:=detect; 
  initgraph(d, r, ''); 
   {Переход в графический режим}
  Hscr:=GetMaxY+1;
  Wscr:=GetMaxX+1;{Высота и ширина экрана}
  Z:=calcZ(n);
   {Коэффициент диагонали кривой Серпинского}
  h:=round(A/(S+1));
   {Проекция наклонного отрезка} 
   {Находим координаты левой верхней
    точки опорного квадрата} 
  Xlu:=Wscr div 2 - a div 2; 
  Ylu:=Hscr div 2 - a div 2; 
   {Находим координаты начальной точки кривой} 
  y0:=Ylu; x0:=Xlu+h; 
  moveto(x0, y0); 
   {Ставим графический курсор в начальную точку} 
   {Строим кривую} 
  LineAB(n); SegmBC; LineCD(n); SegmDE; 
  LineEF(n); SegmFG; LineGH(n); SegmHA; 
  readln;{Выход - нажатием клавиши Enter} 
  closegraph;{Переход в текстовый режим} 
END.
0
Эксперт Pascal/Delphi
6646 / 4471 / 4749
Регистрация: 05.06.2014
Сообщений: 21,975
27.12.2016, 15:30 4
Евгения479, по ссылке программа для ТурбоПаскаль. Вам нужно подправить её для вашей версии Паскаля.
0
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
27.12.2016, 15:32  [ТС] 5
Я,честно говоря,не представляю как работать с графической информацией Pascal ABC
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
27.12.2016, 16:06 6
И не только detect, а еще и initgraph, linerel, потому что это написано в Турбо Паскале
0
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
27.12.2016, 16:09  [ТС] 7
Не могли бы помочь исправить программу для Pascal ABC?
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
27.12.2016, 19:51 8
Лучший ответ Сообщение было отмечено ZX Spectrum-128 как решение

Решение

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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
uses graphABC,crt;
Var d,r,x,y: integer;
    n,i: byte;
    Xlu,Ylu,Hscr,Wscr,A,x0,y0,h,Z: word;
    PrA:real;
//Функция, рекурсивно вычисляющая коэффициент  диагонали кривой Серпинского
function calcZ(i:byte):word;
begin
if i=0 then calcZ:=1
else calcZ:=2*calcZ(i-1)+3;
end;
//процедура рисования отрезка
procedure Linerel(dx,dy:integer);
begin
line(x,y,x+dx,y+dy);
x:=x+dx;y:=y+dy;
end;
//Процедуры рисования наклонных, горизонтальных и вертикальных отрезков кривой
Procedure SegmBC;
begin
linerel(h,h);
end;
Procedure SegmDE;
begin
linerel(-h,h);
end;
Procedure SegmFG;
begin
linerel(-h,-h);
end;
Procedure SegmHA;
begin
linerel(h,-h);
end;
Procedure SegmEast;
begin
linerel(2*h,0);
end;
Procedure SegmSouth;
begin
linerel(0,2*h);
end;
Procedure SegmWest;
begin
linerel(-2*h,0);
end;
Procedure SegmNord;
begin
linerel(0,-2*h);
end;
//Pекурсивные процедуры рисования четырех частей кривой Серпинского
Procedure LineCD(i: byte); forward;
Procedure LineGH(i: byte); forward;
Procedure LineEF(i: byte); forward;
Procedure LineAB(i: byte);
begin
if i>0 then
 begin
  LineAB(i-1); SegmBC; LineCD(i-1); SegmEast;
  LineGH(i-1); SegmHA; LineAB(i-1); //delay(del);
 end
end;
Procedure LineCD(i:byte);
begin
if i>0 then
 begin
  LineCD(i-1); SegmDE; LineEF(i-1); SegmSouth;
  LineAB(i-1); SegmBC; LineCD(i-1);
 end
end;
Procedure LineEF(i: byte);
begin
if i>0 then
 begin
  LineEF(i-1); SegmFG; LineGH(i-1); SegmWest;
  LineCD(i-1); SegmDE; LineEF(i-1);
 end
end;
Procedure LineGH(i: byte);
begin
if i>0 then
 begin
  LineGH(i-1); SegmHA; LineAB(i-1); SegmNord;
  LineEF(i-1); SegmFG; LineGH(i-1);
 end
end;
//процедура рисования кривой заданного порядка цветом с
procedure Draw(n,dx,dy,c:integer);
begin
setpencolor(c);
x:=x0+dx;//смещение от центра
y:=y0+dy;
moveto(x,y); //Ставим графический курсор в начальную точку
//Строим кривую
LineAB(n); SegmBC; LineCD(n); SegmDE;
LineEF(n); SegmFG; LineGH(n); SegmHA;
end;
begin //Основная программа
hidecursor;//уберем курсор
setwindowsize(500,500); ///размер окна
centerwindow;  //по центру экрана
Pra:=85; //85% экрана
n:=5; //максимальный порядок
Hscr:=windowheight+1;
Wscr:=windowwidth+1;//Высота и ширина экрана
A:=Round(PrA/100*Hscr);
Z:=calcZ(n);
//Коэффициент диагонали кривой Серпинского
h:=round(A/(Z+1));//Проекция наклонного отрезка
//Находим координаты левой верхней точки опорного квадрата
Xlu:=Wscr div 2 - a div 2;
Ylu:=Hscr div 2 - a div 2;
//Находим координаты начальной точки кривой
y0:=Ylu; x0:=Xlu+h;
//рисуем последовательно кривые 5..1 порядков
Draw(5,20,20,clRed);
Draw(4,116,116,clBlue);
Draw(3,164,164,clLime);
Draw(2,188,188,clFuchsia);
Draw(1,200,200,clBlack);
end.
Добавлено через 4 минуты
Сдвиги чисто подбором, хотя закономерность явно есть, но думать лень.
0
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
06.01.2017, 12:31  [ТС] 9
Подскажите пожалуйста, получилась вот такая программа, все работает, но нужно, чтобы был виден четкий порядок кривых
Как это сделать?
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
Program Aaa;
Uses GraphABC;
const
power = 5;
var
h, x, y: integer;
function calcZ(i : integer) : integer;
begin
if i=0 then calcZ:=1
else calcZ := 2 * calcZ(i-1) + 3;
end;
procedure DrawSegment(a, b: integer);
begin
Line(x, y, x + a * h, y + b * h);
x := x + a * h;
y := y + b * h;
end;
Procedure LineCD(i: byte); forward;
Procedure LineGH(i: byte); forward;
Procedure LineEF(i: byte); forward;
Procedure LineAB(i: byte);
begin
if i>0 then 
begin
LineAB(i-1); DrawSegment(1, 1); LineCD(i-1); DrawSegment(2, 0);
LineGH(i-1); DrawSegment(1, -1); LineAB(i-1);
end
end;
Procedure LineCD;
begin
if i>0 then 
begin
LineCD(i-1); DrawSegment(-1, 1); LineEF(i-1); DrawSegment(0, 2);
LineAB(i-1); DrawSegment(1, 1); LineCD(i-1);
end
end;
Procedure LineEF;
begin
if i>0 then begin
LineEF(i-1); DrawSegment(-1, -1); LineGH(i-1); DrawSegment(-2, 0);
LineCD(i-1); DrawSegment(-1, 1); LineEF(i-1);
end
end;
Procedure LineGH;
begin
if i>0 then begin
LineGH(i-1); DrawSegment(1, -1); LineAB(i-1); DrawSegment(0, -2);
LineEF(i-1); DrawSegment(-1, -1); LineGH(i-1);
end
end;
begin
h := round(Window.Height/(calcZ(power) + 1));
x := Window.Width div 2 - Window.Height div 2 + h;
y := 0;
moveto(x, y);
LineAB(power); DrawSegment(1, 1); LineCD(power); DrawSegment(-1, 1);
LineEF(power); DrawSegment(-1, -1); LineGH(power); DrawSegment(1, -1);
end.
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
06.01.2017, 12:33 10
Цитата Сообщение от Евгения479 Посмотреть сообщение
тобы был виден четкий порядок кривых
Это Вы об чем?
0
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
06.01.2017, 12:35  [ТС] 11
То есть надо, чтобы было четко видно,что это кривая 1 порядка, это 2 ого и т.д.
Я,честно говоря, не представляю для чего это нужно
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
06.01.2017, 13:11 12
Ну я же уже рисовал Вам, правда там было в простом АВС, вот в .net.
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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
uses graphABC;
var x,y: integer;
    n: byte;
    Xlu,Ylu,Hscr,Wscr,A,x0,y0,h,Z: word;
    PrA:real;
//Функция, рекурсивно вычисляющая коэффициент  диагонали кривой Серпинского
function calcZ(i:byte):word;
begin
if i=0 then calcZ:=1
else calcZ:=2*calcZ(i-1)+3;
end;
//процедура рисования отрезка
procedure Linerel(dx,dy:integer);
begin
line(x,y,x+dx,y+dy);
x:=x+dx;y:=y+dy;
end;
//Процедуры рисования наклонных, горизонтальных и вертикальных отрезков кривой
Procedure SegmBC;
begin
linerel(h,h);
end;
Procedure SegmDE;
begin
linerel(-h,h);
end;
Procedure SegmFG;
begin
linerel(-h,-h);
end;
Procedure SegmHA;
begin
linerel(h,-h);
end;
Procedure SegmEast;
begin
linerel(2*h,0);
end;
Procedure SegmSouth;
begin
linerel(0,2*h);
end;
Procedure SegmWest;
begin
linerel(-2*h,0);
end;
Procedure SegmNord;
begin
linerel(0,-2*h);
end;
//Pекурсивные процедуры рисования четырех частей кривой Серпинского
Procedure LineCD(i: byte); forward;
Procedure LineGH(i: byte); forward;
Procedure LineEF(i: byte); forward;
Procedure LineAB(i: byte);
begin
if i>0 then
 begin
  LineAB(i-1); SegmBC; LineCD(i-1); SegmEast;
  LineGH(i-1); SegmHA; LineAB(i-1); //delay(del);
 end
end;
Procedure LineCD(i:byte);
begin
if i>0 then
 begin
  LineCD(i-1); SegmDE; LineEF(i-1); SegmSouth;
  LineAB(i-1); SegmBC; LineCD(i-1);
 end
end;
Procedure LineEF(i: byte);
begin
if i>0 then
 begin
  LineEF(i-1); SegmFG; LineGH(i-1); SegmWest;
  LineCD(i-1); SegmDE; LineEF(i-1);
 end
end;
Procedure LineGH(i: byte);
begin
if i>0 then
 begin
  LineGH(i-1); SegmHA; LineAB(i-1); SegmNord;
  LineEF(i-1); SegmFG; LineGH(i-1);
 end
end;
//процедура рисования кривой заданного порядка цветом с
procedure Draw(n,dx,dy:integer;c:Color);
begin
setpencolor(c);
x:=x0+dx;//смещение от центра
y:=y0+dy;
moveto(x,y); //Ставим графический курсор в начальную точку
//Строим кривую
LineAB(n); SegmBC; LineCD(n); SegmDE;
LineEF(n); SegmFG; LineGH(n); SegmHA;
end;
begin //Основная программа
setwindowsize(500,500); ///размер окна
centerwindow;  //по центру экрана
Pra:=85; //85% экрана
n:=5; //максимальный порядок
Hscr:=windowheight+1;
Wscr:=windowwidth+1;//Высота и ширина экрана
A:=Round(PrA/100*Hscr);
Z:=calcZ(n);
//Коэффициент диагонали кривой Серпинского
h:=round(A/(Z+1));//Проекция наклонного отрезка
//Находим координаты левой верхней точки опорного квадрата
Xlu:=Wscr div 2 - a div 2;
Ylu:=Hscr div 2 - a div 2;
//Находим координаты начальной точки кривой
y0:=Ylu; x0:=Xlu+h;
//рисуем последовательно кривые 5..1 порядков
Draw(5,20,20,clRed);
Draw(4,116,116,clBlue);
Draw(3,164,164,clLime);
Draw(2,188,188,clFuchsia);
Draw(1,200,200,clBlack);
end.
Добавлено через 1 минуту
Постарайтесь переделать свою программу под эту идею, мне как-то разбирать чужой код, когда уже есть свой, влом.
1
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
06.01.2017, 13:25  [ТС] 13
спасибо огромное)
очень помогло
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
06.01.2017, 13:53 14
Лучший ответ Сообщение было отмечено Евгения479 как решение

Решение

Вот сделал на основе Вашего кода.
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
77
78
79
80
81
82
83
84
85
86
87
uses GraphABC;
const power = 5;
cv:array[1..power] of Color=(clRed,clBlue,clGreen,clLime,clBrown);
var h, x, y: integer;
function calcZ(i : integer) : integer;
begin
if i=0 then calcZ:=1
else calcZ := 2 * calcZ(i-1) + 3;
end;
procedure DrawSegment(a, b: integer);
begin
Line(x, y, x + a * h, y + b * h);
x := x + a * h;
y := y + b * h;
end;
Procedure LineCD(i: byte); forward;
Procedure LineGH(i: byte); forward;
Procedure LineEF(i: byte); forward;
Procedure LineAB(i: byte);
begin
if i>0 then
begin
LineAB(i-1); DrawSegment(1, 1); LineCD(i-1); DrawSegment(2, 0);
LineGH(i-1); DrawSegment(1, -1); 
LineAB(i-1);
end
end;
Procedure LineCD;
begin
if i>0 then
begin
LineCD(i-1); DrawSegment(-1, 1); LineEF(i-1); DrawSegment(0, 2);
LineAB(i-1); DrawSegment(1, 1); LineCD(i-1);
end
end;
Procedure LineEF;
begin
if i>0 then begin
LineEF(i-1); DrawSegment(-1, -1); LineGH(i-1); DrawSegment(-2, 0);
LineCD(i-1); DrawSegment(-1, 1); LineEF(i-1);
end
end;
Procedure LineGH;
begin
if i>0 then begin
LineGH(i-1); DrawSegment(1, -1); LineAB(i-1); DrawSegment(0, -2);
LineEF(i-1); DrawSegment(-1, -1); LineGH(i-1);
end
end;
var i,d:byte;
begin
setwindowsize(600,600);
centerwindow;
h := round(Window.Height/(calcZ(power)+30));
x := 50;//Window.Width div 2 - Window.Height div 2 + h;
y := 50;
moveto(x, y);
d:=32*h;
for i:=power downto 1 do
 begin
  setpencolor(cv[i]);
  LineAB(i); DrawSegment(1,1); LineCD(i); DrawSegment(-1,1);
  LineEF(i); DrawSegment(-1,-1); LineGH(i); DrawSegment(1,-1);
  case i of
  5:begin
    x:=x+d;
    y:=y+d;
    d:=d div 2;
    end;
  4:begin
    x:=x+d;
    y:=y+d;
    d:=d div 2;
    end;
  3:begin
    x:=x+d;
    y:=y+d;
    d:=d div 2;
    end;
  2:begin
    x:=x+d;
    y:=y+d;
    end;
  end;
 textout(10,10,inttostr(h)); 
 end; 
end.
1
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
06.01.2017, 13:59  [ТС] 15
Спасибо еще раз)
Вы, правда очень мне помогли)
0
Модератор
63400 / 47085 / 32454
Регистрация: 18.05.2008
Сообщений: 114,134
06.01.2017, 14:08 16
Строку 85 уберите, это я для проверки делал.
0
1 / 1 / 0
Регистрация: 30.09.2016
Сообщений: 46
06.01.2017, 14:12  [ТС] 17
Хорошо,спасибо)
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
06.01.2017, 14:12

Заказываю контрольные, курсовые, дипломные работы и диссертации здесь.

Кривые Безье
Добрый вечер! Помогите, пожалуйста! Никак не могу разобраться с кривыми Безье :cry: Мне нужно...

Кривые Гаджеты
После утоления Касперского гаджеты стали кривыми.С чем это связанно и как исправить ошибку?

Кривые Пирсона
Добрый день. пишу небольшую программку, которая должна рисовать кривые Пирсона. имеются входные...

полиномиальные кривые
Здравствуйте! Задание: Z-функции (zmf), PI-функции (pimf) и S-функции (smf). Функция zmf...


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

Или воспользуйтесь поиском по форуму:
17
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.