Скачиваний:
31
Добавлен:
01.05.2014
Размер:
15 Кб
Скачать
☆
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