📄 c45.pas
字号:
unit c45;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, DB, ADODB,Math;
type
Tbing = array[0..5] of string; //定义单个病种的数组类
TN4=array[0..3,0..1]of string; //以下定义二进制计数的数组类
TN8=array[0..7,0..2]of string;
TN16=array[0..15,0..3]of string;
TForm1 = class(TForm)
ListView1: TListView;
Button1: TButton;
Button2: TButton;
Button3: TButton;
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;
ADOQuery1: TADOQuery;
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;
DataSource1: TDataSource;
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 TForm1.Button1Click(Sender: TObject);
const
lie1array:Tbing=('gxy','gxb','gxz','qlx','bnz','swm'); // 赋值数组
N4:TN4=(('1','1'),('1','0'),('0','1'),('0','0'));
N8:TN8=(('1','1','1'),('1','1','0'),('1','0','1'),('1','0','0'),('0','1','1'),('0','1','0'),('0','0','1'),('0','0','0'));
N16:TN16=(('1','1','1','1'),('1','1','1','0'),('1','1','0','1'),('1','1','0','0'),
('1','0','1','1'),('1','0','1','0'),('1','0','0','1'),('1','0','0','0'),
('0','1','1','1'),('0','1','1','0'),('0','1','0','1'),('0','1','0','0'),
('0','0','1','1'),('0','0','1','0'),('0','0','0','1'),('0','0','0','0'));
var
node:array of string; //节点的字符串数组
n,m_2,m_4,m_8,m_16:integer; //二进制数组计数器
Ent_node,Ent_positive,Ent_negative,newEnt:real; //熵值
gain:real; //熵值的增益率
i1,i2,j1,j2,k1,k2:integer; //计数器 1:正例，2:反例
E:array of Extended; //gain的数组
v,vh:integer; //数组指针
max:real; //gain的最大值
H:array[0..62,0..5] of string; //候选数组(2维)
judge:Boolean; //判断的布尔数
//judge:array of Boolean; //判断的布尔数的字数组
item: TListItem; // 动态item
procedure selectint(re:real;var i:integer); //取整的过程，得到整型值
var
v:integer ;
begin
for v:=0 to 40 do
if (re>=v) and (re<(v+1))
then
i:=v
end;
procedure oneEnt(x1,x2,y1,y2,z1,z2:integer;liename:string;var i1,i2,j1,j2,k1,k2:integer); //扫描一列的子过程
begin
with adoquery1 do
if (fieldbyname('tnb').AsVariant='1')
then
i1:=x1+1
else
i1:=x1;
with adoquery1 do
if (fieldbyname('tnb').AsVariant='0')
then
i2:=x2+1
else
i2:=x2;
with adoquery1 do
if (fieldbyname(liename).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
then
j1:=y1+1
else
j1:=y1;
with adoquery1 do
if (fieldbyname(liename).AsVariant='1')and(fieldbyname('tnb').AsVariant='0')
then
j2:=y2+1
else
j2:=y2;
with adoquery1 do
if (fieldbyname(liename).AsVariant='0')and(fieldbyname('tnb').AsVariant='1')
then
k1:=z1+1
else
k1:=z1;
with adoquery1 do
if (fieldbyname(liename).AsVariant='0')and(fieldbyname('tnb').AsVariant='0')
then
k2:=z2+1
else
k2:=z2;
end;
procedure twoEnt(x1,x2,y1,y2,z1,z2:integer;liename:string;judge_N:Boolean;var i1,i2,j1,j2,k1,k2:integer);
//扫描两列的子过程
begin
with adoquery1 do
if judge_N and (fieldbyname('tnb').AsVariant='1')
then
i1:=x1+1
else
i1:=x1;
with adoquery1 do
if judge_N and (fieldbyname('tnb').AsVariant='0')
then
i2:=x2+1
else
i2:=x2;
with adoquery1 do
if judge_N and (fieldbyname(liename).AsVariant='1')and(fieldbyname('tnb').AsVariant='1')
then
j1:=y1+1
else
j1:=y1;
with adoquery1 do
if judge_N and (fieldbyname(liename).AsVariant='1')and(fieldbyname('tnb').AsVariant='0')
then
j2:=y2+1
else
j2:=y2;
with adoquery1 do
if judge_N and (fieldbyname(liename).AsVariant='0')and(fieldbyname('tnb').AsVariant='1')
then
k1:=z1+1
else
k1:=z1;
with adoquery1 do
if judge_N and (fieldbyname(liename).AsVariant='0')and(fieldbyname('tnb').AsVariant='0')
then
k2:=z2+1
else
k2:=z2;
end;
procedure EntMath(i1,i2,j1,j2,k1,k2:integer;var Ent_node,Ent_positive,Ent_negative,newEnt,gain:real);
var //计算熵值的过程
fenshu_i1:real; //各分数
fenshu_i2:real;
fenshu_j1:real;
fenshu_j2:real;
fenshu_k1:real;
fenshu_k2:real;
gain_shu:real;
split1,split2,split:real;
begin
if i1=0
then
fenshu_i1:=1
else
fenshu_i1:=(i1+i2)/i1;
if i2=0
then
fenshu_i2:=1
else
fenshu_i2:=(i1+i2)/i2;
if j1=0
then
fenshu_j1:=1
else
fenshu_j1:=(j1+j2)/j1;
if j2=0
then
fenshu_j2:=1
else
fenshu_j2:=(j1+j2)/j2;
if k1=0
then
fenshu_k1:=1
else
fenshu_k1:=(k1+k2)/k1;
if k2=0
then
fenshu_k2:=1
else
fenshu_k2:=(k1+k2)/k2;
{if ((i1=0)and(i2=0))or((j1=0)and(j2=0))or((k1=0)and(k2=0))
then
gain:=0
else
begin
Ent_node:=(i1/(i1+i2))* (Ln(fenshu_i1)/Ln(2))+(i2/(i1+i2))* (Ln(fenshu_i2)/Ln(2));
Ent_positive:=(j1/(j1+j2))* (Ln(fenshu_j1)/Ln(2))+(j2/(j1+j2))* (Ln(fenshu_j2)/Ln(2));
Ent_negative:=(k1/(k1+k2))* (Ln(fenshu_k1)/Ln(2))+(k2/(k1+k2))* (Ln(fenshu_k2)/Ln(2));
newEnt:=((j1+j2)/(j1+j2+k1+k2))*Ent_positive+((k1+k2)/(j1+j2+k1+k2))*Ent_negative;
gain:=Ent_node-newEnt;
end }
if (i1=0)and(i2=0)
then
Ent_node:=0
else
Ent_node:=(i1/(i1+i2))* (Ln(fenshu_i1)/Ln(2))+(i2/(i1+i2))* (Ln(fenshu_i2)/Ln(2));
if (j1=0)and(j2=0)
then
begin
Ent_positive:=0;
split1:=0;
end
else
begin
Ent_positive:=(j1/(j1+j2))* (Ln(fenshu_j1)/Ln(2))+(j2/(j1+j2))* (Ln(fenshu_j2)/Ln(2));
split1:=-((j1+j2)/(j1+j2+k1+k2))* (Ln((j1+j2)/(j1+j2+k1+k2))/Ln(2));
end;
if (k1=0)and(k2=0)
then
begin
Ent_negative:=0 ;
split2:=0;
end
else
begin
Ent_negative:=(k1/(k1+k2))* (Ln(fenshu_k1)/Ln(2))+(k2/(k1+k2))* (Ln(fenshu_k2)/Ln(2));
split2:=-((k1+k2)/(j1+j2+k1+k2))* (Ln((k1+k2)/(j1+j2+k1+k2))/Ln(2));
end;
if (j1=0)and(j2=0)and(k1=0)and(k2=0)
then
newEnt:=0
else
newEnt:=((j1+j2)/(j1+j2+k1+k2))*Ent_positive+((k1+k2)/(j1+j2+k1+k2))*Ent_negative;
gain_shu:=Ent_node-newEnt;
split:=split1+split2;
if split<>0
then
gain:=gain_shu/split
else
gain:=0;
end;
procedure setvalue(var i1,i2,j1,j2,k1,k2:integer);
begin //置零，初始化各值
i1:=0;
i2:=0;
j1:=0;
j2:=0;
k1:=0;
k2:=0;
end;
begin //main begin
setlength(node,63); //初始化用于产生候选的数组
Setlength(E,6);
//Setlength(judge,63) ;
try
with adoquery1 do
begin
sql.clear;
sql.add('select * from tjE_g ');
open;
listview1.Items.BeginUpdate; //开始更新
try
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -