apz.~pas

以从医院病案室获得的3022例数据为样本

unit apz;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB, StdCtrls, ComCtrls, Grids, ExtCtrls;

type
  Tbing = array[0..40] of string;        //定义单个病种的数组类
  TForm1 = class(TForm)
    ADOTable1: TADOTable;
    ADOTable1gxy: TBooleanField;
    ADOTable1xlsc: TBooleanField;
    ADOTable1dmyh2: TBooleanField;
    ADOTable1gxb: TBooleanField;
    ADOTable1gxz: TBooleanField;
    ADOTable1nxg: TBooleanField;
    ADOTable1wy: TBooleanField;
    ADOTable1wky: TBooleanField;
    ADOTable1chy: TBooleanField;
    ADOTable1jxgy: TBooleanField;
    ADOTable1yxgy: TBooleanField;
    ADOTable1gyh: TBooleanField;
    ADOTable1szjb: TBooleanField;
    ADOTable1mxzqg: TBooleanField;
    ADOTable1fxb: TBooleanField;
    ADOTable1fjh: TBooleanField;
    ADOTable1jzb: TBooleanField;
    ADOTable1ggj: TBooleanField;
    ADOTable1jzy: TBooleanField;
    ADOTable1dsz: TBooleanField;
    ADOTable1dny: TBooleanField;
    ADOTable1qlx: TBooleanField;
    ADOTable1fgg: TBooleanField;
    ADOTable1zhi: TBooleanField;
    ADOTable1pfb: TBooleanField;
    ADOTable1yany: TBooleanField;
    ADOTable1quchi: TBooleanField;
    ADOTable1bnz: TBooleanField;
    ADOTable1qgy: TBooleanField;
    ADOTable1swm: TBooleanField;
    ADOTable1erl: TBooleanField;
    ADOTable1bdy: TBooleanField;
    ADOTable1feiy: TBooleanField;
    ADOTable1jzcy: TBooleanField;
    ADOTable1weiy: TBooleanField;
    ADOTable1shiy: TBooleanField;
    ADOTable1gany: TBooleanField;
    ADOTable1ruxy: TBooleanField;
    ADOTable1gjy: TBooleanField;
    ADOTable1biyy: TBooleanField;
    ADOTable1bgy: TBooleanField;
    ADOTable1tnb: TBooleanField;
    DataSource1: TDataSource;
    Button1: TButton;
    ADOQuery1: TADOQuery;
    ListView1: TListView;
    ADOQuery1gxy: TBooleanField;
    ADOQuery1xlsc: TBooleanField;
    ADOQuery1dmyh2: TBooleanField;
    ADOQuery1gxb: TBooleanField;
    ADOQuery1gxz: TBooleanField;
    ADOQuery1nxg: TBooleanField;
    ADOQuery1wy: TBooleanField;
    ADOQuery1wky: TBooleanField;
    ADOQuery1chy: TBooleanField;
    ADOQuery1jxgy: TBooleanField;
    ADOQuery1yxgy: TBooleanField;
    ADOQuery1gyh: TBooleanField;
    ADOQuery1szjb: TBooleanField;
    ADOQuery1mxzqg: TBooleanField;
    ADOQuery1fxb: TBooleanField;
    ADOQuery1fjh: TBooleanField;
    ADOQuery1jzb: TBooleanField;
    ADOQuery1ggj: TBooleanField;
    ADOQuery1jzy: TBooleanField;
    ADOQuery1dsz: TBooleanField;
    ADOQuery1dny: TBooleanField;
    ADOQuery1qlx: TBooleanField;
    ADOQuery1fgg: TBooleanField;
    ADOQuery1zhi: TBooleanField;
    ADOQuery1pfb: TBooleanField;
    ADOQuery1yany: TBooleanField;
    ADOQuery1quchi: TBooleanField;
    ADOQuery1bnz: TBooleanField;
    ADOQuery1qgy: TBooleanField;
    ADOQuery1swm: TBooleanField;
    ADOQuery1erl: TBooleanField;
    ADOQuery1bdy: TBooleanField;
    ADOQuery1feiy: TBooleanField;
    ADOQuery1jzcy: TBooleanField;
    ADOQuery1weiy: TBooleanField;
    ADOQuery1shiy: TBooleanField;
    ADOQuery1gany: TBooleanField;
    ADOQuery1ruxy: TBooleanField;
    ADOQuery1gjy: TBooleanField;
    ADOQuery1biyy: TBooleanField;
    ADOQuery1bgy: TBooleanField;
    ADOQuery1tnb: TBooleanField;
    Button2: TButton;
    Editgate: TEdit;
    Button3: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Label2: TLabel;
    Edit2: TEdit;
    Label3: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    Label5: TLabel;
    Label6: TLabel;
    Edit6: TEdit;
    Label7: TLabel;
    Edit7: TEdit;
    Label8: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end ;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure  transtr(i,ib,itnb:integer;ibl,zxd:real;var il:real;var j,jil,jib,jibl,jzxd:string);
begin                                           //计算及格式转换过程
j:= inttostr(i)   ;
     il:=i/3022;
     ibl:=ib/itnb;
     zxd:=ibl/il;
     jil:=floattostr(il);
     jib:=inttostr(ib)   ;
     jibl:=floattostr(ibl);
     jzxd:=floattostr(zxd);
end;

procedure setvalue(re:real;ig:integer;var il,zxd,ibl:real;var i,ib:integer);
begin                                    //通过re，ig赋值，初始化各值
re:=0;
ig:=0 ;
il:=re;
zxd:=re;
i:=ig;
ib:=ig;
ibl:=re;
end;

procedure TForm1.Button1Click(Sender: TObject);
const
lie1array:Tbing=('gxy','xlsc','dmyh2','gxb','gxz','nxg','wy','wky','chy','jxgy',
'yxgy','gyh','szjb','mxzqg','fxb','fjh','jzb','ggj','jzy','dsz','dny','qlx',
'fgg','zhi','pfb','yany','quchi','bnz','qgy','swm','erl','bdy','feiy','jzcy','weiy',
'shiy','gany','ruxy','gjy','biyy','bgy');       // 赋值数组
var
re:real;
ig:integer;
v:integer;                 //列扫描指针
A:array of string;        //非冗余项的单项项集的数组
H:array of string;        // 侯选项数组
B:array of string;        //非冗余项的双项项集的数组
C:array of string;        //非冗余项的三项项集的数组
D:array of string;        //非冗余项的四项项集的数组
E:array of string;        //非冗余项的五项项集的数组
F:array of string;        //非冗余项的6项项集的数组
countofA:integer;         //非冗余项的单项项集的计数值
countofB:integer;         //非冗余项的双项项集的计数值
countofC:integer;         //非冗余项的三项项集的计数值
countofD:integer;         //非冗余项的四项项集的计数值
countofE:integer;         //非冗余项的五项项集的计数值
countofF:integer;         //非冗余项的6项项集的计数值
m,n,k:integer;             //用于由非冗余项数组产生侯选项数组的变量
g:integer;                // 设置的糖尿病并发数的域值，判断是否为冗余项
i:integer  ;              // 项集患者数
ib:integer  ;                 //糖尿病并发数
itnb:integer;                 //糖尿病患者总数
il: real;                     //项集患者数/3022
ibl:real;                     //糖尿病并发数/糖尿病患者总数
zxd:real;                     //置信度=ibl/il
j:string;                     //以下为数据格式转换
jil:string;
jib:string;
jibl:string;
jzxd:string;
item: TListItem;              // 动态item

procedure Onelie(x,y:integer;liename1:string;var i,ib:integer); //扫描一列的嵌套过程
    begin
   with adoquery1 do
      if (fieldbyname(liename1).AsVariant='1')
         then
           i:=x+1
         else
            i:=x;
   with adoquery1 do
    if  (fieldbyname(liename1).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
         then
         ib:=y+1
        else
         ib:=y;
            end;
procedure Twolie(x,y:integer;liename1,liename2:string;var i,ib:integer);//扫描两列的嵌套过程
    begin
    with adoquery1 do
      if (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')
         then
           i:=x+1
         else
            i:=x;
   with adoquery1 do
    if  (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
         then
         ib:=y+1
        else
         ib:=y;
            end;

procedure Threelie(x,y:integer;liename1,liename2,liename3:string;var i,ib:integer);//扫描三列的嵌套过程
    begin
    with adoquery1 do
      if (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')
         then
           i:=x+1
         else
            i:=x;
   with adoquery1 do
    if  (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
         then
         ib:=y+1
        else
         ib:=y;
            end;

procedure fourlie(x,y:integer;liename1,liename2,liename3,liename4:string;var i,ib:integer);//扫描四列的嵌套过程
    begin
    with adoquery1 do
      if (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')and(fieldbyname(liename4).AsVariant='1')
         then
           i:=x+1
         else
            i:=x;
   with adoquery1 do
    if  (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')and(fieldbyname(liename4).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
         then
         ib:=y+1
        else
         ib:=y;
            end;

procedure fivelie(x,y:integer;liename1,liename2,liename3,liename4,liename5:string;var i,ib:integer);//扫描五列的嵌套过程
    begin
    with adoquery1 do
      if (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')and(fieldbyname(liename4).AsVariant='1')and(fieldbyname(liename5).AsVariant='1')
         then
           i:=x+1
         else
            i:=x;
   with adoquery1 do
    if  (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')and(fieldbyname(liename4).AsVariant='1')and(fieldbyname(liename5).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
         then
         ib:=y+1
        else
         ib:=y;
            end;

procedure sixlie(x,y:integer;liename1,liename2,liename3,liename4,liename5,liename6:string;var i,ib:integer);//扫描6列的嵌套过程
    begin
    with adoquery1 do
      if (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')and(fieldbyname(liename4).AsVariant='1')and(fieldbyname(liename5).AsVariant='1')and(fieldbyname(liename6).AsVariant='1')
         then
           i:=x+1
         else
            i:=x;
   with adoquery1 do
    if  (fieldbyname(liename1).AsVariant='1')and(fieldbyname(liename2).AsVariant='1')and(fieldbyname(liename3).AsVariant='1')and(fieldbyname(liename4).AsVariant='1')and(fieldbyname(liename5).AsVariant='1')and(fieldbyname(liename6).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
         then
         ib:=y+1
        else
         ib:=y;
            end;


procedure  fillTable(liename,j,jil,jib,jibl,jzxd:string)  ;     //填表的嵌套过程
begin
    item.caption := liename ;
    item.subitems.Add(j)   ;
     item.subitems.Add(jil);
    item.subitems.Add(jib);
     item.subitems.Add(jibl);
     item.subitems.Add(jzxd);
end;

procedure judge1(z,ib,g:integer;liename:string;var countofA:integer;var A:array of string); //判断单项冗余项的嵌套过程
begin                                                                      //细心：var A:array of string
 if (ib>=g)                                   //如果并发数小于g，判定为冗余项
     then
     begin
     item.subitems.Add('否') ;
     A[countofA]:=liename   ;
     countofA:=z+1   ;
     end
     else
       item.subitems.Add('是')  ;
end;

procedure judge2(z,ib,g:integer;liename1,liename2:string;var countofB:integer;var B:array of string); //判断双项冗余项的嵌套过程
begin                                                                      //细心：var B:array of string
 if (ib>=g)                                   //如果并发数小于g，判定为冗余项
     then
     begin
     item.subitems.Add('否') ;
     B[2*countofB]:=liename1   ;
     B[2*countofB+1]:=liename2;
     countofB:=z+1   ;
     end
     else
       item.subitems.Add('是')  ;
end;

procedure judge3(z,ib,g:integer;liename1,liename2,liename3:string;var countofC:integer;var C:array of string); //判断三项冗余项的嵌套过程
begin                                                                      //细心：var C:array of string
 if (ib>=g)                                   //如果并发数小于g，判定为冗余项
     then
     begin
     item.subitems.Add('否') ;
     C[3*countofC]:=liename1   ;
     C[3*countofC+1]:=liename2;
     C[3*countofC+2]:=liename3;
     countofC:=z+1   ;
     end