Добавил:
Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

Исходник программы

.doc
Скачиваний:
12
Добавлен:
02.05.2014
Размер:
83.46 Кб
Скачать

unit Unit2;

interface

uses

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

Dialogs, StdCtrls, Buttons, ComCtrls, ExtCtrls,Math, AppEvnts ;

const

LF = #10;

type

TForm1 = class(TForm)

BitBtn1: TBitBtn;

ListBox1: TListBox;

Edit1: TEdit;

ListBox3: TListBox;

Edit2: TEdit;

ListBox4: TListBox;

StatusBar1: TStatusBar;

Timer1: TTimer;

ListBox5: TListBox;

GroupBox1: TGroupBox;

Label2: TLabel;

Label3: TLabel;

Label5: TLabel;

Label9: TLabel;

Label10: TLabel;

GroupBox3: TGroupBox;

Label6: TLabel;

Label7: TLabel;

Label8: TLabel;

Edit3: TEdit;

Label14: TLabel;

GroupBox4: TGroupBox;

ListBox6: TListBox;

Label15: TLabel;

ListBox7: TListBox;

Label16: TLabel;

ListBox8: TListBox;

Label17: TLabel;

Label18: TLabel;

Edit4: TEdit;

Label19: TLabel;

GroupBox5: TGroupBox;

ListBox9: TListBox;

Label20: TLabel;

Label21: TLabel;

Edit5: TEdit;

Label22: TLabel;

GroupBox6: TGroupBox;

Panel1: TPanel;

ListBox10: TListBox;

ListBox11: TListBox;

Label23: TLabel;

Label24: TLabel;

Label25: TLabel;

Label26: TLabel;

ListBox12: TListBox;

Label27: TLabel;

Label28: TLabel;

Edit6: TEdit;

Label29: TLabel;

ListBox13: TListBox;

Label30: TLabel;

Label31: TLabel;

Label32: TLabel;

Label33: TLabel;

ListBox14: TListBox;

Label34: TLabel;

Label35: TLabel;

CheckBox1: TCheckBox;

CheckBox2: TCheckBox;

CheckBox3: TCheckBox;

CheckBox4: TCheckBox;

CheckBox5: TCheckBox;

CheckBox6: TCheckBox;

ListBox2: TListBox;

GroupBox2: TGroupBox;

Label1: TLabel;

Label4: TLabel;

Label11: TLabel;

ApplicationEvents1: TApplicationEvents;

procedure BitBtn1Click(Sender: TObject);

procedure Timer1Timer(Sender: TObject);

procedure FormCreate(Sender: TObject);

procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);

private

{ Private declarations }

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

var

kol:integer;

dt:string;

{$R *.dfm}

procedure TForm1.BitBtn1Click(Sender: TObject);

var

st:string;

y123,y124,max:integer;

z: array[1..10,1..10] of integer;

matr_sed: array[1..10,1..10] of integer;

matr_ger: array[1..10,1..10] of integer;

matr_ger2: array[1..10,1..10] of real;

min_mas:array[1..10] of integer;

min_mas_hod:array[1..10] of real;

min_mas_ger:array[1..10] of real;

max_mas:array[1..10] of integer;

vich_mas:array[1..10] of real;

mas_par:array[1..10] of real;

mas_bair:array[1..10] of real;

max_el_stol:array[1..10] of integer;

x,j:integer;

st1,n,u:string;

y,dl,min:integer;

min1,c1,c:variant;

max2,znach,znach1,param_bair,ver:real;

begin

listbox1.Clear;

listbox2.Clear;

listbox3.Clear;

listbox4.clear;

listbox5.Clear;

listbox6.Clear;

listbox7.Clear;

listbox8.clear;

listbox9.Clear;

listbox10.Clear;

listbox11.Clear;

listbox12.clear;

listbox13.Clear;

listbox14.clear;

groupbox1.Visible:=false;

groupbox2.Visible:=false;

groupbox3.Visible:=false;

groupbox4.Visible:=false;

groupbox5.Visible:=false;

groupbox6.Visible:=false;

dt:=InputBox('Размер матрицы', 'Количество исследований-3','3');

kol:=strtoint(dt);

//dt:='3';

j:=1;

for x:=1 to kol do

begin

for y:=1 to kol do

begin

n:=inputbox('Введите элемент:'+inttostr(j),'','');

z[x,y]:=Strtoint(n);

j:=j+1;

end;

end;

////Вывод массива

y123:=0;

y124:=0;

st:='';

for y:=1 to kol do

begin

for x:=1 to kol do

begin

y123:=Length(inttostr(z[x,y]));

if (y123<6 ) then y124:=6-y123;

st1:=inttostr(z[x,y]);

for dl:=1 to y124 do

begin

st1:=' '+st1;

end;

st:=st+st1;

end;

listbox4.Items.Add(st);

st:='';

end;

listbox4.Visible:=true;

if (Checkbox1.Checked=true) then

begin

groupbox2.Visible:=true;

////Минимальные

y:=1;

while y<=kol do

begin

x:=1;

min1:=z[x,y];

max:= z[x,y];

while x<=kol do

begin

if min1>z[x,y] then min1:=z[x,y];

if max<z[x,y] then max:=z[x,y];

x:=x+1;

end;

min_mas[y]:=min1;

max_mas[y]:=max;

y:=y+1;

end;

///////////////////

for x:=1 to kol do

begin

listbox1.Items.Add(inttostr(min_mas[x]));

end;

listbox1.Visible:=true;

////////////////////////////////////

max:=min_mas[1];

for x:=1 to kol do

begin

if (max<min_mas[x]) then max:=min_mas[x];

end;

edit1.text:=inttostr(max);

edit1.Visible:=true;

for x:=1 to kol do

begin

listbox2.Items.Add(inttostr(max_mas[x]));

end;

listbox2.Visible:=true;

///////////////////////////////////

end;

if (Checkbox2.Checked=true) then

begin

c:=InputBox('Критерий Гурвица', '','0,5');

Label32.Caption:=c;

c:=strtofloat(c);

c1:=1-c;

groupbox1.Visible:=true;

/////////Минимальный, максимальный массив

y:=1;

while y<=kol do

begin

x:=1;

min1:=z[x,y];

max:= z[x,y];

while x<=kol do

begin

if min1>z[x,y] then min1:=z[x,y];

if max<z[x,y] then max:=z[x,y];

x:=x+1;

end;

min_mas[y]:=min1;

max_mas[y]:=max;

y:=y+1;

end;

//////////////////////////////////////

for x:=1 to kol do

begin

vich_mas[x]:=min_mas[x]*c+max_mas[x]*c1;

end;

max2:= vich_mas[1];

for x:=1 to kol do

begin

if (max2<vich_mas[x]) then max2:=vich_mas[x];

end;

edit2.text:=floattostr(max2);

edit2.Visible:=true;

for x:=1 to kol do

begin

listbox3.Items.Add(floattostr(vich_mas[x]));

end;

listbox3.Visible:=true;

end;

/////////////////Байеса-Лапласа

if (Checkbox3.Checked=true) then

begin

groupbox3.Visible:=true;

for x:=1 to kol do

begin

n:=inputbox('Введите параметр Байеса-Лапласа:','0.5,0.3,0.2','');

mas_par[x]:=StrtoFloat(n);

listbox14.Items.Add(n);

j:=j+1;

end;

listbox14.Visible:=true;

znach1:=0;

y:=1;

while y<=kol do

begin

x:=1;

while x<=kol do

begin

znach:=0;

param_bair:=mas_par[x];

znach:=z[x,y]*param_bair;

znach1:=znach1+znach;

x:=x+1;

end;

mas_bair[y]:=znach1;

znach1:=0;

y:=y+1

end;

////Вывод в Box

for x:=1 to kol do

begin

listbox5.Items.Add(floattostr(mas_bair[x]));

end;

listbox5.Visible:=true;

/////Поиск максимального значения

max2:=mas_bair[1];

for x:=1 to kol do

begin

if (max2<mas_bair[x]) then max2:=mas_bair[x];

end;

edit3.text:=floattostr(max2);

edit3.Visible:=true;

end;

////Критерий Сэвиджа

if (Checkbox4.Checked=true) then

begin

groupbox4.Visible:=true;

y:=1;

while y<=kol do

begin

x:=1;

max:= z[y,x];

while x<=kol do

begin

if max<z[y,x] then max:=z[y,x];

x:=x+1;

end;

max_el_stol[y]:=max;

y:=y+1;

end;

////////////////////////

y:=1;

while y<=kol do

begin

x:=1;

while x<=kol do

begin

matr_sed[y,x]:=max_el_stol[y]-z[y,x];

x:=x+1;

end;

y:=y+1;

end;

///////////

y123:=0;

y124:=0;

st:='';

y:=1;

while y<=kol do

begin

x:=1;

while x<=kol do

begin

y123:=Length(inttostr(matr_sed[x,y]));

if (y123<6 ) then y124:=6-y123;

st1:=inttostr(matr_sed[x,y]);

x:=x+1;

for dl:=1 to y124 do

begin

st1:=' '+st1;

end;

st:=st+st1;

end;

listbox7.Items.Add(st);

st:='';

y:=y+1;

end;

listbox7.Visible:=true;

/////////////

listbox6.Clear;

for x:=1 to kol do

begin

listbox6.Items.Add(inttostr( max_el_stol[x]));

end;

listbox6.Visible:=true;

///Максимальный

y:=1;

while y<=kol do

begin

x:=1;

max:= matr_sed[x,y];

while x<=kol do

begin

if max<matr_sed[x,y] then max:=matr_sed[x,y];

x:=x+1;

end;

max_mas[y]:=max;

y:=y+1;

end;

for x:=1 to kol do

begin

listbox8.Items.Add(inttostr(max_mas[x]));

end;

listbox8.Visible:=true;

////////////

min:=max_mas[1];

for x:=1 to kol do

begin

if (min>max_mas[x]) then min:=max_mas[x];

end;

edit4.text:=inttostr(min);

edit4.Visible:=true;

end;

if (Checkbox5.Checked=true) then

begin

//////Ходжа-Лемана

c:=InputBox('Введите критерий Ходжа-Лемана <=0.4', '','0,4');

label35.Caption:=c;

groupbox5.Visible:=true;

znach:=1-c;

ver:=roundto(1/kol,-2);

y:=1;

while y<=kol do

begin

x:=1;

min1:=z[x,y];

znach1:=0;

while x<=kol do

begin

if min1>z[x,y] then min1:=z[x,y];

znach1:=znach1+z[x,y]*ver;

x:=x+1;

end;

znach1:=znach1*znach;

znach1:=znach1+ (min1*c);

min_mas_hod[y]:=roundto(znach1,-2);

y:=y+1;

end;

/////////////

listbox9.Clear;

for x:=1 to kol do

begin

listbox9.Items.Add(floattostr( min_mas_hod[x]));

end;

listbox9.Visible:=true;

///////////////

Max2:=min_mas_hod[1];

for x:=1 to kol do

begin

if (max2<min_mas_hod[x]) then max2:=min_mas_hod[x];

end;

edit5.text:=floattostr(max2);

edit5.Visible:=true;

end;

////////Метод Гермейера/////

if (Checkbox6.Checked=true) then

begin

groupbox6.Visible:=true;

for x:=1 to kol do

begin

n:=inputbox('Введите параметры Гермейера:','0.5,0.3,0.2','');

listbox13.Items.Add(n);

mas_par[x]:=StrtoFloat(n);

j:=j+1;

end;

listbox13.Visible:=true;

///Ищем максимум заданной матрицы z[x,y]

y:=1;

max:=z[1,1];

while y<=kol do

begin

x:=1;

while x<=kol do

begin

if max<z[x,y] then max:=z[x,y];

x:=x+1;

end;

y:=y+1;

end;

max:=max+1;

//////Получаем матрицу остатков

y:=1;

while y<=kol do

begin

x:=1;

while x<=kol do

begin

matr_ger[x,y]:=z[x,y]-max;

x:=x+1;

end;

y:=y+1;

end;

///////////// Вывод на экран расчет

///////////

y123:=0;

y124:=0;

st:='';

y:=1;

while y<=kol do

begin

x:=1;

while x<=kol do

begin

y123:=Length(inttostr(matr_ger[x,y]));

if (y123<6 ) then y124:=6-y123;

st1:=inttostr(matr_ger[x,y]);

x:=x+1;

for dl:=1 to y124 do

begin

st1:=' '+st1;

end;

st:=st+st1;

end;

listbox10.Items.Add(st);

st:='';

y:=y+1;

end;

listbox10.Visible:=true;

////Умножаем на заданные параметры

x:=1;

while x<=kol do

begin

y:=1;

while y<=kol do

begin

matr_ger2[x,y]:=matr_ger[x,y]*mas_par[x];

y:=y+1;

end;

x:=x+1;

end;

////////////////////// Вывод второй матрицы вычислений

y123:=0;

y124:=0;

st:='';

y:=1;

while y<=kol do

begin

x:=1;

while x<=kol do

begin

y123:=Length(floattostr(matr_ger2[x,y]));

if (y123<6 ) then y124:=6-y123;

st1:=floattostr(matr_ger2[x,y]);

x:=x+1;

for dl:=1 to y124 do

begin

st1:=' '+st1;

end;

st:=st+st1;

end;

listbox11.Items.Add(st);

st:='';

y:=y+1;

end;

listbox11.Visible:=true;

////////В матрице 2 ищем минимальные значения по строкам

y:=1;

while y<=kol do

begin

x:=1;

min1:=matr_ger2[x,y];

while x<=kol do

begin

if min1>matr_ger2[x,y] then min1:=matr_ger2[x,y];

x:=x+1;

end;

min_mas_ger[y]:=min1;

y:=y+1;

end;

/// Вывод минимального массива

for x:=1 to kol do

begin

listbox12.Items.Add(floattostr(min_mas_ger[x]));

end;

listbox12.Visible:=true;

////Завершающий этап

Max2:=min_mas_ger[1];

for x:=1 to kol do

begin

if (max2<min_mas_ger[x]) then max2:=min_mas_ger[x];

end;

edit6.text:=floattostr(max2);

edit6.Visible:=true;

end;

end;

procedure TForm1.Timer1Timer(Sender: TObject);

begin

statusbar1.Panels[0].Text:=TimeToStr(Time) ;

end;

procedure TForm1.FormCreate(Sender: TObject);

begin

statusbar1.Panels[1].Text:=Application.ExeName;

end;

procedure TForm1.ApplicationEvents1Exception(Sender: TObject;

E: Exception);

begin

kol:=3;

end;

end.