unitfrmassociation.pas

来自「关联规则算法的实现和表示Delphi源码」· PAS 代码 · 共 379 行

unit UnitFrmAssociation;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls,UnitDM, ExtCtrls, StdCtrls,ADODB, Menus, TeEngine,
  Series, TeeProcs, Chart, BubbleCh;

type
  TFrmAssociation = class(TForm)
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    ComboBox1: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Button1: TButton;
    MainMenu1: TMainMenu;
    ItemSet1: TMenuItem;
    N1ItemSet1: TMenuItem;
    N2ItemSet1: TMenuItem;
    Chart1: TChart;
    Series3: TBubbleSeries;
    ListBox1: TListBox;
    procedure FormShow(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure N1ItemSet1Click(Sender: TObject);
    procedure N2ItemSet1Click(Sender: TObject);
    procedure Chart1DblClick(Sender: TObject);
    procedure Chart1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure Chart1Click(Sender: TObject);
  private
    { Private declarations }
      m_iOrderCount:real;
      NewItem:TListItem;
      m_bShow:boolean;

      thePoint:TPoint;
  public
    { Public declarations }
  m_farray:array [0..200] of real;                //only manage the First 200 elements of the array
  m_index: integer;
  m_arrayCount:integer;
  
   procedure Get1ItemSet();   //insert into OneItemset

   procedure Get2ItemSet();   //Insert into TwoItemset

   procedure Fetch1ItemSet();
   procedure Fetch2ItemSet();

  end;

var
  FrmAssociation: TFrmAssociation;

implementation

{$R *.dfm}

procedure TFrmAssociation.Get1ItemSet();
var

 m_iProductID:integer;
 m_iSupport:real;
 m_fSupport:real;

begin

     DM.ADOCommand1.CommandType:=cmdText;
     DM.ADOCommand1.CommandText:='delete from OneItemSet';
     DM.ADOCommand1.Execute;


    DM.ADOQuery1.Close;
    DM.ADOQuery1.SQL.Clear;
    DM.ADOQuery1.SQL.Add('select distinct orderID from FactTable ');
    DM.ADOQuery1.Open;
    m_iOrderCount:=DM.ADOQuery1.RecordCount;

    DM.ADOQuery1.Close;
    DM.ADOQuery1.SQL.Clear;
    DM.ADOQuery1.SQL.Add('select distinct ProductID  from factTable order by productID ');
    DM.ADOQuery1.Open;

    while not DM.ADOQuery1.Eof do
      begin
        m_iProductID:=DM.ADOQuery1.FieldValues['productID'];
        DM.ADOQuery2.Close;
        DM.ADOQuery2.SQL.Clear;
        DM.ADOQuery2.SQL.Add('select Count(OrderID)as support from facttable where productID=:productID');
        DM.ADOQuery2.Prepared:=false;
        DM.ADOQuery2.Parameters.ParamByName('productID').Value:=m_iProductID;
        DM.ADOQuery2.Prepared:=true;
        DM.ADOQuery2.Open;

        m_iSupport:=DM.ADOQuery2.FieldByName('support').AsInteger;
        DM.ADOQuery2.Close;

        m_fSupport:=m_iSupport/m_iOrderCount;
        //if (m_fSupport>0.2 )) then        //0.2is too big,the m_iOrderCount 830,the max m_iSupport 50;
          begin

             DM.ADOCommand1.CommandText:='insert into OneItemSet(ProductID,Support) values (:productid,:Support)';
             DM.ADOCommand1.Prepared:=false;
             DM.ADOCommand1.Parameters.ParamByName('ProductID').Value :=m_iProductID;
             DM.ADOCommand1.Parameters.ParamByName('Support').Value :=m_fSupport;     //Difference from 2Itemset:是不需要确定小数点后的位数，原因：2用了%f，默认是2位吧！
             DM.ADOCommand1.Prepared :=true;
             DM.ADOCommand1.Execute;
          end;


       DM.ADOQuery1.Next;

      end;

      ShowMessage('successful');

end;


procedure TFrmAssociation.FormShow(Sender: TObject);
begin

       if not m_bshow then
        begin
       ComboBox1.Text :=ComboBox1.Items.Strings[0];
       ComboBox2.Text :=Combobox2.Items.Strings[0];

        end;
       m_bShow:=true;
end;

procedure TFrmAssociation.Fetch1ItemSet();
var
 m_strProductID:String;
 m_fSupport:real;
begin

     DM.ADOQuery1.Close;
     DM.ADOQuery1.SQL.Clear;
     DM.ADOQuery1.SQL.Add('select ProductID,Support from OneItemSet where Support>=:minSupport');
     DM.ADOQuery1.Prepared :=false;
     DM.ADOQuery1.Parameters.ParamByName('minSupport').Value :=strToFloat(Combobox1.Text) ;
     DM.ADOQuery1.Prepared :=true;
     DM.ADOQuery1.Open;


     while not DM.ADOQuery1.Eof do
      begin
        m_strProductID:=DM.ADOQuery1.FieldValues['ProductID'];
        m_fSupport:=DM.ADOQuery1.FieldValues['Support'];

        //NewItem:=ListView1.Items.Add;
        //NewItem.Caption:=m_strProductID;
        //NewItem.SubItems.Add(m_strSupport);
         //Series2.Add(m_fSupport,m_strProductID);

        DM.ADOQuery1.Next;

      end;

      DM.ADOQuery1.Close;

end;


procedure TFrmAssociation.Get2ItemSet();
var
ProductNum,i:Integer;
m_iProduct1,m_iProduct2:Integer;
m_fSupport1,m_fSupportOf2,m_fSupport2:real;    //支持度
m_rSupport2:real;                 //支持的orderID个数

m_fConfidence:real;
m_strSQL,m_strSQL1:string;
begin
   //
   DM.ADOCommand1.CommandText:='delete from TwoItemSet';
   DM.ADOCommand1.Execute;

   if (m_iOrderCount<10) then
    begin

    DM.ADOQuery1.Close;
    DM.ADOQuery1.SQL.Clear;
    DM.ADOQuery1.SQL.Add('select distinct orderID from FactTable ');
    DM.ADOQuery1.Open;
    m_iOrderCount:=DM.ADOQuery1.RecordCount;

    DM.ADOQuery1.Close;

    end;

   DM.ADOQuery1.Close;
   DM.ADOQuery1.SQL.Clear;
   DM.ADOQuery1.SQL.Add('select ProductID,Support from OneItemSet');
   DM.ADOQuery1.Open;
   ProductNum:=DM.ADOQuery1.RecordCount;

    for i:=0 to ProductNum-2 do
    begin
        DM.ADOQuery1.First;
        DM.ADOQuery1.MoveBy(i);
        m_iProduct1:=DM.ADOQuery1.FieldValues['ProductID'];
        m_fSupport1:=DM.ADOQuery1.FieldValues['Support'];

        DM.ADOQuery1.Next;
        while not  DM.ADOQuery1.Eof do
          begin
               m_iProduct2:=DM.ADOQuery1.FieldValues['ProductID'];
               m_strSQL:=Format('select Count(OrderID) as Support from FactTable where ProductID=%d and OrderID in (select orderID from FactTable where ProductID=%d )',[m_iProduct2,m_iProduct1] );
               DM.ADOQuery2.Close;
               DM.ADOQuery2.SQL.Clear;
               DM.ADOQuery2.SQL.Add(m_strSQL);
               DM.ADOQuery2.Open;

               m_rSupport2:=DM.ADOQuery2.FieldValues['Support'];

               DM.ADOQuery2.Close;

               m_fSupport2:=m_rSupport2/m_iOrderCount;          //the support of 2Itemset

              // m_fConfidence:=m_fSupport2/m_fSupport1;     //the confidence of 2ItemSet
               //compare m_fSupport1 and m_iProduct2's support ,fetch the min one .
               DM.ADOQuery2.SQL.Clear;
               DM.ADOQuery2.SQL.Add('select support from OneItemSet where ProductID=:product2');
               DM.ADOQuery2.Prepared :=false;
               DM.ADOQuery2.Parameters.ParamByName('product2').Value :=m_iProduct2;
               DM.ADOQuery2.Prepared :=true;
               DM.ADOQuery2.Open;
               m_fSupportOf2:=DM.ADOQuery2.FieldValues['support'];
               DM.ADOQuery2.Close;

               if (m_fSupport1>m_fSupportOf2) then
                  m_fConfidence:=m_fSupport2/m_fSupportOf2
               else                                                    //get the min P(A) or P(B)
                  m_fConfidence:=m_fSupport2/m_fSupport1;

               DM.ADOCommand1.CommandType:=cmdText;            //Be Careful:限定小数点后的位数，
               m_strSQL1:=Format('insert into TwoItemSet(product1,product2,Support,confidence) values(%d,%d,%.4f,%.4f)',[m_iProduct1,m_iProduct2,m_fSupport2,m_fConfidence]);
               DM.ADOCommand1.CommandText:=m_strSQL1;
               DM.ADOCommand1.Execute;

               DM.ADOQuery1.Next;
           end;
    end;

     DM.ADOQuery1.Close;
     ShowMessage('successful');

end;


procedure TFrmAssociation.Fetch2ItemSet();
var
  m_strProduct1,m_strProduct2:string;
  m_strX:string;
  m_fSupport2:real;
  m_fConfidence:real;
  //for test;
  i:integer;
  str:string;

begin
  DM.ADOQuery1.Close;
  DM.ADOQuery1.SQL.Clear;
  DM.ADOQuery1.SQL.Add('select Product1,Product2,Support,Confidence from TwoItemSet where Support>=:a and Confidence>=:b');
  DM.ADOQuery1.Prepared :=false;
  DM.ADOQuery1.Parameters.ParamByName('a').Value :=StrToFloat(Combobox1.Text );
  DM.ADOQuery1.Parameters.ParamByName('b').Value :=StrToFloat(Combobox2.Text );
  DM.ADOQuery1.Prepared :=true;
  DM.ADOQuery1.Open;

  //
  m_index:=0;

  while not DM.ADOQuery1.Eof do
    begin
      m_strProduct1:=DM.ADOQuery1.FieldValues['Product1'];
      m_strProduct2:=DM.ADOQuery1.FieldValues['Product2'];

      m_fSupport2:=DM.ADOQuery1.FieldValues['Support'];
      m_fConfidence:=DM.ADOQuery1.FieldValues['Confidence'];

      //NewItem:=ListView1.Items.Add;
      //NewItem.Caption:=m_strProduct1+'->'+m_strProduct2  ;
      //NewItem.SubItems.Add(m_strSupport2);
      //NewItem.SubItems.Add(m_strConfidence);
      m_strX:=m_strProduct1+'->'+m_strProduct2 +'  : '+FloatTostr(m_fConfidence); ;
      Listbox1.Items.Add(m_strX);
      m_strX:='';
      //for m_arrya
      if (m_index<200)then
        begin
          m_farray[m_index]:=StrToFloat(Format('%.3f',[m_fConfidence]));
          m_index:=m_index+1;
          m_arrayCount:=m_index-1;
        end;
      //Series2.Add(m_fSupport2,m_strX);
      //Series1.Add(m_fConfidence,m_strX);
      //for test
      i:=Series3.AddBubble(m_fSupport2,m_fConfidence,0.01,m_strX,RGB(255,0,0));
      //str:=Format('%d',[i]);
      //ShowMessage(str);


      DM.ADOQuery1.Next;
    end;


end;
procedure TFrmAssociation.Button1Click(Sender: TObject);
begin

  //Fetch1ItemSet();
  //series1.Clear;
  series3.Clear;

  ListBox1.Items.Clear;
  Fetch2ItemSet();
end;

procedure TFrmAssociation.N1ItemSet1Click(Sender: TObject);
begin
      Get1ItemSet();
end;

procedure TFrmAssociation.N2ItemSet1Click(Sender: TObject);
begin
    Get2ItemSet();
end;

procedure TFrmAssociation.Chart1DblClick(Sender: TObject);
var
  tmp:integer;
  thelabel:String ;
  targetvalue:real;
  i:integer;
begin
  tmp:=Series3.GetCursorValueIndex;
  //theLabel:=series1.XValueToText(tmp);

  if (tmp<>-1) then
   begin
       //m_iCountry:=tmp;
       theLabel:=Series3.ValueMarkText[tmp];
        //ListBox1.Selected[tmp]:=true;
        targetValue:=strToFloat(theLabel);
        //ListBox1.MultiSelect:=true;
        for i:=0 to m_arrayCount do
          begin
               if (targetValue=m_fArray[i]) then
                begin
                ListBox1.Selected[i]:=true;
                end;
          end;
       //ListBox1DblClick(Sender);  //this function are running or not ,depending on radioButton1 and radiobutton selected or not

   end;
   //Chart1.CancelMouse:=true;
end;

procedure TFrmAssociation.Chart1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  thePoint.X :=x;
  thePoint.Y :=y;
end;

procedure TFrmAssociation.Chart1Click(Sender: TObject);
begin
 Chart1DblClick(Sender);
end;

end.