Другие языки программирования и технологии
люди добрые помогите мне написать программу в паскале, метод Рунге Кутта. Математическое решение есть у меня
Его нужно реализовать в Паскале. Пожалуйста не умничайте а помогите. Если надо я заплачу
Отправил на почту
{$N+}
{$D-}
Uses Graph, CRT;
const
t0 : Extended = 0.0 ;
x0 : Extended = 10.0 ;
b : Extended = 6.0 ;
h0 : Extended = 0.5 ;
ScaleX : Extended = 0.53 ;
ScaleT : Extended = 100.0 ;
var
D, R, e : Integer;
i : Integer;
N : Byte;
x, t, h, C, C1, C2, C3, C4 : Extended;
delta, tt : Extended;
{ ^ }
xk {x}, x1, k1, k2, k3, k4, S, eps {epsilon} : Extended;
SSS : String;
{-=-=-=-=-=-=-=-=-=-=-=-=-}
Function f(t, x : Extended) : Extended;{Интегрируемая функция}
begin
f:= -2*(t-2.0)*x + Exp(-t*t+4.0*t)*(2.0*t+1.0);
end;
{_+_+_+_+_+_+_+_+_+_+_+_+_+_+_}
Function ff(t : Extended) : Extended;{Аналитическое решение}
begin
ff:= (t*(t+1.0)+10.0)*exp(-t*(t-4.0));
end;
{[][][[][[][][][][][][][][]}
Procedure View(tr, Anr, RKr : Extended);
begin
Str(tr:5:5, SSS);
OutTextXY(350, 10+N*14, SSS);
Str(Anr:5:5, SSS);
OutTextXY(430, 10+N*14, SSS);
Str(RKr:5:5, SSS);
OutTextXY(540, 10+N*14, SSS)
end;
{-----------------------}
Procedure DoScreen;
begin
ClearViewPort;
SetColor(DarkGray);
MoveTo(0, 477);
LineTo(640, 477);
LineTo(630, 475);
LineTo(630, 479);
LineTo(640, 477);
MoveTo(2, 480);
LineTo(2, 0);
LineTo(0, 10);
LineTo(4, 10);
LineTo(2, 0);
SetColor(LightGray);
for i := 0 to 6 do Line(i*100+2, 476, i*100+2, 478);
for i := 0 to 8 do Line(1, i*53+3, 3, i*53+3);
SetColor(White); { (0, 0) equ (2, 477) }
OutTextXY(9, 425, '100');
OutTextXY(9, 371, '200');
OutTextXY(9, 319, '300');
OutTextXY(9, 264, '400');
OutTextXY(9, 212, '500');
OutTextXY(9, 160, '600');
OutTextXY(9, 105, '700');
OutTextXY(9, 53, '800');
OutTextXY(99, 465, '1');
OutTextXY(199, 465, '2');
OutTextXY(299, 465, '3');
OutTextXY(399, 465, '4');
OutTextXY(499, 465, '5');
OutTextXY(630, 465, 't');
OutTextXY(9, 3, 'x');
OutTextXY(9, 465, '0');
OutTextXY(599, 465, '6');
end;
{ Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы }
begin
D:=Detect;
InitGraph(D,R,'');
e:=GraphResult;
if e <> 0 then
begin
WriteLn('Ошибка графики (', e, '):');
WriteLn(GraphErrorMsg(e));
Halt;
end;
eps := 0.5E-3 ;
t := t0-0.5;
DoScreen;
C := exp(4.0)*(49766.0/4913.0);
C1:=56.0/289.0;
C2:=106.0/289.0;
C3:=646.0/4913.0;
C4:=4445.0/4913.0;
SetColor(Yellow);
OutTextXY(350, 1, 't Выч. значение Прибл. значение');
While (t<=b+0.5) do
begin
x:=ff(t);
t := t+0.001;
PutPixel(Round(2.0+ScaleT*t),Round(477.0-ScaleX*x), Yellow);
end;
x := x0;
t := t0;
h := h0;
N := 1;
While t <= b do
begin
Repeat
tt := t+h/2.0;
k1 := h * f(t, x)/2.0;
k2 := h * f(t+h/2.0, x+k1/2.0)/2.0;
k3 := h * f(t+h/2.0, x+k2/2.0)/2.0;
k4 := h * f(t+h, x+k3)/2.0;
S := (k1+2.0*k2+2.0*k3+k4)/6.0;
x1 := x + S;
k1 := h * f(tt, x)/2.0;
k2 := h * f(tt+h/4.0, x+k1/2.0)/2.0;
k3 := h * f(tt+h/4.0, x+k2/2.0)/2.0;
k4 := h * f(tt+h/2.0, x+k3)/2.0;
S := (k1+2.0*k2+2.0*k3+k4)/6.0;
xk := x1 + S;
delta := Abs((xk-x)/15.0);
if delta>eps then
h := h/2.0;
Until delta<= 24 then
begin
View(t, ff(t), x);
inc(N);
end;
PutPixel(Round(2+ScaleT*t),Round(477-ScaleX*x), Magenta);
end;
ReadKey;
CloseGraph;
end.
{$D-}
Uses Graph, CRT;
const
t0 : Extended = 0.0 ;
x0 : Extended = 10.0 ;
b : Extended = 6.0 ;
h0 : Extended = 0.5 ;
ScaleX : Extended = 0.53 ;
ScaleT : Extended = 100.0 ;
var
D, R, e : Integer;
i : Integer;
N : Byte;
x, t, h, C, C1, C2, C3, C4 : Extended;
delta, tt : Extended;
{ ^ }
xk {x}, x1, k1, k2, k3, k4, S, eps {epsilon} : Extended;
SSS : String;
{-=-=-=-=-=-=-=-=-=-=-=-=-}
Function f(t, x : Extended) : Extended;{Интегрируемая функция}
begin
f:= -2*(t-2.0)*x + Exp(-t*t+4.0*t)*(2.0*t+1.0);
end;
{_+_+_+_+_+_+_+_+_+_+_+_+_+_+_}
Function ff(t : Extended) : Extended;{Аналитическое решение}
begin
ff:= (t*(t+1.0)+10.0)*exp(-t*(t-4.0));
end;
{[][][[][[][][][][][][][][]}
Procedure View(tr, Anr, RKr : Extended);
begin
Str(tr:5:5, SSS);
OutTextXY(350, 10+N*14, SSS);
Str(Anr:5:5, SSS);
OutTextXY(430, 10+N*14, SSS);
Str(RKr:5:5, SSS);
OutTextXY(540, 10+N*14, SSS)
end;
{-----------------------}
Procedure DoScreen;
begin
ClearViewPort;
SetColor(DarkGray);
MoveTo(0, 477);
LineTo(640, 477);
LineTo(630, 475);
LineTo(630, 479);
LineTo(640, 477);
MoveTo(2, 480);
LineTo(2, 0);
LineTo(0, 10);
LineTo(4, 10);
LineTo(2, 0);
SetColor(LightGray);
for i := 0 to 6 do Line(i*100+2, 476, i*100+2, 478);
for i := 0 to 8 do Line(1, i*53+3, 3, i*53+3);
SetColor(White); { (0, 0) equ (2, 477) }
OutTextXY(9, 425, '100');
OutTextXY(9, 371, '200');
OutTextXY(9, 319, '300');
OutTextXY(9, 264, '400');
OutTextXY(9, 212, '500');
OutTextXY(9, 160, '600');
OutTextXY(9, 105, '700');
OutTextXY(9, 53, '800');
OutTextXY(99, 465, '1');
OutTextXY(199, 465, '2');
OutTextXY(299, 465, '3');
OutTextXY(399, 465, '4');
OutTextXY(499, 465, '5');
OutTextXY(630, 465, 't');
OutTextXY(9, 3, 'x');
OutTextXY(9, 465, '0');
OutTextXY(599, 465, '6');
end;
{ Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы=Ы }
begin
D:=Detect;
InitGraph(D,R,'');
e:=GraphResult;
if e <> 0 then
begin
WriteLn('Ошибка графики (', e, '):');
WriteLn(GraphErrorMsg(e));
Halt;
end;
eps := 0.5E-3 ;
t := t0-0.5;
DoScreen;
C := exp(4.0)*(49766.0/4913.0);
C1:=56.0/289.0;
C2:=106.0/289.0;
C3:=646.0/4913.0;
C4:=4445.0/4913.0;
SetColor(Yellow);
OutTextXY(350, 1, 't Выч. значение Прибл. значение');
While (t<=b+0.5) do
begin
x:=ff(t);
t := t+0.001;
PutPixel(Round(2.0+ScaleT*t),Round(477.0-ScaleX*x), Yellow);
end;
x := x0;
t := t0;
h := h0;
N := 1;
While t <= b do
begin
Repeat
tt := t+h/2.0;
k1 := h * f(t, x)/2.0;
k2 := h * f(t+h/2.0, x+k1/2.0)/2.0;
k3 := h * f(t+h/2.0, x+k2/2.0)/2.0;
k4 := h * f(t+h, x+k3)/2.0;
S := (k1+2.0*k2+2.0*k3+k4)/6.0;
x1 := x + S;
k1 := h * f(tt, x)/2.0;
k2 := h * f(tt+h/4.0, x+k1/2.0)/2.0;
k3 := h * f(tt+h/4.0, x+k2/2.0)/2.0;
k4 := h * f(tt+h/2.0, x+k3)/2.0;
S := (k1+2.0*k2+2.0*k3+k4)/6.0;
xk := x1 + S;
delta := Abs((xk-x)/15.0);
if delta>eps then
h := h/2.0;
Until delta<= 24 then
begin
View(t, ff(t), x);
inc(N);
end;
PutPixel(Round(2+ScaleT*t),Round(477-ScaleX*x), Magenta);
end;
ReadKey;
CloseGraph;
end.
Похожие вопросы
- Помогите пожалуйста написать программу в Паскале )) Написать программу для вычисления суммы в массиве из 10 элементов
- Помогите, пожалуйста, написать программу на Паскале хотя бы примерно
- Программирование на Паскале Помогите, пожалуйста , написать программу на паскале
- Помогите пожалуйста написать программу для Паскаля
- помогите плиз написать программу на паскале...тема массивы...нужно использовать поиск деления пополам!!!нужно срочно!
- Помогите пожалуйста написать программу на паскале:
- помогите, пожалуйста, написать программу в паскале! сложные циклы.
- Срочно.Помогите пожалуйста написать программу на паскале.
- может помочь мне написать программу на VBA? Благодарность не меньше 200р. Решение кубических уравнений!!!
- Нужно написать программы в Паскале! Массивы! Срочно! Помогите!