www.pudn.com > Apriori_Kidney.rar > apz.pas
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
else
item.subitems.Add('是') ;
end;
procedure judge4(z,ib,g:integer;liename1,liename2,liename3,liename4:string;var countofD:integer;var D:array of string); //判断四项冗余项的嵌套过程
begin //细心：var D:array of string
if (ib>=g) //如果并发数小于g，判定为冗余项
then
begin
item.subitems.Add('否') ;
D[4*countofD]:=liename1 ;
D[4*countofD+1]:=liename2;
D[4*countofD+2]:=liename3;
D[4*countofD+3]:=liename4;
countofD:=z+1 ;
end
else
item.subitems.Add('是') ;
end;
procedure judge5(z,ib,g:integer;liename1,liename2,liename3,liename4,liename5:string;var countofE:integer;var E:array of string); //判断五项冗余项的嵌套过程
begin //细心：var E:array of string
if (ib>=g) //如果并发数小于g，判定为冗余项
then
begin
item.subitems.Add('否') ;
E[5*countofE]:=liename1 ;
E[5*countofE+1]:=liename2;
E[5*countofE+2]:=liename3;
E[5*countofE+3]:=liename4;
E[5*countofE+4]:=liename5;
countofE:=z+1 ;
end
else
item.subitems.Add('是') ;
end;
procedure judge6(z,ib,g:integer;liename1,liename2,liename3,liename4,liename5,liename6:string;var countofF:integer;var F:array of string); //判断五项冗余项的嵌套过程
begin //细心：var E:array of string
if (ib>=g) //如果并发数小于g，判定为冗余项
then
begin
item.subitems.Add('否') ;
F[6*countofE]:=liename1 ;
F[6*countofE+1]:=liename2;
F[6*countofE+2]:=liename3;
F[6*countofE+3]:=liename4;
F[6*countofE+4]:=liename5;
F[6*countofE+5]:=liename6;
countofF:=z+1 ;
end
else
item.subitems.Add('是') ;
end;
begin //主程序的开始位置
if editgate.Text=''
then
messagedlg('请输入域值',mtError,[mbok],0)
else
try
with adoquery1 do
begin
g:=strtoint(editgate.Text);
sql.clear;
sql.add('select * from tjE_g ');
open;
listview1.Items.BeginUpdate; //开始更新
try
listview1.items.clear;
setvalue(re,ig,il,zxd,ibl,i,ib);
itnb:=0;
first;
while not eof do //是否读到dataset的最后一条记录
begin //计算糖尿病患者总数
if (fieldbyname('tnb').AsVariant='1')
then
itnb:=itnb+1
else
itnb:=itnb;
next; //读dataset的下一条记录
end ;
countofA:=0;
Setlength(A,50);
for v:=0 to 40 do //按列扫描（单列扫描）
begin
first; //返回dataset的第一条记录
while not eof do //按行扫描
begin
onelie(i,ib,lie1array[v],i,ib) ;
next
end;
if (i<>0) then
transtr(i,ib,itnb,ibl,zxd,il,j,jil,jib,jibl,jzxd);
item := listview1.items.add;
fillTable(lie1array[v],j,jil,jib,jibl,jzxd);
judge1(countofA,ib,g,lie1array[v],countofA,A);
setvalue(re,ig,il,zxd,ibl,i,ib);
end; //此时A中有(countA)个元素
k:=-1;
Setlength(H,1000);
for m:=0 to countofA-1 do //由A产生侯选项数组H (1->2)
begin
for n:=m+1 to countofA-1 do //保证没有重项
begin
k:=k+1;
H[2*k]:=A[m];
H[2*k+1]:=A[n];
end;
end;
countofB:=0;
Setlength(B,1000);
for v:=0 to k do //按列扫描 (双列扫描)
begin
first; //返回dataset的第一条记录
while not eof do //按行扫描
begin
twolie(i,ib,H[2*v],H[2*v+1],i,ib) ;
next
end;
if (i<>0) then
transtr(i,ib,itnb,ibl,zxd,il,j,jil,jib,jibl,jzxd);
item := listview1.items.add;
fillTable(H[2*v]+'&'+H[2*v+1],j,jil,jib,jibl,jzxd);
judge2(countofB,ib,g,H[2*v],H[2*v+1],countofB,B);
setvalue(re,ig,il,zxd,ibl,i,ib);
end; //此时B中有2*(countB)个元素
k:=-1;
Setlength(H,1000);
for v:=0 to 999 do
H[v]:=''; //初始化H
for m:=0 to countofB-1 do //由B产生侯选项数组H (2->3)
begin
for n:=m+1 to countofB-1 do
begin
if B[2*m]=B[2*n]
then
begin
k:=k+1;
H[3*k]:=B[2*m];
H[3*k+1]:=B[2*m+1];
H[3*k+2]:=B[2*n+1];
end;
end;
end;
countofC:=0;
Setlength(C,1000);
for v:=0 to k do //按列扫描 (三列扫描)
begin
first; //返回dataset的第一条记录
while not eof do //按行扫描
begin
threelie(i,ib,H[3*v],H[3*v+1],H[3*v+2],i,ib) ;
next
end;
if (i<>0) then
transtr(i,ib,itnb,ibl,zxd,il,j,jil,jib,jibl,jzxd);
item := listview1.items.add;
fillTable(H[3*v]+'&'+H[3*v+1]+'&'+H[3*v+2],j,jil,jib,jibl,jzxd);
judge3(countofC,ib,g,H[3*v],H[3*v+1],H[3*v+2],countofC,C);
setvalue(re,ig,il,zxd,ibl,i,ib);
end; //此时C中有3*(countC)个元素
k:=-1;
Setlength(H,1000);
for v:=0 to 999 do
H[v]:=''; //初始化H
for m:=0 to countofC-1 do //由C产生侯选项数组H (3->4)
begin
for n:=m+1 to countofC-1 do
begin
if (C[3*m]=C[3*n])and (C[3*m+1]=C[3*n+1])
then
begin
k:=k+1;
H[4*k]:=C[3*m];
H[4*k+1]:=C[3*m+1];
H[4*k+2]:=C[3*m+2];
H[4*k+3]:=C[3*n+2];
end;
end;
end;
countofD:=0;
Setlength(D,1000);
for v:=0 to k do //按列扫描 (四列扫描)
begin
first; //返回dataset的第一条记录
while not eof do //按行扫描
begin
fourlie(i,ib,H[4*v],H[4*v+1],H[4*v+2],H[4*v+3],i,ib) ;
next
end;
if (i<>0) then
transtr(i,ib,itnb,ibl,zxd,il,j,jil,jib,jibl,jzxd);
item := listview1.items.add;
fillTable(H[4*v]+'&'+H[4*v+1]+'&'+H[4*v+2]+'&'+H[4*v+3],j,jil,jib,jibl,jzxd);
judge4(countofD,ib,g,H[4*v],H[4*v+1],H[4*v+2],H[4*v+3],countofD,D);
setvalue(re,ig,il,zxd,ibl,i,ib);
end; //此时D中有4*(countD)个元素
k:=-1;
Setlength(H,1000);
for v:=0 to 999 do
H[v]:=''; //初始化H
for m:=0 to countofD-1 do //由D产生侯选项数组H (4->5)
begin
for n:=m+1 to countofD-1 do
begin
if (D[4*m]=D[4*n])and (D[4*m+1]=D[4*n+1])and(D[4*m+2]=D[4*n+2])
then
begin
k:=k+1;
H[5*k]:=D[4*m];
H[5*k+1]:=D[4*m+1];
H[5*k+2]:=D[4*m+2];
H[5*k+3]:=D[4*m+3];
H[5*k+4]:=D[4*n+3];
end;
end;
end;
countofE:=0;
Setlength(E,1000);
for v:=0 to k do //按列扫描 (五列扫描)
begin
first; //返回dataset的第一条记录
while not eof do //按行扫描
begin
fivelie(i,ib,H[5*v],H[5*v+1],H[5*v+2],H[5*v+3],H[5*v+4],i,ib) ;
next
end;
if (i<>0) then
transtr(i,ib,itnb,ibl,zxd,il,j,jil,jib,jibl,jzxd);
item := listview1.items.add;
fillTable(H[5*v]+'&'+H[5*v+1]+'&'+H[5*v+2]+'&'+H[5*v+3]+'&'+H[5*v+4],j,jil,jib,jibl,jzxd);
judge5(countofE,ib,g,H[5*v],H[5*v+1],H[5*v+2],H[5*v+3],H[5*v+4],countofE,E);
setvalue(re,ig,il,zxd,ibl,i,ib);
end; //此时E中有5*(countE)个元素
k:=-1;
Setlength(H,1000);
for v:=0 to 999 do
H[v]:=''; //初始化H
for m:=0 to countofE-1 do //由E产生侯选项数组H (5->6)
begin
for n:=m+1 to countofE-1 do
begin
if (E[5*m]=E[5*n])and (E[5*m+1]=E[5*n+1])and(E[5*m+2]=E[5*n+2])and(E[5*m+3]=E[5*n+3])
then
begin
k:=k+1;
H[6*k]:=E[5*m];
H[6*k+1]:=E[5*m+1];
H[6*k+2]:=E[5*m+2];
H[6*k+3]:=E[5*m+3];
H[6*k+4]:=E[5*m+4];
H[6*k+5]:=E[5*n+4];
end;
end;
end;
countofF:=0;
Setlength(F,1000);
for v:=0 to k do //按列扫描 (6列扫描)
begin
first; //返回dataset的第一条记录
while not eof do //按行扫描
begin
sixlie(i,ib,H[6*v],H[6*v+1],H[6*v+2],H[6*v+3],H[6*v+4],H[6*v+5],i,ib) ;
next
end;
if (i<>0) then
transtr(i,ib,itnb,ibl,zxd,il,j,jil,jib,jibl,jzxd);
item := listview1.items.add;
fillTable(H[6*v]+'&'+H[6*v+1]+'&'+H[6*v+2]+'&'+H[6*v+3]+'&'+H[6*v+4]+'&'+H[6*v+5],j,jil,jib,jibl,jzxd);
judge6(countofF,ib,g,H[6*v],H[6*v+1],H[6*v+2],H[6*v+3],H[6*v+4],H[6*v+5],countofF,F);
setvalue(re,ig,il,zxd,ibl,i,ib);
end; //此时F中有6*(countF)个元素
except
listview1.items.Clear;
messagedlg('运行出错',mtError,[mbok],0);
end ;
end;
finally
Listview1.Items.EndUpdate; //结束更新
end;
edit1.Text:=inttostr(countofA);
edit2.Text:=inttostr(countofB);
edit3.Text:=inttostr(countofC);
edit4.Text:=inttostr(countofD);
edit5.Text:=inttostr(countofE);
edit6.Text:=inttostr(Listview1.Items.Count);
edit7.Text:=inttostr(itnb);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
close;
end;
procedure TForm1.Button3Click(Sender: TObject); //复位过程
begin
editgate.Text:='';
edit1.Text:='';
edit2.Text:='';
edit3.Text:='';
edit4.Text:='';
edit5.Text:='';
edit6.Text:='';
edit7.Text:='';
listview1.items.Clear;
end;
end.