Скачиваний:
29
Добавлен:
01.05.2014
Размер:
14.57 Кб
Скачать
unit baes1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, ExtCtrls, Instances, Mask, baes2;

type
///////////главная форма для расчета/////////////
TfmExample = class(TForm)
bbRun: TBitBtn;
bbClose: TBitBtn;
ComboBox: TComboBox;
LabelComboBox: TLabel;
ListBox: TListBox;
ed: TMaskEdit;
ListBox1: TListBox;
LabelLB1: TLabel;
LabelLB2: TLabel;
Right: TButton;
Left: TButton;
mmOutput: TMemo;
procedure FormActivate(Sender: TObject);
procedure printlist(Sender: TObject);
procedure RightClick(Sender: TObject);
procedure LeftClick(Sender: TObject);
procedure bbRunClick(Sender: TObject);

private
{ Private declarations }
public
{ Public declarations }
procedure CallForm(inst : TDMInstances);
end;
//
chpoint = array of boolean; //в массиве boolean отмечаются номера выбранных атрибутов
//True[i], если i-ый атрибут выбран в качестве условия
///////////////////////////////////
var
fmExample: TfmExample;
Choice : TChoice; //Форма для выбора значения атрибута
inst1:TDMinstances; //Данные для обработки
flags : chpoint; //здесь будут отмечаться номера атрибутов, выбранных пользователем
pult : TDMInstance; //параметр для передачи данных
main_attr: string; //имя значения зависимого атрибута


function NByes(p : TDMinstance; ins:TDMInstances; fl: chpoint; mainstr : string; mainattr : string) : real;
function Probability(strFr : string; strUnfr:string; ins:TDMInstances; indexFr : integer; indexUnFr:integer):real; overload;
function Probability(strFr : string; valUnfr:double; ins:TDMInstances; indexFr : integer; indexUnfr : integer):real; overload;
function Probability(valFr : double; strUnfr : string; ins:TDMInstances; indexFr : integer; indexUnfr : integer):real; overload;
function Probability(valFr : double; valUnfr:double; ins:TDMInstances; indexFr:integer; indexUnfr:integer):real; overload;

implementation

{$R *.dfm}
/////////////////при появлении формы кнопка Run пока отключена/////
procedure TfmExample.FormActivate(Sender: TObject);
begin
bbRun.Enabled := false; //отключить кнопку
end;

////////////вызов формы в которой развернется основные события
procedure TfmExample.CallForm(inst : TDMInstances);
var i:integer;
s:Ansistring;
begin

fmExample := TfmExample.Create(fmExample);
fmExample.ShowModal;
//fmExample.Show;
fmExample.SetFocus;
fmExample.LabelComboBox.Caption := 'Unfreedom variable';
fmExample.LabelComboBox.Alignment := taCenter;
fmExample.LabelLB1.Alignment := taCenter;
fmExample.LabelLB2.Alignment := taCenter;
fmExample.ListBox.Clear;
fmExample.ListBox1.Clear;
inst1 := inst;
main_attr := '';

if inst1 <> nil then begin
SetLength(flags, inst1.numAttributes); //сколько у нас атрибутов
for i := 0 to length(flags) - 1 do //в массиве fl хранятся флаги выбора пользователем атрибутов
flags[i] := false;
pult := inst1.firstInstance;
fmExample.ed.Text := 'Выберите зависимую переменную'; //подсказка пользователю
fmExample.ComboBox.Style := csDropDownList; //установка стиля
for i:=0 to inst1.numAttributes-1 do //записываем в комбисписок все имена номинальных атрибутов
begin
s := inst1.attribute(i).name;
if inst1.attribute(s).isNominal then
fmExample.ComboBox.Items.Add(s);
end;
end
else fmExample.ed.Text := 'Сначала загрузите данные!';
end;

//////////////////Вывести в список ListBox (независимые переменные)
//////////////////все возможные параметры выбора////////////////
procedure TfmExample.printlist(Sender: TObject);
var s:string;
i, j:integer;
begin
fmExample.ed.Text := 'Выберите независимые переменные клавишами Left и Right';
ListBox.Clear;
ListBox1.Clear;
for i := 0 to inst1.numAttributes - 1 do
begin
s := inst1.attribute(i).name; //заполняем список именами атрибутов
ListBox.Items.Add(s);
end;
for i := 0 to ListBox.Count - 1 do
if ListBox.Items.Strings[i] = ComboBox.Text then j := i; //ищем в списке имя зависимого атрибута
ListBox.Items.Delete(j); //вычеркиваем его
end;

/////////////Щелчок кнопкой Right - заполнение правого списка(условия анализа)//////////////////
procedure TfmExample.RightClick(Sender: TObject);
var i:integer;
begin
for i := ListBox.Items.Count-1 downto 0 do
if ListBox.Selected[i] then
begin
ListBox1.Items.Add(ListBox.Items[i]);
ListBox.Items.Delete(i);
end;
if ListBox1.Items.Count > 0 then bbRun.Enabled := true else bbRun.Enabled := false;
end;


///Щелчок кнопкой left -удаление из правого списка выделенных условий
procedure TfmExample.LeftClick(Sender: TObject);
var i:integer;
begin
for i := ListBox1.Items.Count-1 downto 0 do
if ListBox1.Selected[i] then
begin
ListBox.Items.Add(ListBox1.Items[i]);
ListBox1.Items.Delete(i);
end;
if ListBox1.Items.Count > 0 then bbRun.Enabled := true else bbRun.Enabled := false;
end;

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

/////////////////////////кнопка run - окончательный расчет
////////////////////////на основе выбранных условий и вывод р-в
procedure TfmExample.bbRunClick(Sender: TObject);
var i, j, prom :integer;
isdigital : boolean;
s, smean :string;
obb : TDMinstance;
begin
mmOutput.Clear; //очищаем место для вывода р-в
Choice := TChoice.Create(Self); //заранее создаем форму для ввода значений
Choice.Enabled := True; //теперь форма доступна для ввода, хотя и не видна

mmOutput.Lines.Add('START DATA');
s := '';
for i := 0 to inst1.numAttributes-1 do
s := s + inst1.attribute(i).name + ' ';
mmOutput.Lines.Add(s);


for i := 0 to inst1.numInstances-1 do //вывод всех значений на экран
begin
obb := inst1.instance(i);
s := obb.toString;
mmOutput.Lines.Add(s);
end;

for i := 0 to ListBox1.Count-1 do
begin
s := ListBox1.Items.Strings[i];
j := inst1.attribute(s).index;
flags[j] := true;
end;

for i := 0 to ListBox1.Items.Count - 1 do //для каждой переменной в правом списке списке
begin
s := ListBox1.Items.Strings[i]; //найдем название соответствующего атрибута и его тип
if inst1.attribute(s).isNominal then //если атрибут номинального типа
begin
Choice.Choose.Clear; //очищаем список в окне выбора от всякого хлама,который там лежал
Choice.Yes.Enabled := False; //пока выбор не сделан, кнопка утверждения выбора недоступна
for j := 0 to inst1.attribute(s).numValues - 1 do //загружаем в список все значения этого атрибута
begin
smean := inst1.attribute(s).value(j); //находим очередной тип значения заданного атрибута
Choice.Choose.Items.Add(smean); //и записываем его в список для выбора значений
end;
Choice.Name_of_attr.Caption := s; //поясняем пользователю, какой атрибут он устанавливает
Choice.ShowModal; //приостановка выполнения, пока юзер не выбрал нужное ему значение атрибута
end
else begin //если атрибут числового типа
repeat
smean := '';
InputQuery('Ввод значения', s, smean); //вводим его
isdigital := TryStrToInt(smean, prom); //переводим в число
if isdigital = false then //если не удалось привести к числу
MessageDlg('Ошибка ввода', mtError, mbOkCancel, 0); //Ошибка!
until isdigital = true; //повторяем ввод, пока не введут число
pult.setValue(inst1.attribute(s), prom); //запомним введенный числовой аргумент
fmExample.mmOutput.Lines.Add('ЗАДАНО УСЛОВИЕ: '+s+' = ' + IntToStr(prom));
end;
end;
s := ComboBox.Text;
Choice.Choose.Clear;
for j := 0 to inst1.attribute(s).numValues - 1 do
begin
smean := inst1.attribute(s).value(j); //находим очередной тип значения заданного атрибута
Choice.Choose.Items.Add(smean); //и записываем его в список для выбора значений
end;
Choice.Name_of_attr.Caption := s; //поясняем пользователю, какой атрибут он устанавливает
Choice.ShowModal;
main_attr := Choice.Choose.Text;

s := fmExample.ComboBox.Text;

NByes(pult, inst1, flags, main_attr, s);
for i := 0 to length(flags) - 1 do
flags[i] := false;

end;
//////////////////////////////////////////////////////
function NByes(p : TDMInstance; ins : TDMInstances; fl : chpoint; mainstr:string; mainattr:string):real;
var i, j, k, M, N:integer;
s, s1 , s2 : string;
mult, valfunc, v1 : double;
multex : array of real;

begin
M := length(fl);
if (M <> p.numAttributes) or (M <> ins.numAttributes) or (p.numAttributes <> p.numAttributes) then
begin
ShowMessage('Error!');
result := 0;
end;

mult := 1;
N := ins.attribute(mainattr).numValues;
SetLength(multex, N);
for k := 0 to N-1 do
multex[k] := 1;
k := 0;

for k := 0 to length(multex)-1 do
begin
for i := 0 to M-1 do
begin
if fl[i] = true then
begin
j := ins.attribute(mainattr).index; //номер зависимой переменной
s2 := ins.attribute(mainattr).value(k); //одно из значений зависимой переменной

if ins.attribute(i).isNominal then //проверяем независимую переменную на номинальность
begin
s1 := p.stringValue(i); //значение независимой переменной
valfunc := Probability(s1, s2, ins, i, j); //вероятность того, что при данном значении независимой переменной // //зависимая переменная принимает указанное значение
multex[k] := multex[k] * valfunc;
end
else begin
v1 := p.value(i);
valfunc := Probability(v1, s2, ins, i, j);
multex[k] := multex[k] * valfunc;
end;
end;
end;
end;

i := ins.attribute(mainattr).indexOfValue(mainstr);
mult := multex[i];
fmExample.mmOutput.Lines.Add('ИТОГО ');
v1 := 0;
for N := 0 to k-1 do
begin
v1 := v1 + multex[N];
end;
if (v1 = 0) then fmExample.mmOutput.Lines.Add('НЕТ ДАННЫХ ПО ЭТОМУ АТРИБУТУ')
else begin
mult := mult/v1;
fmExample.mmOutput.Lines.Add(mainattr + ' = ' + mainstr + ' с вероятностью ' + FloatToStr(mult) +' при заданных условиях');
end;
result := mult;
end;
//////////////////////////////////////////////////////////
function Probability(strFr:string; strUnfr:string; ins:TDMInstances; indexFr:integer; indexUnfr:integer) : real; overload;
var i , N, numEq, numFulEq : integer;
begin
N := ins.numInstances;
numEq := 0;
numFulEq := 0;
for i :=0 to N-1 do
if (ins.instance(i).stringValue(indexUnfr) = strUnfr) then
begin
numEq := numEq + 1;
if (ins.instance(i).stringValue(indexFr) = strFr) then numFulEq := numFulEq + 1;
end;
if numEq = 0 then result := -1 else result := numFulEq/numEq;
end;
//////////////////////////////////////////////////////////
function Probability(strFr : string; valUnfr:double; ins:TDMInstances; indexFr : integer; indexUnfr : integer):real; overload;
var i , N, numEq, numFulEq : integer;
begin
N := ins.numInstances;
numEq := 0;
numFulEq := 0;
for i :=0 to N-1 do
if (ins.instance(i).value(indexUnfr) = valUnfr) then
begin
numEq := numEq + 1;
if (ins.instance(i).stringValue(indexFr) = strFr) then numFulEq := numFulEq + 1;
end;
if numEq = 0 then result := -1 else result := numFulEq/numEq;
end;
///////////////////////////////////////////////////////////
function Probability(valFr : double; strUnfr : string; ins:TDMInstances; indexFr : integer; indexUnfr : integer):real; overload;
var i , N, numEq, numFulEq : integer;
begin
N := ins.numInstances;
numEq := 0;
numFulEq := 0;
for i :=0 to N-1 do
if (ins.instance(i).stringValue(indexUnfr) = strUnfr) then
begin
numEq := numEq + 1;
if (ins.instance(i).value(indexFr) = valFr) then numFulEq := numFulEq + 1;
end;
if numEq = 0 then result := -1 else result := numFulEq/numEq;
end;
////////////////////////////////////////////////////////////
function Probability(valFr : double; valUnfr:double; ins:TDMInstances; indexFr:integer; indexUnfr:integer):real; overload;
var i , N, numEq, numFulEq : integer;
begin
N := ins.numInstances;
numEq := 0;
numFulEq := 0;
for i :=0 to N-1 do
if (ins.instance(i).value(indexUnfr) = valUnfr) then
begin
numEq := numEq + 1;
if (ins.instance(i).value(indexFr) = valFr) then numFulEq := numFulEq + 1;
end;
if numEq = 0 then result := -1 else result := numFulEq/numEq;
end;
//////////////////////////////////
end.
Соседние файлы в папке Baes