Технологии программирования

1. Вводим функцию, как она есть, соблюдая правила расстановки знаков и скобок.

2. Вводим нижний предел.

3. Вводим верхний предел.

4. Вводим количество отрезков для разбиения.

5. Выбираем метод для вычисления интеграла

- По формуле Симпсона

- По формуле прямоугольников

-.По формуле трапеций

6. Нажимаем кнопку вычислить.

7. Проверяется выбранный метод, в зависимости от выбора рассчитывается интеграл по соответствующему методу.

8. Для формулы Симпсона, сначала рассчитываются первые два узла интегрирования и шаг.(для других методов аналогично, только меняются пункты 8, 9, 10)

9. После, рассчитываются результаты интегрирования на 3ем узле и 4том. Здесь используются потоки, в зависимости от количества отрезков на каждый узел.

10. После суммируются и умножаются переменные содержащие суммы результатов интегрирования на всех отрезках.

11. На экран выводится метка с результатом интегрирования.

12. После расчетов и просмотра результатов, окончание работы программы производится кнопкой выход.

3.Краткая инструкция по работе программы

программирование средний прямоугольник формула

Исходный текст программы (основной модуль)

unit Unit1;

interface

uses

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

Dialogs, StdCtrls, UFunction, jpeg, ExtCtrls, Unit2, Unit3;

type

TForm1 = class(TForm)

Label1: TLabel;

Label2: TLabel;

Edit1: TEdit;

Edit2: TEdit;

Button1: TButton;

Edit4: TEdit;

RadioButton1: TRadioButton;

RadioButton2: TRadioButton;

RadioButton3: TRadioButton;

Edit5: TEdit;

Button4: TButton;

Image1: TImage;

GroupBox1: TGroupBox;

Label5: TLabel;

Label6: TLabel;

Label4: TLabel;

Label3: TLabel;

procedure Edit1KeyPress(Sender: TObject; var Key: Char);

procedure Edit2KeyPress(Sender: TObject; var Key: Char);

procedure Edit4KeyPress(Sender: TObject; var Key: Char);

procedure Button1Click(Sender: TObject);

procedure Edit5KeyPress(Sender: TObject; var Key: Char);

procedure Button4Click(Sender: TObject);

procedure FormCreate(Sender: TObject);

private

{ Private declarations }

public

{ Public declarations }

simc2,simc3:extended; //переменные для суммирования результатов потока

end;

var

Form1: TForm1;

OldFStroka: string;

a, b : extended;//границы интегрирования,счетчик

nc: integer;//разбить на nc частей

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);

begin

label3.Visible:=False;

label4.Visible:=False;

end;

procedure TForm1.Edit5KeyPress(Sender: TObject; var Key: Char);

begin

if not (key in['0'..'9', 'a'..'z', #8, #13, '-', '+', '*', '/',

'^', ',', '.', '(', ')']) then key:=#0;

end;

procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);

begin

if not (key in['0'..'9', #8, '-', 'E', 'e', ',', '.']) then key:=#0;

end;

procedure TForm1.Edit2KeyPress(Sender: TObject; var Key: Char);

begin

if not (key in['0'..'9', #8, '-', 'E', 'e', ',', '.']) then key:=#0;

end;

procedure TForm1.Edit4KeyPress(Sender: TObject; var Key: Char);

begin

if not (key in['0'..'9', #8]) then key:=#0;

end;

procedure Pr;

begin

FStroka:=Form1.Edit5.Text;

if length(OldFStroka) = 0 then

begin

CreateSh;

OldFStroka:=FStroka;

end else

if OldFStroka <> FStroka then

begin

DeleteSh;

CreateSh;

OldFStroka:=FStroka;

end;

end;

function Log: boolean;

begin

if Form1.Edit5.Text <> '' then Log:=true else Log:=false;

if Form1.Edit1.Text <> '' then a:=strtofloat(Form1.Edit1.Text) else

Log:=false;

if Form1.Edit2.Text <> '' then b:=strtofloat(Form1.Edit2.Text) else

Log:=false;

if Form1.Edit4.Text <> '' then nc:=strtoint(Form1.Edit4.Text) else

Log:=false;

end;

//формула Симпсона

function IntegralSimpson: extended;

var c0, c1, c2, c3, c4, dx: extended;

i: integer; Thr: Threadc2;Thr2: Threadc3;

k: real;

begin

c0:=(b-a)/(3*nc);

c1:=(F(a)+F(b))/2;

dx:=(b-a)/nc;

c2:=0; i:=0;

c3:=0; k:=-0.5;

repeat

i:=i+1;

Thr:=Threadc2.Create(False);

Thr.Priority:=tpHighest;

Thr.FreeOnTerminate:=True;

Thr.a:=a;

Thr.dx:=dx;

Thr.nc:=nc;

Thr.i:=i;

until i = nc-1;

repeat

k:=k+1;

Thr2:=Threadc3.Create(False);

Thr2.Priority:=tpHighest;

Thr2.FreeOnTerminate:=True;

Thr2.a:=a;

Thr2.dx:=dx;

Thr2.nc:=nc;

Thr2.k:=k;

until k = nc-0.5;

IntegralSimpson:=c0*(c1+Form1.simc2+2*Form1.simc3);

end;

//формула прямоугольников

function IntegralPrmg: extended;

var sum, dx: extended;

k: real;

begin

dx:=(b-a)/nc;

sum:=0; k:=-0.5;

repeat

k:=k+1;

sum:=sum+F(a+dx*k);

until k = (2*nc-1)/2;

IntegralPrmg:=dx*sum;

end;

//формула трапеций

function IntegralTrap: extended;

var dx, c0, c1: extended;

i: integer;

begin

dx:=(b-a)/nc;

c0:=(F(a)+F(b))/2;

c1:=0; i:=0;

repeat

i:=i+1;

c1:=c1+F(a+dx*i);

until i = nc-1;

IntegralTrap:=dx*(c0+c1);

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

Pr;simc2:=0;simc3:=0;

label3.Caption:='';

if Log then

if Form1.RadioButton1.Checked then Form1.Label3.Caption:=floattostr(IntegralSimpson)

else

if Form1.RadioButton2.Checked then Form1.Label3.Caption:=floattostr(IntegralPrmg) else

if Form1.RadioButton3.Checked then Form1.Label3.Caption:=floattostr(IntegralTrap);

label3.Visible:=True;

label4.Visible:=True;

end;

procedure TForm1.Button4Click(Sender: TObject);

begin

close;

end;

end.

Исходный текс потока 1(Unit2)

unit Unit2;

interface

uses

Classes;

type

Threadc2 = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

procedure SIMP;

Public

dx,a,tr2,c,cc,c0,c1,c2,c3,nc,k:Extended;

i:integer;

end;

implementation

uses unit1, Forms, SysUtils, UFunction;

{ Threadc2 }

procedure Threadc2.SIMP;

begin

c2:=F(a+dx*i);

Form1.simc2:=Form1.simc2+c2;

end;

procedure Threadc2.Execute;

begin

SIMP;

end;

end.

Исходный текс потока 2(Unit3)

unit Unit3;

interface

uses

Classes;

type

Threadc3 = class(TThread)

private

{ Private declarations }

protected

procedure Execute; override;

procedure SIMP;

Public

dx,a,tr2,c,cc,c0,c1,c2,c3,nc,k:Extended;

i:integer;

end;

implementation

uses unit1, Forms, SysUtils, UFunction;

{ Threadc3 }

procedure Threadc3.SIMP;

begin

c3:=F(a+dx*i);

Form1.simc3:=Form1.simc3+c3;

end;

procedure Threadc3.Execute;

begin

SIMP;

end;

end.

Дополнительный модуль(UFunction):

unit UFunction;

interface

uses

Windows, SysUtils, Math;

Const

a: array[1..10] of string[6] = ('arcsin', 'arccos', 'arctan', 'sin', 'cos', 'tan', 'ctg', 'ln', 'exp', 'abs');

Type

PExt = ^extended;

ElemSh = ^Dat;

Dat = record

L, R: PExt;

fn: integer;

Rez: extended;

Next: ElemSh;

end;

Var

FStroka: string;//функция в виде строки

Mch: array of PExt;

n, nn: integer;

p: PExt;

FX: extended;

U: ElemSh;

BeginUz: ElemSh;

function F(X: extended): extended;//функция

procedure CreateSh;//создать схему

procedure DeleteSh;//удалить схему

implementation

function StrToLogstr(str: string): string;

var i, k: integer;

s: string;

begin

s:=str;

while pos(' ', s) <> 0 do delete(s, pos(' ', s), 1);

if s[1] = '-' then insert('0', s, 1);;

while pos('(-', s) <> 0 do insert('0', s, pos('(-', s)+1);

for i:=low(a) to high(a) do

while pos(a[i], s) <> 0 do

begin

insert('f'+inttostr(i), s, pos(a[i], s));

delete(s, pos(a[i], s), length(a[i]));

end;

i:=0;

repeat

i:=i+1;

if s[i] = 'f' then

begin

k:=i+1;

while s[k] <> '(' do

begin

k:=k+1;

if k > length(s) then break;

end;

i:=i+(k-i-1);

end else

if s[i] in ['0'..'9', ',', '.'] then

begin

k:=i;

while s[k] in['0'..'9', ',', '.'] do

begin

k:=k+1;

if k > length(s) then break;

end;

n:=n+1;

p:=new(PExt);

setlength(MCh, n+1);

MCh[n]:=p;

p^:=strtofloat(copy(s, i, k-i));

delete(s, i, k-i);

insert('<'+inttostr(n)+'>', s, i);

if n < 10 then i:=i+2 else if n < 100 then i:=i+3 else if n < 1000 then i:=i+4;

end else

if (s[i] = 'p') or (s[i] = 'e') then

begin

p:=new(PExt);

if s[i] = 'p' then p^:=pi else p^:=exp(1);

if s[i] = 'p' then delete(s, i, 2) else delete(s, i, 1);

n:=n+1;

insert('<'+inttostr(n)+'>', s, i);

setlength(MCh, n+1);

MCh[n]:=p;

if n < 10 then i:=i+2 else if n < 100 then i:=i+3 else if n < 1000 then i:=i+4;

end else

if s[i] = 'x' then

begin

delete(s, i, 1);

n:=n+1;

insert('<'+inttostr(n)+'>', s, i);

setlength(MCh, n+1);

MCh[n]:=@FX;

if n < 10 then i:=i+2 else if n < 100 then i:=i+3 else if n < 1000 then i:=i+4;

end;

until i >= length(s);

nn:=n;

StrToLogstr:=s;

end;

procedure InsUz(AddrL, AddrR: PExt; fnd: integer; var U: ElemSh);

begin

new(U);

U^.L:=AddrL;

U^.R:=AddrR;

U^.fn:=fnd;

U^.Next:=nil;

end;

function Fbs(str: string): string;

var i, k, t, m, NOper: integer;

s: string;

Q: ElemSh;

begin

s:=str;

while (pos('^', s) <> 0) or (pos('*', s) <> 0) or (pos('/', s) <> 0) do

begin

Q:=U;

i:=4;

while not (s[i] in['^', '*', '/']) do i:=i+1;

NOper:=0;

if s[i] = '*' then NOper:=high(a)+3 else

if s[i] = '/' then NOper:=high(a)+4 else

if s[i] = '^' then NOper:=high(a)+5;

k:=i-2;

while s[k-1] <> '<' do k:=k-1;//(k-1) - поз. '<'

m:=strtoint(copy(s, k, i-k-1));

t:=k;

k:=i+2;

while s[k+1] <> '>' do k:=k+1;//(k+1) - поз. '>'

InsUz(Mch[m], Mch[strtoint(copy(s, i+2, k-i-1))], NOper, U);

if Q <> nil then Q^.Next:=U else BeginUz:=U;

n:=n+1;

setlength(MCh, n+1);

MCh[n]:=@U^.Rez;

delete(s, t, k-t+1);

insert(inttostr(n), s, t);

end;

while (pos('+', s) <> 0) or (pos('-', s) <> 0) do

begin

Q:=U;

i:=2;

while not (s[i] in['+', '-']) do i:=i+1;

NOper:=0;

if s[i] = '+' then NOper:=high(a)+1 else

if s[i] = '-' then NOper:=high(a)+2;

k:=i-2;

while s[k-1] <> '<' do k:=k-1;//(k-1) - поз. '<'

m:=strtoint(copy(s, k, i-k-1));

t:=k;

k:=i+2;

while s[k+1] <> '>' do k:=k+1;//(k+1) - поз. '>'

InsUz(Mch[m], Mch[strtoint(copy(s, i+2, k-i-1))], NOper, U);

if Q <> nil then Q^.Next:=U else BeginUz:=U;

n:=n+1;

setlength(MCh, n+1);

MCh[n]:=@U^.Rez;

delete(s, t, k-t+1);

insert(inttostr(n), s, t);

end;

Fbs:=s;

end;

procedure Skb(str: string; var U: ElemSh);

var i, k, g: integer;

s, sc: string;

Q: ElemSh;

begin

s:=str;

while pos('(', s) <> 0 do

begin

i:=pos(')', s);

k:=i-4;

while s[k] <> '(' do k:=k-1;

if s[k-1] in['0'..'9'] then

begin

sc:=Fbs(copy(s, k+1, i-k-1));

Q:=U;

g:=k-1;

while s[g-1] <> 'f' do g:=g-1;

InsUz(MCh[strtoint(copy(sc, 2, length(sc)-2))], nil, strtoint(copy(s, g, k-g)), U);

if Q <> nil then Q^.Next:=U else BeginUz:=U;

n:=n+1;

setlength(MCh, n+1);

MCh[n]:=@U^.Rez;

delete(s, g-1, i-g+2);

insert('<'+inttostr(n)+'>', s, g-1);

end else

if (k-1 = 0) or (s[k-1] in['+', '-', '*', '/', '^', '(']) then

begin

sc:=Fbs(copy(s, k+1, i-k-1));

delete(s, k, i-k+1);

insert(sc, s, k);

end; end;

sc:=Fbs(s);

if U <> nil then if BeginUz <> U then U^.Next:=BeginUz;

end;

procedure CompileUz(var U: ElemSh);

begin

case U^.fn of

1: U^.Rez:=arcsin(U^.L^);

2: U^.Rez:=arccos(U^.L^);

3: U^.Rez:=arctan(U^.L^);

4: U^.Rez:=sin(U^.L^);

5: U^.Rez:=cos(U^.L^);

6: U^.Rez:=sin(U^.L^)/cos(U^.L^);

7: U^.Rez:=cos(U^.L^)/sin(U^.L^);

8: U^.Rez:=ln(U^.L^);

9: U^.Rez:=exp(U^.L^);

10: U^.Rez:=abs(U^.L^);

11: U^.Rez:=U^.L^+U^.R^;

12: U^.Rez:=U^.L^-U^.R^;

13: U^.Rez:=U^.L^*U^.R^;

14: U^.Rez:=U^.L^/U^.R^;

15: if U^.L^ = 0 then U^.Rez:=0 else U^.Rez:=exp(U^.R^*ln(U^.L^));

end;

end;

procedure CreateSh;

begin

Skb(strtologstr(FStroka), U);

n:=-1;

setlength(MCh, nn+1);

end;

procedure DeleteSh;

var Q: ElemSh;

i: integer;

begin

U:=BeginUz;

if U <> nil then if U^.Next = nil then Dispose(U) else

begin

repeat

Q:=U;

U:=U^.Next;

Dispose(Q);

until U^.Next = BeginUz;

Dispose(U);

end;

U:=nil;

for i:=low(Mch) to nn do if Mch[i] <> @FX then dispose(Mch[i]);

setlength(MCh, 0);

p:=nil;

end;

function F(X: extended): extended;

begin

FX:=X;

U:=BeginUz;

if U = nil then F:=Mch[0]^ else

begin

if U^.Next = nil then CompileUz(U) else

begin

repeat

CompileUz(U);

U:=U^.Next;

until U^.Next = BeginUz;

CompileUz(U);

end;

F:=U^.Rez;

end;

end;

Begin

n:=-1;

end.

Заключение