переписать на PascalABC

@Ksenia S · Регистрация: 05.10.2013

Студворк — интернет-сервис помощи студентам

Добавлено через 9 минут
Помогите, пожалуйста, переписать на PascalABC)

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
Program Pod_Uglom;
Uses Crt, Graph;
Type G = array [1..4] of real;
Const A=0; B=0.1; {параметры модели}
Al=pi/4; {угол - параметр модели}
H=0.001; Hpr=0.1; {шаг интегрирования и шаг вывода результатов}
Var N , I , J, M, L , K: integer;
Y0, Y: G; X0,  X, Xpr, A1, B1, Cosinus, Sinus: real; LS: string;
Function Ff ( I: integer; X: real; Y:G): real;
{описание правых частей дифференциальных уравнений}
Begin
Case I of
1: Ff:=-A1*sinus*Y[1]-B1*sinus*sqrt(sqr(Y[1])+ sqr(Y[2]))*Y[1];
2: Ff:=-sinus-A1*sinus*Y[1]-B1*sinus*sqrt(sqr(Y[1])+ sqr(Y[2]))*Y[2];
3: Ff:= Y[1]/(2*cosinus);
4: Ff:= 2*Y[2]/sinus
end
end;
Procedure Runge_Kut (N: Integer; Var X: real; Y0: G; Var Y: G; H: real);
{метод Рунге-Кутта четвертого порядка}
Var I: Integer; Z, K1, K2, K3, K4: G;
Procedure Right (X: real; Y: G; Var F:G);
{вычисление правых частей дифференциальных уравнений}
Var I : Integer;
Begin
For I:=1 to N do F[I] := Ff(I, X, Y)
End;
Begin Right (X, Y0, K1); X:=X + H/2;
For I:=1 to  N do Z[I]:=Y0[I]+H*K1[I]/2; Right ( X, Z, K2);
For I:=1 to  N do Z[I]:=Y0[I]+H*K2[I]/2; Right ( X, Z, K3); X:=X+H/2;
For I:=1 to  N do Z[I]:=Y0[I]+H*K3[I]; Right ( X, Z, K4);
For I:=1 to  N do Y[I]:=Y0[I]+H*(K1[I]+2*K2[I]+2*K3[I]+K4[I])/6;
End;
{следующий блок - для получения численных результатов при одном наборе параметров}
{Begin
Sinus :=sin(al); cosinus:= cos(al); a1:=A; B1:=B; ClrScr;
N:=4; X0:=0; Y0[1]:=cosinus; Y0[2]:=sinus; Y0[3]:=0; Y0[4]:=0;
writeln (' время с к о р о с т ь к о о р д и н а т ы  ');
Writeln; X:=X0;  Xpr:=0; Y[4] :=Y0[4];
While Y[4]>=0 do
Begin
If X>=Xpr then
Begin
Writeln ('t=' , X:6:3, 'Vx=' , Y0[1]:6:3, 'Vy=' , Y0[2]:6:3, ' X=' , y0[3]:6:3, 'Y=' , Y0[4]:6:3);
Xpr:=Xpr+Hpr
End;
Runge_Kut (N, X, Y0, Y, H); Y0:=Y
End;
Writeln;
Writeln ('для продолжения нажмите любую клавишу ');
Repeat Until KeyPressed
End.}
{следующий блок - для изображения траекторий при нескольких наборах параметров}
Begin
DetectGraph (J, M); InitGraph (J, M, ' ');
L:=1; A1:=A; B1:=B; Sinus:=sin(Al); Cosinus:=cos(Al);
While L < 5 do
Begin
N:=4; {количество уравнений в системе}
X0:=0; Y0[1]:=cosinus;{начальные условия}
Y0[2]:=sinus; Y0[3]:=0; Y0[4]:=0;
SetColor(L); Line (400, 50+20*(L-1), 440, 50+20*(L-1));
OutTextXY (450, 50+20*(L-1), ' l=' );
Str (L, LS); OutTextXY (480, 50+20*(L-1), LS); X:=X0; Y[4]:=Y0[4];
While Y[4]>=0 do
Begin
Runge_Kut (N, X, Y0, Y, H); Y0:=Y;
PutPixel (Abs (Trunc (Y0[3]*500)), GetMaxY-Abs (Trunc(Y0[4]*500)) , L) ;
End;
B1:=B1*10; L:=L+1
End;
OutTextXY (10 , 50, 'для продолжения нажмите любую клавишу') ;
Repeat Until KeyPressed; CloseGraph
End.

@Puporev · 29.11.2013, 12:19

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
Program Pod_Uglom;
Uses GraphABC;
Type G = array [1..4] of real;
Const A=0; B=0.1; {параметры модели}
Al=pi/4; {угол - параметр модели}
H=0.001; Hpr=0.1; {шаг интегрирования и шаг вывода результатов}
Cl:array[1..4] of integer=(clBlue,clGreen,clFuchsia,clRed);
Var N , I , J, M, L , K: integer;
Y0, Y: G; X0, X, Xpr, A1, B1, Cosinus, Sinus: real;
LS: string;
Function Ff ( I: integer; X: real; Y:G): real;
{описание правых частей дифференциальных уравнений}
Begin
Case I of
1: Ff:=-A1*sinus*Y[1]-B1*sinus*sqrt(sqr(Y[1])+ sqr(Y[2]))*Y[1];
2: Ff:=-sinus-A1*sinus*Y[1]-B1*sinus*sqrt(sqr(Y[1])+ sqr(Y[2]))*Y[2];
3: Ff:= Y[1]/(2*cosinus);
4: Ff:= 2*Y[2]/sinus
end
end;
Procedure Runge_Kut (N: Integer; Var X: real; Y0: G; Var Y: G; H: real);
{метод Рунге-Кутта четвертого порядка}
Var I: Integer; Z, K1, K2, K3, K4: G;
Procedure Right (X: real; Y: G; Var F:G);
{вычисление правых частей дифференциальных уравнений}
Var I : Integer;
Begin
For I:=1 to N do F[I] := Ff(I, X, Y)
End;
Begin Right (X, Y0, K1); X:=X + H/2;
For I:=1 to N do Z[I]:=Y0[I]+H*K1[I]/2; Right ( X, Z, K2);
For I:=1 to N do Z[I]:=Y0[I]+H*K2[I]/2; Right ( X, Z, K3); X:=X+H/2;
For I:=1 to N do Z[I]:=Y0[I]+H*K3[I]; Right ( X, Z, K4);
For I:=1 to N do Y[I]:=Y0[I]+H*(K1[I]+2*K2[I]+2*K3[I]+K4[I])/6;
End;
{следующий блок - для получения численных результатов при одном наборе параметров}
{Begin
Sinus :=sin(al); cosinus:= cos(al); a1:=A; B1:=B; ClrScr;
N:=4; X0:=0; Y0[1]:=cosinus; Y0[2]:=sinus; Y0[3]:=0; Y0[4]:=0;
writeln (' время с к о р о с т ь к о о р д и н а т ы  ');
Writeln; X:=X0;  Xpr:=0; Y[4] :=Y0[4];
While Y[4]>=0 do
Begin
If X>=Xpr then
Begin
Writeln ('t=' , X:6:3, 'Vx=' , Y0[1]:6:3, 'Vy=' , Y0[2]:6:3, ' X=' , y0[3]:6:3, 'Y=' , Y0[4]:6:3);
Xpr:=Xpr+Hpr
End;
Runge_Kut (N, X, Y0, Y, H); Y0:=Y
End;
Writeln;
Writeln ('для продолжения нажмите любую клавишу ');
Repeat Until KeyPressed
End.}
{следующий блок - для изображения траекторий при нескольких наборах параметров}
Begin
L:=1; A1:=A; B1:=B; Sinus:=sin(Al); Cosinus:=cos(Al);
While L < 5 do
Begin
N:=4; {количество уравнений в системе}
X0:=0; Y0[1]:=cosinus;{начальные условия}
Y0[2]:=sinus; Y0[3]:=0; Y0[4]:=0;
SetPenColor(Cl[L]); Line (400, 50+20*(L-1), 440, 50+20*(L-1));
TextOut (450, 50+20*(L-1), ' l=' );
Str (L, LS); TextOut (480, 50+20*(L-1), LS); X:=X0; Y[4]:=Y0[4];
While Y[4]>=0 do
Begin
Runge_Kut (N, X, Y0, Y, H); Y0:=Y;
SetPixel (Abs (Trunc (Y0[3]*500)), WindowHeight-Abs (Trunc(Y0[4]*400)) , Cl[L]) ;
End;
B1:=B1*10; L:=L+1
End;
End.

Новые блоги и статьи Все статьи Все блоги /
1С: Программный отбор элементов справочника по группе Maks 22.03.2026 Установка программного отбора элементов справочника "Номенклатура" из модуля формы документа. В качестве фильтра для отбора справочника служит группа номенклатуры. Отбор по наименованию группы. . .	Как я обхитрил таблицу Word Alexander-7 21.03.2026 Когда мигает курсор у внешнего края таблицы, и нам надо перейти на новую строку, а при нажатии Enter создается новый ряд таблицы с ячейками, то мы вместо нервных нажатий Энтеров мы пишем любые буквы. . .	Krabik - рыболовный бот для WoW 3.3.5a AmbA 21.03.2026 без регистрации и смс. Это не торговля, приложение не содержит рекламы. Выполняет свою непосредственную задачу - автоматизацию рыбалки в WoW - и ничего более. Однако если админы будут против -. . .	1С: Программный отбор элементов справочника по значению перечисления Maks 21.03.2026 Установка программного отбора элементов справочника "Сотрудники" из модуля формы документа. В качестве фильтра для отбора служит предопределенное значение перечислений. Процедура. . .
Переходник USB-CAN-GPIO Eddy_Em 20.03.2026 Достаточно давно на работе возникла необходимость в переходнике CAN-USB с гальваноразвязкой, оный и был разработан. Однако, все меня терзала совесть, что аж 48-ногий МК используется так тупо: просто. . .	Оттенки серого Argus19 18.03.2026 Оттенки серого Нашёл в интернете 3 прекрасных модуля: Модуль класса открытия диалога открытия/ сохранения файла на Win32 API; Модуль класса быстрого перекодирования цветного изображения в оттенки. . .	SDL3 для Desktop (MinGW): Рисуем цветные прямоугольники с помощью рисовальщика SDL3 на Си и C++ 8Observer8 17.03.2026 Содержание блога Финальные проекты на Си и на C++: finish-rectangles-sdl3-c. zip finish-rectangles-sdl3-cpp. zip	Символические и жёсткие ссылки в Linux. algri14 15.03.2026 Существует два типа ссылок — символические и жёсткие. Ссылка в Linux — это запись в каталоге, которая может указывать либо на inode «файла-ИСТОЧНИКА», тогда это будет «жёсткая ссылка» (hard link),. . .