Решение

a=-2 b=2 n=8 S=22,579

№6 Решение задачи Коши

y(1,1)=0 x[1.1;1.6] h=0.1

Тексты программ

Метод Эйлера

x– Абсцисса точки искомой функции

y - Ордината точки искомой функции

b – Конечная точка интегрирования

h - Шаг

a - Начальная точка интегрирования

f - Производная

I - Количество вычислений

program eiler;

uses crt;

var x,y,a,b,h:real;i:integer;

function f(x,y:real):real;{Opisanie funkcii}

begin f:= 1-x*x+y;end;

begin

clrscr;

writeln('y-Na4alna9a to4ka y');writeln('a-Na4alna9a to4ka x');

writeln('b-Kone4na9a to4ka x');writeln('h-Shag');

writeln('VVedite y, a, b, h'); readln(y,a,b,h);

x:=a; i:=0;

repeat

i:=i+1;y:=y+h*f(x,y);x:=x+h;writeln('x',i,'=',x:0:2,' ','y',i,'=',y:0:2);

until x>b-1;

readln;

end.

№8 Решение краевой задачи для линейного дифференциального уравнения второго порядка методом конечных разностей.

Рассмотрим линейную краевую задачу

,где , , и непрерывны на [ a, b ].

Разобьем отрезок [ a, b ] на n равных частей длины, или шага

.

Точки разбиения

,

называются узлами, а их совокупность – сеткой на отрезке [ a, b ]. Значения в узлах искомой функции и ее производных обозначим соответственно через

.

Введем обозначения

Заменим производные так называемыми односторонними конечно-разностными отношениями:

Формулы приближенно выражают значения производных во внутренних точках интервала [ a, b ].

№9 Интерполяция

Вариант 5

Х	-2
У

uses crt;

label m1;

const n=6;

var

x,y:array [1..n] of real;

i,z:integer;

yy,yy1,xx:real;

begin

clrscr;

for i:=1 to n do read(x[i]);

for i:=1 to n do read(y[i]);

for i:=1 to n do writeln(y[i]);

m1:

write('xx=');readln(xx);writeln;

for i:=1 to n do begin

yy:=(y[i+1]+y[i])/(x[i+1]/x[i]);

yy1:=yy*(xx-x[i])+y[i];end;

writeln(xx);

writeln(yy);

writeln(' Prodolgit`? 1-yes,2-no');

readln(z);

if z=1 then goto m1 else readkey;

end.

№10 Задачи линейного программирования (ЗЛП)

Определим максимальное значение целевой функции при следующих условиях ограничений:

Программная реализация

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, ExtCtrls;

type

TForm1 = class(TForm)

Label1: TLabel;Label2: TLabel;Edit2: TEdit;Exit: TButton;Button_Next: TButton;

Edit1: TEdit;Button_Prev: TButton;ScrollBox1: TScrollBox;Conditions: TGroupBox;

Label3: TLabel;Extrem: TComboBox;Memo1: TMemo;procedure ExitClick(Sender: TObject);

procedure Button_NextClick(Sender: TObject);procedure Button_PrevClick(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

end;

const

mm = 100; nn = 100;

var

Form1: TForm1;

table_changed,done,solve,is_ok,kanon,need_basis,need_i_basis,is_basis,written: boolean;

m,n,y,i_basis,i0,j0,step,iter: integer; {m - элементов, n - ограничений}

pole: array [1..nn, 1..mm] of TEdit; {поля для ввода}

podpis: array [0..nn, 0..mm] of TLabel; {подписи полей}

znak: array [1..nn] of TComboBox; {знаки сравнения ограничений}

matrix: array [1..nn, 1..mm] of double; {массив для рассчетов}

all_basis: array [1..nn] of integer; {номера базисных переменных}

f: text; {файловая переменная для отчета}

tochnost: double;

implementation

{$R *.dfm}

procedure Init;

{инициализация: ввод размеров системы}

Begin

form1.Button_Prev.Enabled:=false;

form1.Edit1.Enabled:=true;

form1.Edit2.Enabled:=true;

form1.Extrem.Enabled:=true;

form1.ScrollBox1.DestroyComponents; {расчищаем место под табличку}

table_changed:=true;

tochnost:=0.000000001;

assign(f, 'report.htm');

end;

procedure Step1; {шаг первый: создание таблички и ввод значений}

var

i,j: integer;

nadpis: string;

begin

form1.Memo1.ReadOnly:=false;

form1.Memo1.Lines.Clear;

form1.Memo1.ReadOnly:=true;

form1.Extrem.Enabled:=true;

if table_changed=true then {если меняли количество эл-тов или ограничений,}

begin {то создаем новую табличку}

table_changed:=false;

m:=strtoint(form1.Edit1.Text); {считываем количество переменных}

n:=strtoi

nt(form1.Edit2.Text); {и ограничений}

form1.Edit1.Enabled:=false; {блокируем поля для их ввода}

form1.Edit2.Enabled:=false;

i:=0; {используем нулевую строку массива подписей для заголовков}

for j:=1 to 3 do {подписываем что is что}

begin

podpis[i,j]:=TLabel.Create(Form1.ScrollBox1);

podpis[i,j].parent:=form1.ScrollBox1;

podpis[i,j].Left:=5;

podpis[i,j].Top:=32*(j-1); {расстояние между надписями}

case j of

1: nadpis:='Целевая функция:';

2: nadpis:='F(x)=';

3: nadpis:='Система ограничений:';end;

podpis[i,j].Caption:=nadpis;end;

i:=n+1; {используем последнюю строку массива полей для целевой ф-ции}

for j:=1 to m+1 do

begin

pole[i,j]:=TEdit.Create(Form1.ScrollBox1);

pole[i,j].parent:=form1.ScrollBox1;

pole[i,j].Height:=20;

pole[i,j].Width:=40;

pole[i,j].Left:=80*(j-1)+30;

pole[i,j].Top:=30;

pole[i,j].Text:='0';

if j<=m then

begin

podpis[i,j]:=TLabel.Create(Form1.ScrollBox1);

podpis[i,j].parent:=form1.ScrollBox1;

podpis[i,j].Height:=20;

podpis[i,j].Width:=20;

podpis[i,j].Left:=pole[i,j].Left+pole[i,j].Width+2;

podpis[i,j].Top:=pole[i,j].Top+2;

podpis[i,j].Caption:='X['+inttostr(j)+']';

if j<>m+1 then podpis[i,j].Caption:=podpis[i,j].Caption+' +';

{если поле не последнее, то дописываем плюсик}

end;end;

for i:=1 to n do {поля для ввода ограничений}

for j:=1 to m+1 do

begin

pole[i,j]:=TEdit.Create(Form1.ScrollBox1);

pole[i,j].parent:=form1.ScrollBox1;

pole[i,j].Height:=20;

pole[i,j].Width:=40;

pole[i,j].Left:=80*(j-1)+5; {расстояние между соседними + отступ от края}

pole[i,j].Top:=40*(i-1)+100;

pole[i,j].Text:='0';

if j<=m then

begin

podpis[i,j]:=TLabel.Create(Form1.ScrollBox1);

podpis[i,j].parent:=form1.ScrollBox1;

podpis[i,j].Height:=20;

podpis[i,j].Width:=20;

podpis[i,j].Left:=pole[i,j].Left+pole[i,j].Width+2;

podpis[i,j].Top:=pole[i,j].Top+2;

podpis[i,j].Caption:='X['+inttostr(j)+']';

if j<>m then podpis[i,j].Caption:=podpis[i,j].Caption+' +'

{если поле не последнее, то дописываем плюсик; иначе пишем знак}

else begin

znak[i]:=TComboBox.Create(Form1.ScrollBox1);

znak[i].parent:=form1.ScrollBox1;

znak[i].Height:=20;

znak[i].Width:=40;

znak[i].Left:=podpis[i,j].Left+podpis[i,j].Width+25;

znak[i].Top:=pole[i,j].Top;

znak[i].Items.Insert(0,'> ');

znak[i].Items.Insert(1,'>=');

znak[i].Items.Insert(2,' =');

znak[i].Items.Insert(3,'<=');

znak[i].Items.Insert(4,'< ');

znak[i].ItemIndex:=1;

end;

end else pole[i,j].Left:=pole[i,j].Left+70; //поля для правой части ограничений

end;

end else {если табличку создавать не надо, то разблокируем поля}

begin

for i:=1 to n+1 do

for j:=1 to m+1 do

begin

pole[i,j].Enabled:=true;

if i<=n then znak[i].Enabled:=true;

end;

end;

end;

procedure write_system(strok,stolb: integer); {записывает массив в виде уравнений}

var

i,j: integer;

begin

write(f,'<P>F(x) = ');

for j:=1 to stolb do

begin

write(f,matrix[strok,j]:0:3);

if j<stolb then

begin

write(f,'x_',j,'');

if (kanon=true) and (j=stolb-1) then write(f,' = ') else

if (matrix[strok,j+1]>=0) then write(f,' + ') else write(f,' ');

end;

end;

writeln(f,'</P>');

writeln(f,'<P>При ограничениях:</P><P>');

for i:=1 to strok-1 do

begin

for j:=1 to stolb do

BEGIN

write(f,matrix[i,j]:0:3);

if j<stolb then write(f,'x_',j,' ');

if j=stolb-1 then

if kanon=false then write(f,' ',znak[i].text,' ')

else write(f,' = ');

if (matrix[i,j+1]>=0) and (j<stolb-1) then write(f,'+');end;writeln(f,'<br>'); end;

writeln(f,'</P>');end;

procedure zapisat(strok,stolb: integer; v_strok,v_stolb:integer);{ массив в виде таблички}

var

i,j:integer;

begin

writeln(f,'<TABLE BORDER BORDERCOLOR=black CELLSPACING=0 CELLPADDING=5>');

for i:=0 to strok do

begin

writeln(f,'<TR>');

for j:=1 to stolb+1 do

begin

write(f,'<TD ');

if i=0 then

begin

if (i_basis<>0) and (j>m+y-i_basis) and (j<=m+y) then

write(f,'BGCOLOR=yellow ')

else write(f,'BGCOLOR=green '); end else

if (i=v_strok) or (j=v_stolb) then write(f,'BGCOLOR=silver ') else

if (i=strok) or (j=stolb) then

if (j<>stolb+1) then write(f,'BGCOLOR=olive ');

write(f,'align=');

if (i=0) and (j<stolb) then write(f,'center>X<sub>',j,'<sub>') else

if (i=0) and (j=stolb) then write(f,'center>св. чл.') else

if (i=0) and (j=stolb+1) then write(f,'center>базис') else

if (j=stolb+1) then

if i<>n+1 then write(f,'center>X_{',all_basis[i],'}') else

write(f,'center> ') else

write(f,'right>',matrix[i,j]:1:3); writeln(f,'</TD>'); end; writeln(f,'</TR>'); end;

writeln(f,'</TABLE>'); end;

procedure findved; {ищет ведущий элемент}

var

i,j,k: integer;

temp: double;

begin

done:=false;

solve:=false;

is_ok:=true;

temp:=100000;

i0:=0;

j0:=0;

i:=n+1;

for j:=1 to m+y do

if (i0=0) or (j0=0) then

if matrix[i,j]>0 then

begin

j0:=j;

for k:=1 to n do

if (matrix[k,j]>0) then

if (matrix[k,m+y+1]/matrix[k,j]<temp) then

begin

temp:=matrix[k,m+y+1]/matrix[k,j];

i0:=k; end; end;

if (j0=0) and (i0=0) then

for j:=1 to m do

if matrix[n+1,j]=0 then

for i:=1 to n do

if (matrix[i,j]<>0) and (matrix[i,j]<>1) then

begin

is_ok:=false;

j0:=j; end;

if is_ok=false then

begin

temp:=100000;

for k:=1 to n do

if (matrix[k,j0]>0) then

if (matrix[k,m+y+1]/matrix[k,j0]<temp) then

begin

temp:=matrix[k,m+y+1]/matrix[k,j0];

i0:=k;end;end;

if (j0=0) and (i0=0) then

begin

writeln(f, '<P>Конец вычислений</P>');done:=true;solve:=true;end else if (j0<>0) and (i0=0) then

begin

writeln(f, '<P>Не удается решить систему</P>');done:=true;solve:=false;end else

if iter<>0 then

begin

writeln(f,'<P><b>Итерация ',iter,'</b></P>'); writeln(f, '<P>Найдем ведущий элемент:</P>');

zapisat(n+1,m+y+1,i0,j0);

writeln(f,'<P>Ведущий столбец: ',j0,'<br>Ведущая строка: ',i0,'</P>');

write(f,'<P>В строке ',i0,': базис ');

writeln(f,'X_{',all_basis[i0],'} заменяем на X_',j0,'</P>');

all_basis[i0]:=j0;end;end;

procedure okr; {округляет мелкие погрешности}

var

i,j: integer;

begin

for i:=1 to n+1 do

for j:=1 to m+y+1 do

if abs(matrix[i,j]-round(matrix[i,j]))< tochnost then

matrix[i,j]:=round(matrix[i,j]);

end;

procedure preobr; {преобразует массив относительно ведущего элемента}

var

i,j,k,l,t: integer;

temp: double;

begin

if done=false then

begin

write(f, '<P>Пересчет:</P>');

temp:=matrix[i0,j0];

for j:=1 to m+y+1 do matrix[i0,j]:=matrix[i0,j]/temp;

for i:=1 to n+1 do

begin

temp:=matrix[i,j0];

for j:=1 to m+y+1 do

if (i<>i0) then

matrix[i,j]:=matrix[i,j]-matrix[i0,j]*temp;end;okr;zapisat(n+1,m+y+1,-1,-1);

{убираем искусственный базис}

if i_basis>0 then {если он есть }

begin

t:=0;

for j:=m+y-i_basis+1 to m+y do {от первого исскусственного элемеента до конца}

begin

need_i_basis:=false; {предполагаем, что элемент не нужен (*)}

for i:=1 to n do {просматриваем столбец}

if all_basis[i]=j then {и если элемент

в базисе}

need_i_basis:=true; {тогда он все-таки нужен}

if need_i_basis=false then t:=j; { запомним этот элемент}

end;

if t<>0 then

begin

for k:=1 to n+1 do {во всех строках}

begin

for l:=t to m+y do {от текущего столбца до последнего}

matrix[k,l]:=matrix[k,l+1]; {заменяем элемент на соседний}

matrix[k,m+y+1]:=0; {а последний убираем}

end; {столбец удален! надо это запомнить}

y:=y-1;

i_basis:=i_basis-1;

if i_basis>0 then {если остались еще искусственные переменные,}

for l:=m+y-i_basis+1 to m+y do {то от первой из них до последней}

for i:=1 to n do {просматриваем строки в столбце}

if matrix[i,l]=1 then all_basis[i]:=l; {туда, где 1, заносим в базис}

writeln(f,'<P>Искусственная переменная исключена из базиса<br>');

writeln(f,'и может быть удалена из таблицы.');

writeln(f,'</P>');

zapisat(n+1,m+y+1,-1,-1);end;end; {закончили убирать искусственный базис}

end;end;

procedure otvet; {выводит ответ}

var

i,j: integer;

begin

writeln(f,'<P><b>ОТВЕТ:</b></P>');

form1.Memo1.ReadOnly:=false;

form1.Memo1.Lines.Clear;

form1.Memo1.Lines.Add('ОТВЕТ:');

form1.Memo1.Lines.Add('');

if (solve=true) and (i_basis=0) then

write(f,'F('); form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'F(';

if form1.Extrem.ItemIndex=0 then

begin

write(f,'max) = ',0-matrix[n+1,m+y+1]:0:3);

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'max) = ';

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+floattostr(0-matrix[n+1,m+y+1]);end else

begin

write(f,'min) = ',matrix[n+1,m+y+1]:0:3);

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'min) = ';

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+floattostr(matrix[n+1,m+y+1]);end;

writeln(f,'<br>при значениях:<br>');

form1.Memo1.Lines.Add('');form1.Memo1.Lines.Add('');form1.Memo1.Lines.Add('при значениях:');form1.Memo1.Lines.Add('');

for j:=1 to m do

begin

writeln(f,'x_',j,' = ');

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'X[';

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+inttostr(j);

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'] = ';

written:=false;

for i:=1 to n do

if all_basis[i]=j then

begin

writeln(f,matrix[i,m+y+1]:0:3,'<br>');

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+floattostr(matrix[i,m+y+1]);

form1.Memo1.Lines.Add('');form1.Memo1.Lines.Add('');written:=true;end;

if written=false then

begin

writeln(f,'0.000 <br>');

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'0';

form1.Memo1.Lines.Add('');form1.Memo1.Lines.Add('');end;end;end else

begin

writeln(f,'<P>Решение не найдено.(</P>');

form1.Memo1.Lines.Text:=form1.Memo1.Lines.Text+'Решение не найдено.';

end;

form1.Memo1.ReadOnly:=true;

end;

procedure Step2; {шаг второй: решение задачи и формирование отчета}

var

i,j: integer; k: integer;

begin

for i:=1 to n+1 do

for j:=1 to m+1 do

begin

matrix[i,j]:=strtofloat(pole[i,j].Text); {Вводим значения в массив}

pole[i,j].Enabled:=false; {Блокируем поля}

if i<=n then znak[i].Enabled:=false; {блокируем знаки}

end; form1.Extrem.Enabled:=false;

{ имеем матрицу [ n+1, m+1 ] }

rewrite(f);

writeln(f,'<HTML>');writeln(f,'<HEAD>');writeln(f,'<TITLE>Отчет</TITLE>');

writeln(f,'</HEAD>');writeln(f,'<BODY>');writeln(f,'<H1>Отчет</H1>');write(f,'<P><b> ');

if form1.Extrem.ItemIndex=0 then write(f,'макс') else write(f,'мин');

writeln(f,'имизировать целевую функцию:</b></P>');

kanon:=false; {еще не в канонической форме}

write_system(n+1,m+1); {Выведем ее в отчет}

{приведем ее к каноническому виду}

writeln(f,'<P><b>Приведем к каноническому виду:</b></P>');

y:=0; {количество дополнительных переменных}

need_basis:=false;

for i:=1 to n do

if znak[i].ItemIndex<>2 then {если ограничение не является равенством}

begin

y:=y+1; {вводим дополнительную переменную, для этого:}

for k:=1 to n+1 do begin {во всех ограничениях и в ЦФ}

{перед правой частью добавляем столбец}

matrix[k,m+y+1]:=matrix[k,m+y];

matrix[k,m+y]:=0; {состоящий из нулей}

end; {а в текущем ограничении, если знак был > или >=}

if (znak[i].ItemIndex=0) or (znak[i].ItemIndex=1) then

begin

matrix[i,m+y]:=-1; {записываем -1}

need_basis:=true;end

else {иначе, т.е. в случае < или <=}

matrix[i,m+y]:=1; {записываем 1}

end

else need_basis:=true;

{ЦФ приравнивается к нулю, а свободный член переносится в правую часть:}

matrix[n+1,m+y+1]:=0-matrix[n+1,m+y+1];

{правые части ограничений должны быть неотрицательны, проверим это:}

for i:=1 to n do {для всех ограничений}

if matrix[i,m+y+1]<0 then {если правая часть отрицательна,}

{то отнимаем всю строку от нуля}

for j:=1 to m+y+1 do matrix[i,j]:=(0-matrix[i,j]);

kanon:=true;{система приведена к каноническому виду}

{выведем ее в отчет}

write_system(n+1,m+y+1);

{если ф-ция на минимум, то нужно поменять знаки в последней строке}

if form1.Extrem.ItemIndex=1 then

for j:=1 to m+y+1 do matrix[n+1,j]:=0-matrix[n+1,j];

{Ввести базис }

i_basis:=0;

for i:=1 to n do {то во всех ограничениях}

begin

is_basis:=false;

for j:=1 to m+y do

if (matrix[i,j]=1) then

if (is_basis=false) then

begin

all_basis[i]:=j;is_basis:=true;for k:=1 to n do

if k<>i then

if (matrix[k,j]<>0) then

if (is_basis=true) then

begin

is_basis:=false;all_basis[i]:=0;end;end;

if is_basis=false then

begin

i_basis:=i_basis+1;y:=y+1;

for k:=1 to n+1 do

begin {во всех ограничениях и в ЦФ}

{перед правой частью добавляем столбец}

matrix[k,m+y+1]:=matrix[k,m+y];

matrix[k,m+y]:=0; {состоящий из нулей}

end;matrix[i,m+y]:=1;all_basis[i]:=m+y;end;end;

{Закончили ввод искусственного базиса }

{теперь надо от него избавиться }

if i_basis>0 then

begin

write(f, '<H2>Необходимо ввести искусственный базис</H2>');

zapisat(n+1,m+y+1,-1,-1);

writeln(f, '<P>Искусственный базис введен.<br>');

writeln(f, 'Избавившись от него, получим первое допустимое решение</P>');

iter:=0;

repeat

inc(iter);findved;preobr;

until (i_basis=0) or (iter=20) or (done=true);

if i_basis=0 then

begin

writeln(f,'<P>Искусственный базис выведен полностью.<br>');

writeln(f,'Получено первое допустимое решение!</P>');end else

begin

writeln(f,'<P>Не удалось вывести искусственный базис.<br>');

writeln(f,'Решение не найдено.</P>');end;end;

{ попытки избавленя окончены }