Программа для решения дифференциальных уравнений первого порядка методом Рунге-Кутта

ShowMessage('введите Y(x1) неравное -X1');

RadioGroup1.Enabled:=False;

RadioGroup1.ItemIndex:=31;

end

else

begin

Memo4.Clear;

Memo4.Lines.Add('(3.4-x*y)/(x+y) ');

f:=(3.4-x_rg*y_rg)/(x_rg+y_rg);

Memo3.lines.Add(''+floattostr(f));

Button1.Enabled:=True;

RadioGroup1.Enabled:=False;

RadioGroup1.ItemIndex:=31;

end;

end;

{------------------------------------------------------------------------------}

if RadioGroup1.ItemIndex=29 then

begin

if y_rg=0 then

begin

ShowMessage('введите Y(x1) не равное 0');

RadioGroup1.Enabled:=False;

RadioGroup1.ItemIndex:=31;

end

else

begin

Memo4.Clear;

Memo4.Lines.Add('y-2x/y ');

f:=y_rg-2*x_rg/y_rg;

Memo3.lines.Add(''+floattostr(f));

Button1.Enabled:=True;

RadioGroup1.Enabled:=False;

RadioGroup1.ItemIndex:=31;

end;

end;

{------------------------------------------------------------------------------}

if RadioGroup1.ItemIndex=30 then

begin

if y_rg=0 then

begin

ShowMessage('введите Y(x1) не равное 0');

RadioGroup1.Enabled:=False;

RadioGroup1.ItemIndex:=31;

end

else

begin

Memo4.Clear;

Memo4.Lines.Add(' x/y ');

f:=x_rg/y_rg;

Memo3.lines.Add(''+floattostr(f));

Button1.Enabled:=True;

RadioGroup1.Enabled:=False;

RadioGroup1.ItemIndex:=31;

end;

end

{------------------------------------------------------------------------------}

except

on EConvertError do // невозможно преобразовать строку символов в число

begin

MessageDlg('Некорректные значения переменных',mtError,[mbOk],0);

exit;

end;

end;

end;

//------------------------------------------------------------------------------

{Активация ввода образцовых функций}

procedure TRKutta.Button5Click(Sender: TObject);

begin

memo4.clear;

memo3.clear;

RadioGroup1.Enabled:=True; memo1.clear;memo2.Clear;memo3.clear;

memo3.lines.Add(''+floattostr(f));

end;

//------------------------------------------------------------------------------

{Деактивация ввода образцовых функций}

procedure TRKutta.Button6Click(Sender: TObject);

begin

RadioGroup1.Enabled:=False;

Memo3.lines.Add(''+floattostr(f));

end;

//------------------------------------------------------------------------------

{Вывод информации о программе}

procedure TRKutta.N7Click(Sender: TObject);

begin

Form3.ShowModal;

end;

//------------------------------------------------------------------------------

end.

{====================================================}

unit RngeKutta;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs,StdCtrls,Rkt,Menus;

type

TRungeKutta=class(TObject)

constructor CreateGr(var hzx:array of real;var hzy:array of real;var lin_arr:integer);

private

{ Private declarations }

public

{ Public declarations }

x0,y0:integer; //координаты начала координатных осей, 2*x0,2*y0 - высота

// и ширина области вывода координатной сетки

dx,dy:integer; // шаг координатной сетки (в пикселях)

y1,y2,xP,xL:integer;// засечки по оси Y и X

dlx,dly:real; // шаг меток (оцифровки) линий сетки по X и Y

cross:integer; // счетчик неоцифрованных линий сетки

dcross:integer; // количество неоцифрованных линий между оцифрованными

BaseMasht_X,BaseMasht_Y:extended; //МАХ значения элементов в массивах

razm:integer;

uzx:array of real; //Динамический массив координат-X

uzy:array of real; //Динамический массив координат-Y

uxc,uyc:extended; // Оцифровка по осям

mx,my:extended;

function MaxAbsElementArray(arr:array of real;razmer:integer):real;

procedure UstanovkaParametrov();

procedure KoordPloskost;

end;

TForm2 = class(TForm)

MainMenu1: TMainMenu;

N4: TMenuItem;

N5: TMenuItem;

procedure N4Click(Sender: TObject);

procedure N5Click(Sender: TObject);

private

{ Private declarations }

RungeKutta:TRungeKutta; //Объявление переменной - объекта класса

public

{ Public declarations }

end;

var

Form2: TForm2;

implementation

{$R *.dfm}

function TRungeKutta.MaxAbsElementArray(arr:array of real;razmer:integer):real;

var i:integer;

max:real;

begin

i:=1;

max:=arr[1];

while i<>razmer do

begin

i:=i+1;

if abs(arr[i])>max then

begin

max:=abs(arr[i]);

end;

end;

MaxAbsElementArray:=max;

end;

//------------------------------------------------------------------------------

procedure TRungeKutta.UstanovkaParametrov();

begin

//определение max абсолютного значения функции (ордината)

BaseMasht_Y:=MaxAbsElementArray(uzy,razm)+1;

//определение max абсолютного значения аргумента функции (абсцисса)

BaseMasht_X:=MaxAbsElementArray(uzx,razm);

y0:=round(Form2.ClientHeight/2); // оси начинаются в точке (X0,Y0)

x0:=round(Form2.ClientWidth/2);

dcross:=1; // помечать линии сетки X: 1 - каждую;

// 2 - через одну;

// 3 - через две;

dlx:=round(BaseMasht_X)/10; // вес меток оси X

dly:=round(BaseMasht_Y)/10; // вес меток оси Y ,

dx:=round(x0/10); // шаг координатной сетки в пикселях

dy:=round(y0/10); // шаг координатной сетки в пикселях

mx:=round(x0/round(BaseMasht_X)+1);//вычисление масштаба по оси X

my:=round(y0/round(BaseMasht_Y)+1);//вычисление масштаба по оси Y

end;

//------------------------------------------------------------------------------

procedure TRungeKutta.KoordPloskost;

begin

uxc:=0;

uyc:=0;

with form2.Canvas do

begin

cross:=dcross;

//------------------------------------------------------------------------------

//Нанесение засечек и оцифровка координатных осей I,II квадрантов

// засечки и оцифровка по оси X

xP:=x0;

xL:=x0;

repeat

MoveTo(xP,y0-2);LineTo(xP,y0+2); // засечка

MoveTo(xL,y0-2);LineTo(xL,y0+2); // засечка

cross:=cross-1;

if cross = 0 then //оцифровка

begin

TextOut(xP-8,y0+3,FloatToStr(uxc));

TextOut(xL-8,y0+3,FloatToStr(-uxc));

cross:=dcross;

uxc:=uxc+dlx;

end;

Pen.Style:=psDot;

MoveTo(xP,2*y0);LineTo(xP,-2*y0); // линия сетки

MoveTo(xL,2*y0);LineTo(xL,-2*y0);

Pen.Style:=psSolid;

xP:=xP+dx;

xL:=xL-dx;

until (xP>2*x0);

//------------------------------------------------------------------------------

//Нанесение засечек и оцифровка координатных осей III, IV квадрантов

// засечки, и оцифровка по оси Y

y1:=y0-dy;

y2:=y0+dy;

repeat

MoveTo(x0-2,y1);LineTo(x0+2,y1); // засечка

MoveTo(x0-2,y2);LineTo(x0+2,y2);

uyc:=uyc+dly;

TextOut(x0-20,y1,FloatToStr(uyc)); // оцифровка

TextOut(x0-20,y2,FloatToStr(-uyc));

Pen.Style:=psDot;

MoveTo(10,y1);LineTo(2*x0-10,y1); // линия сетки

MoveTo(10,y2);LineTo(2*x0-10,y2);

Pen.Style:=psSolid;

y2:=y2+dy;

y1:=y1-dy;

until (y2>2*y0);

//------------------------------------------------------------------------------

MoveTo(x0,2*y0); LineTo(x0,0); // ось Y

MoveTo(0,y0); LineTo(2*x0,y0); // ось X

end;

end;

//-----------------------------------------------------------------------------

//создание объекта (график функции, координатная сетка, координатные оси)

constructor TRungeKutta.CreateGr(var hzx:array of real;var hzy:array of real;var lin_arr:integer);

var n:integer;

begin

SetLength(uzx,lin_arr); //Установка размера массива uzx

SetLength(uzy,lin_arr); //Установка размера массива uzy

razm:= lin_arr;

for n:=0 to lin_arr do

begin

uzx[n]:=hzx[n]; //инициализация массива uzx

uzy[n]:=hzy[n]; //инициализация массива uzy

end;

UstanovkaParametrov;

KoordPloskost;

for n:=0 to (lin_arr-1) do

begin

form2.canvas.Pixels[(x0+ROUND(uzx[n]*mx)),(y0-round((uzy[n]*my)))]:=clRed;

end;

end;

//------------------------------------------------------------------------------

{Процедура N4Click выводит график функции в установленном масштабе в окне 'График' }

procedure TForm2.N4Click(Sender: TObject);

begin

form2.Canvas.FillRect(Rect(0,0,ClientWidth,ClientHeight));

TRungeKutta.CreateGr(zx,zy,line_arr);

end;

//------------------------------------------------------------------------------

{Процедура N5Click закрывает окно вывода графика функции - результата решния ДУ }

procedure TForm2.N5Click(Sender: TObject);

begin

close;

end;

end.

{====================================================}

Unit Spravka;

interface

uses

Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,

Dialogs, ExtCtrls, StdCtrls;

type

TForm3 = class(TForm)

Panel1: TPanel;

Label1: TLabel;

Button1: TButton;

Label2: TLabel;

Label3: TLabel;

Label4: TLabel;

Label5: TLabel;

Label7: TLabel;

Label8: TLabel;

Label9: TLabel;

Label10: TLabel;

Label6: TLabel;

Label11: TLabel;

Label12: TLabel;

Label13: TLabel;

Label14: TLabel;

procedure Button1Click(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form3: TForm3;

implementation

{$R *.dfm}

//------------------------------------------------------------------------------

{Ввывод информации о программе}

procedure TForm3.Button1Click(Sender: TObject);

begin

Caption := 'OK';

ModalResult := mrOK;

OnClick := Button1Click;

end;

end.

{===============================================}

7. РЕШЕНИЕ ДИФФЕРЕНЦИАЛЬНОГО УРАВНЕНИЯ Y = Y?2X/Y МЕТОДОМ РУНГЕ - КУТТА В СРЕДЕ EXCEL

дифференциальное уравнение программирование

2. Решение дифференциального уравнения Y = Y?2X/Y программой «РЕШЕНИЕ ОДУ» показано на рис. 5 и рис. 6.(стр. 22 - 23 )

ВЫВОД

Программа «Решение ОДУ» решает заданные дифференциальные уравнения первой степени с достаточно высокой степенью точности.

Размещено на Allbest.ru