Приложение 1. Обучающая и тестовая выборки задачи классификации заемщиков
Данные о заемщиках представлены в виде:
Кредит; Возраст; Собственность; Доход; Был_под_следствием; Имеет_поручителей; Имеет_высшее_образование; Выдать_кредит
Обучающая выборка класса «Платежеспособный заемщик»
45000;19;Car ;4000;0;1;0;1
80000;32;Quarter ;6000;0;1;1;1
60000;53;;6600;0;1;1;1
70000;39;Quarter Car ;4500;0;1;1;1
45000;22;Quarter ;4500;0;1;1;1
20000;33;Quarter Car ;2100;0;1;0;1
70000;22;Car ;4100;0;0;0;1
20000;22;Quarter ;7900;1;1;0;1
15000;36;;6900;1;0;0;1
90000;41;House ;7800;0;0;0;1
80000;35;Quarter Car ;7600;0;1;0;1
50000;58;;6700;0;1;0;1
90000;30;;9500;0;1;0;1
15000;32;House Car ;3300;0;1;1;1
90000;57;Quarter ;8500;0;1;0;1
10000;21;Quarter ;5600;0;0;0;1
55000;40;;9400;0;1;0;1
40000;18;;7400;0;1;0;1
50000;18;Quarter ;6400;0;1;0;1
85000;56;Quarter ;8100;0;1;0;1
15000;34;Quarter ;5300;1;0;0;1
65000;22;Quarter ;9500;0;1;0;1
90000;34;Car ;8500;0;1;1;1
35000;32;Quarter ;8500;0;1;1;1
20000;33;;6700;0;1;1;1
45000;30;Quarter Car ;6600;0;1;1;1
45000;32;House Car ;5400;0;1;0;1
30000;40;Quarter ;1900;0;0;0;1
70000;31;;7900;0;1;0;1
30000;37;Quarter ;9900;0;1;1;1
90000;41;Car ;5500;0;1;0;1
50000;24;Quarter ;3800;0;1;0;1
20000;60;;4500;0;1;0;1
45000;39;;4700;0;1;0;1
35000;40;Quarter ;2000;0;1;0;1
50000;32;;7800;0;1;1;1
25000;25;Quarter ;5500;0;0;0;1
25000;60;;9100;0;0;0;1
20000;49;Quarter ;7700;0;1;0;1
55000;60;Quarter Car ;6500;0;1;1;1
55000;34;Quarter Car ;2900;0;1;1;1
20000;59;;4200;0;1;0;1
15000;47;;7400;0;1;1;1
85000;25;;9400;0;1;0;1
65000;19;House ;4700;0;1;0;1
10000;54;Quarter ;1100;1;1;0;1
65000;21;Quarter Car ;5000;0;1;0;1
45000;48;;7100;0;1;1;1
15000;23;House Quarter ;9200;0;1;0;1
20000;60;Quarter ;7000;0;1;0;1
Обучающая выборка класса «НЕплатежеспособный заемщик»
65000;22;;900;0;1;0;
75000;19;;400;0;1;0;
70000;24;House ;1900;0;0;1;
55000;52;;5200;0;0;0;
85000;38;Quarter ;1500;0;1;1;
35000;46;;6800;0;0;1;
60000;19;Car ;2200;0;1;0;
80000;38;;4800;0;1;0;0
50000;52;Quarter ;1000;0;1;1;0
55000;49;;3700;0;1;0;0
85000;40;Car ;300;1;1;0;0
50000;42;;2100;1;1;1;0
90000;57;;1900;0;0;0;0
60000;29;;6600;0;1;0;0
85000;24;Quarter ;2300;0;1;1;0
70000;28;;7600;0;0;0;0
40000;48;;3400;0;1;1;0
80000;39;Quarter ;9700;0;1;1;0
55000;23;;5000;0;1;0;0
60000;55;Quarter ;1900;0;1;0;0
75000;23;Quarter Car ;2000;0;1;0;0
70000;23;House Quarter ;300;0;1;0;0
25000;26;;4100;1;0;0;0
35000;23;;8800;0;0;0;0
35000;33;;2200;0;0;0;0
70000;21;;3100;0;1;0;0
80000;35;House Quarter Car ;3700;0;1;0;0
60000;40;;4800;0;1;0;0
65000;52;;700;0;0;0;0
90000;27;Quarter ;1800;0;1;1;0
20000;40;Quarter ;500;0;1;0;0
20000;25;Quarter ;200;0;1;1;0
45000;30;Quarter ;1000;0;0;1;0
65000;30;;5900;0;0;1;0
25000;18;Quarter ;1100;1;1;0;0
70000;30;Quarter ;2500;0;1;1;0
50000;40;;4900;0;0;0;0
85000;53;Quarter ;3300;0;1;1;0
85000;53;Car ;1000;1;1;0;0
65000;32;;6400;0;0;0;0
30000;54;;2300;1;1;0;0
35000;18;Quarter ;400;0;1;0;0
25000;32;;5000;0;0;0;0
40000;41;Quarter Car ;1400;0;1;1;0
90000;31;;8700;0;1;1;0
55000;20;;2300;0;1;0;0
90000;38;Car ;1700;1;1;1;0
40000;39;;1900;1;1;1;0
60000;42;;7300;0;0;0;0
55000;48;;3100;0;1;1;0
Тестовая выборка класса «Платежеспособный заемщик»
50000;42;Quarter ;6400;0;1;1;
120000;22;;7300;0;1;1;1
30000;51;House Quarter ;5500;0;1;0;1
25000;51;;7100;0;1;1;1
45000;60;;7900;0;1;1;1
40000;60;Quarter Car ;5100;0;1;0;1
10000;54;;2100;0;1;0;1
70000;48;;9800;0;1;0;1
15000;51;Quarter Car ;6500;0;1;1;1
45000;20;Quarter ;4500;0;0;0;1
90000;35;Quarter ;4800;0;1;0;1
35000;19;Quarter Car ;8100;1;1;0;1
60000;27;House ;6900;0;1;0;1
35000;37;Quarter ;5000;0;1;0;1
10000;54;;8900;0;0;1;1
50000;57;Quarter ;3500;0;1;1;1
40000;45;Quarter ;4600;0;1;1;1
40000;35;Quarter ;6000;0;1;0;1
75000;54;Quarter Car ;7100;0;0;1;1
85000;55;;8600;1;1;0;1
Тестовая выборка класса «НЕплатежеспособный заемщик»
65000;23;;4000;0;1;0;
75000;47;Quarter ;2900;0;1;0;
55000;46;;4000;0;1;0;
30000;50;Quarter ;1300;0;1;1;
20000;52;Car ;700;0;1;0;
65000;43;;1300;0;1;0;0
35000;39;;2600;0;1;0;0
45000;32;;300;0;1;1;0
85000;22;;6400;0;1;0;0
70000;33;;800;0;1;0;0
30000;21;House Car ;1000;0;1;0;0
50000;20;;1100;0;1;0;0
25000;56;House ;800;0;0;0;0
75000;22;Quarter ;1000;1;1;0;0
70000;42;House Quarter ;7100;0;1;1;0
50000;38;House ;3600;0;1;1;0
45000;60;House ;1900;0;1;0;0
70000;23;;2700;0;1;0;0
85000;48;;1900;0;0;0;0
90000;40;Quarter ;2700;0;1;0;0
Выборки были сгенерированны следующей программой
{============================================================================}
{ Программа генерации данных для CHCK_CRD }
{ записывает в выходной файл случайно сгенерированные данные о заемщиках }
{ используется для демонстрации работы программы }
{============================================================================}
{ для записи результатов работы в файл вызывать как: }
{ GEN_CRD.EXE > <имя файла> }
{============================================================================}
const
TeachGC=50; {количество объектов обучающей выборки ДАТЬ КРЕДИТ}
TeachNGC=50; {количество объектов обучающей выборки НЕ ДАВАТЬ КРЕДИТ}
TestGC=20; {количество объектов тестовой выборки ДАТЬ КРЕДИТ}
TestNGC=20; {количество объектов тестовой выборки НЕ ДАВАТЬ КРЕДИТ}
MinCredit=10000;
StepCredit=5000;
MaxCredit=90000;
MinAge=18;
MaxAge=60;
MinIncome=100;
StepIncome=100;
MaxIncome=10000;
{============================================================================}
type
TPropItem=(House,Quarter,Car); {дом, квартира, автомобиль}
TCustomer=record
Credit:LongInt; {размер испрашиваемого кредита}
Age:Word; {возраст}
Property:set of TPropItem; {собственность}
Income:LongInt; {ежемесячный доход}
WasInJail:Boolean; {находился ли в заключении}
HaveFriends:Boolean; {имеются ли поручители}
HaveHighShool:Boolean; {имеет ли высшее образование}
GiveCredit:Boolean; {был ли выдан кредит}
end;
{============================================================================}
function GenRandom(Min,Step,Max:LongInt):LongInt;
begin
GenRandom:=Random(((Max-Min) div Step)+1)*Step+Min;
end;
{============================================================================}
procedure GenInfo(var Customer:TCustomer);
begin
repeat
Customer.Credit:=GenRandom(MinCredit,StepCredit,MaxCredit);
Customer.Age:=GenRandom(MinAge,1,MaxAge);
Customer.Property:=[];
if Random(10)=0 then Customer.Property:=Customer.Property+[House];
if Random(2)=0 then Customer.Property:=Customer.Property+[Quarter];
if Random(5)=0 then Customer.Property:=Customer.Property+[Car];
Customer.Income:=GenRandom(MinIncome,StepIncome,MaxIncome);
Customer.WasInJail:=Random(20)=0;
Customer.HaveFriends:=Random(5)<>0;
Customer.HaveHighShool:=(Random(3)=0)and(Customer.Age>=22);
until Customer.Credit>Customer.Income;
{calc Customer.GiveCredit}
Customer.GiveCredit:=((Customer.Income/Customer.Credit>=0.05)and(Customer.Property <> []))or
((Customer.Income/Customer.Credit>=0.1)and(Customer.HaveFriends))or
((Customer.Income/Customer.Credit>=0.20)and(Customer.HaveHighShool))or
(Customer.Income/Customer.Credit>=0.3);
if Random(100)<=3 then Customer.GiveCredit:=not(Customer.GiveCredit);
end;
{============================================================================}
procedure OutInfo(Customer:TCustomer);
{************}
function BoolToByte(B:Boolean):Byte;
begin
if B then BoolToByte:=1 else BoolToByte:=0
end;
{************}
begin
Write(Customer.Credit,';',Customer.Age,';');
if House in Customer.Property then Write('House ');
if Quarter in Customer.Property then Write('Quarter ');
if Car in Customer.Property then Write('Car ');
Write(';',Customer.Income,';',BoolToByte(Customer.WasInJail));
Write(';',BoolToByte(Customer.HaveFriends),';',BoolToByte(Customer.HaveHighShool));
Writeln(';',BoolToByte(Customer.GiveCredit));
end;
{============================================================================}
var
I:Word;
Customer:TCustomer;
begin
Randomize;
{вывод сведений о порядке следования полей TCustomer}
Writeln('Credit|Age|Property|Income|WasInJail|HaveFriends|HaveHighShool|GiveCredit');
{вывод объектов обучающей выборки ДАТЬ КРЕДИТ}
for I:=1 to TeachGC do
begin
repeat GenInfo(Customer) until Customer.GiveCredit;
OutInfo(Customer);
end;
Writeln;
{вывод объектов обучающей выборки НЕ ДАВАТЬ КРЕДИТ}
for I:=1 to TeachNGC do
begin
repeat GenInfo(Customer) until not Customer.GiveCredit;
OutInfo(Customer);
end;
Writeln;
{вывод объектов тестовой выборки ДАТЬ КРЕДИТ}
for I:=1 to TestGC do
begin
repeat GenInfo(Customer) until Customer.GiveCredit;
OutInfo(Customer);
end;
Writeln;
{вывод объектов тестовой выборки НЕ ДАВАТЬ КРЕДИТ}
for I:=1 to TestNGC do
begin
repeat GenInfo(Customer) until not Customer.GiveCredit;
OutInfo(Customer);
end;
Writeln;
end.
Приложение 2. Обучающая и тестовая выборки задачи оценки стоимости подержанных автомобилей
Данные о автомобилях представлены в виде:
Возраст; Пробег; Соответсвие_СО2; Антикорр; Повреждения; Цена
Обучающая выборка
24;192000;0;0;1;8
19;252000;1;0;1;9
22;264000;0;0;1;9
17;144000;1;0;1;9
7;64000;1;1;1;8
23;308000;0;0;1;9
22;264000;1;0;1;7
10;126000;1;1;3;9
25;230000;0;0;1;8
11;135000;1;1;4;6
18;207000;1;0;1;9
13;164000;0;1;4;2
23;262000;0;0;1;9
23;237000;0;0;1;9
8;107000;0;1;1;8
25;256000;0;0;1;8
23;258000;0;0;1;9
19;213000;1;0;1;9
13;127000;0;1;4;2
22;208000;1;0;1;7
24;273000;1;0;1;6
25;204000;0;0;1;8
19;193000;1;0;1;9
25;279000;0;0;1;8
11;91000;1;1;2;3
20;227000;0;0;1;10
22;182000;1;0;1;7
11;111000;0;1;1;3
21;241000;0;0;1;9
24;266000;0;0;1;8
13;174000;0;1;5;2
13;178000;0;1;1;0
24;296000;1;0;1;6
21;231000;1;0;1;7
7;92000;1;1;1;8
8;74000;0;1;1;8
18;189000;1;0;1;9
25;309000;1;0;1;5
13;136000;0;1;2;1
20;209000;1;0;1;8
21;219000;0;0;1;9
21;261000;1;0;1;7
24;288000;0;0;1;8
19;257000;1;0;1;9
16;184000;1;0;1;10
17;156000;1;0;1;9
16;181000;1;0;1;10
16;182000;1;0;1;10
22;202000;1;0;1;7
24;241000;0;0;1;8
14;146000;1;0;1;11
18;199000;0;0;1;11
20;221000;1;0;2;16
21;216000;0;0;2;19
24;315000;1;0;2;12
11;121000;0;1;5;17
4;34000;1;0;1;16
11;109000;0;0;1;15
13;124000;0;0;1;14
13;135000;0;0;1;14
24;243000;1;0;2;12
13;173000;1;0;1;11
4;36000;0;0;1;18
12;112000;1;0;1;12
6;52000;0;0;1;17
11;144000;0;0;1;15
18;222000;0;0;1;11
21;260000;1;0;2;15
11;137000;0;0;1;15
10;90000;1;0;1;13
4;40000;0;0;1;18
23;231000;1;0;2;13
6;48000;1;0;1;15
1;16000;1;0;1;18
11;118000;1;0;1;13
24;298000;1;0;2;12
22;271000;0;0;2;18
25;328000;0;0;2;15
23;193000;1;0;2;13
23;192000;1;0;3;20
9;107000;1;0;1;14
20;250000;0;0;2;20
9;122000;1;1;4;18
8;82000;0;0;1;16
1;19000;0;0;1;20
16;208000;1;0;2;20
11;149000;1;0;1;13
9;109000;0;0;1;15
22;228000;1;0;2;14
9;120000;0;1;3;20
6;79000;1;0;1;15
22;230000;0;0;2;18
18;222000;0;0;1;11
23;263000;0;0;2;17
11;143000;0;0;1;15
22;274000;1;0;2;14
23;211000;1;0;2;13
17;207000;1;0;2;19
13;124000;0;0;1;14
15;203000;0;0;1;13
25;258000;1;0;4;22
22;291000;1;0;4;28
12;114000;1;0;2;24
24;217000;1;0;5;30
11;140000;0;0;2;29
19;173000;0;0;2;21
9;95000;0;1;4;26
15;153000;0;0;2;25
24;224000;1;0;5;30
23;213000;0;0;3;25
9;122000;1;1;5;22
20;163000;1;0;3;24
15;169000;1;0;2;21
11;125000;1;0;2;25
24;298000;1;0;4;24
9;109000;0;1;4;26
10;91000;1;0;2;26
18;200000;1;0;3;27
12;140000;0;0;2;28
22;269000;1;0;3;21
15;144000;0;0;2;25
14;116000;1;0;2;22
8;113000;1;1;4;24
18;222000;0;0;2;22
15;173000;1;0;2;21
22;182000;1;0;4;28
11;118000;1;0;2;25
21;255000;0;0;3;28
25;307000;1;0;4;22
12;132000;0;0;2;28
16;135000;0;0;2;24
25;252000;1;0;4;22
16;184000;0;0;2;24
18;170000;1;0;3;27
18;184000;1;0;3;27
17;206000;1;0;3;28
21;277000;0;0;3;28
9;88000;1;1;5;22
3;45000;1;1;2;27
21;177000;1;0;4;30
7;70000;1;0;2;29
22;286000;1;0;3;21
14;154000;0;0;2;26
11;130000;0;0;2;29
13;135000;0;0;2;27
17;187000;0;0;2;23
12;128000;0;0;2;28
24;199000;1;0;5;30
9;90000;1;0;2;27
21;280000;1;0;3;22
24;270000;0;0;4;32
12;159000;1;0;3;36
16;145000;1;0;3;30
13;164000;1;0;3;35
9;89000;0;1;5;33
6;70000;0;0;2;34
4;32000;1;0;2;32
21;262000;0;0;4;38
2;26000;1;0;2;34
1;15000;0;0;2;39
25;225000;0;0;5;38
18;180000;0;0;3;33
18;219000;0;0;3;33
18;172000;1;0;4;36
21;232000;0;0;4;38
20;182000;1;0;5;40
5;67000;0;0;2;35
20;210000;0;0;3;30
13;133000;1;0;3;35
17;231000;0;0;3;35
7;57000;0;0;2;33
12;135000;1;0;3;36
22;208000;0;0;4;36
10;133000;1;0;3;39
6;73000;0;0;2;34
21;273000;0;0;4;38
21;239000;0;0;4;38
4;58000;1;0;2;32
18;219000;1;0;4;36
23;305000;1;0;5;33
19;191000;0;0;3;32
23;239000;1;0;5;33
17;211000;1;0;4;38
17;197000;1;0;4;38
14;136000;0;0;3;39
10;135000;0;0;2;30
1;23000;0;0;2;39
20;246000;1;0;5;40
19;252000;0;0;3;32
23;184000;0;0;4;34
11;152000;1;0;3;38
14;117000;0;0;3;39
5;47000;0;1;3;38
20;209000;1;0;4;32
21;191000;0;0;4;38
24;294000;0;0;5;40
2;25000;1;0;2;34
16;192000;1;0;3;30
13;127000;1;0;3;35
25;309000;0;0;5;38
7;84000;1;0;3;44
18;223000;1;0;5;45
4;44000;1;1;4;48
3;43000;0;1;3;47
12;96000;0;0;3;42
12;132000;0;0;3;42
20;240000;0;0;5;50
20;247000;0;0;5;50
18;151000;0;0;4;44
15;167000;0;0;4;50
2;26000;1;1;3;45
7;63000;0;1;5;48
4;34000;1;0;3;48
19;219000;1;0;5;43
8;81000;0;0;3;48
10;125000;0;0;3;45
16;167000;1;0;5;50
10;126000;0;0;3;45
17;225000;1;0;5;47
3;32000;0;1;3;47
16;167000;1;0;5;50
9;105000;0;0;3;47
3;45000;1;0;3;49
9;95000;0;0;3;47
13;104000;1;0;4;46
7;84000;0;0;3;49
11;134000;1;0;4;50
1;16000;1;1;3;49
16;195000;1;0;5;50
18;183000;0;0;4;44
15;200000;0;0;4;50
20;180000;0;0;5;50
17;139000;1;0;5;47
11;131000;0;0;3;44
18;244000;0;0;4;44
18;237000;1;0;5;45
18;223000;1;0;5;45
9;80000;1;0;3;41
23;282000;0;0;5;43
19;211000;0;0;4;42
13;112000;0;0;3;41
13;124000;0;0;3;41
12;116000;0;0;3;42
9;75000;0;0;3;47
18;216000;1;0;5;45
15;186000;0;0;4;50
9;101000;0;0;3;47
19;232000;1;0;5;43
16;151000;1;0;5;50
13;146000;1;0;4;46
17;211000;0;0;5;58
4;50000;0;0;3;54
12;158000;0;0;4;56
13;113000;1;0;5;58
1;16000;1;0;3;52
13;134000;1;0;5;58
1;15000;0;0;3;59
10;81000;1;0;4;52
14;170000;1;0;5;55
4;55000;0;0;3;54
14;150000;0;0;4;52
3;37000;0;0;3;56
6;56000;0;0;3;51
19;154000;0;0;5;53
7;72000;1;0;4;58
14;155000;0;0;4;52
6;68000;0;0;3;51
7;70000;1;0;4;58
2;28000;0;1;3;51
14;115000;0;0;4;52
9;73000;1;0;4;54
4;57000;0;0;3;54
13;124000;0;0;4;54
13;147000;1;0;5;58
1;17000;1;0;3;52
1;11000;0;1;3;56
9;94000;1;0;4;54
2;26000;0;0;3;57
2;21000;1;0;3;51
19;209000;0;0;5;53
12;151000;0;0;4;56
15;137000;1;0;5;53
13;132000;0;0;4;54
1;19000;0;0;3;59
17;179000;0;0;5;58
4;38000;0;0;3;54
4;46000;0;0;3;54
3;41000;1;1;4;54
1;13000;0;1;3;56
19;256000;0;0;5;53
1;19000;1;0;3;52
3;34000;1;1;4;54
13;147000;0;0;4;54
13;175000;1;0;5;58
18;185000;0;0;5;55
19;158000;0;0;5;53
2;29000;1;0;3;51
8;106000;1;0;4;56
17;159000;0;0;5;58
6;84000;0;0;3;51
14;112000;0;0;5;65
9;83000;0;0;4;62
6;76000;1;0;4;60
12;137000;1;0;5;60
14;186000;0;0;5;65
7;60000;0;0;4;66
11;109000;1;0;5;63
3;44000;1;0;4;66
4;61000;1;0;4;64
9;75000;1;0;5;68
12;163000;1;0;5;60
9;115000;0;0;4;62
6;52000;0;0;4;68
3;30000;1;0;4;66
5;57000;0;0;4;70
12;104000;1;0;5;60
1;8000;1;0;4;70
12;108000;0;0;5;70
1;20000;1;1;4;66
5;51000;1;0;4;62
13;133000;0;0;5;68
15;135000;0;0;5;63
5;51000;0;1;5;63
10;112000;1;0;5;65
11;113000;1;0;5;63
14;188000;0;0;5;65
13;175000;0;0;5;68
5;63000;0;0;4;70
6;54000;0;0;4;68
2;23000;1;0;4;68
5;51000;1;0;4;62
6;81000;0;0;4;68
10;96000;0;0;4;60
7;71000;0;0;4;66
1;16000;1;0;4;70
6;72000;1;0;4;60
3;32000;0;1;4;62
10;84000;1;0;5;65
7;92000;0;0;4;66
13;143000;0;0;5;68
6;58000;0;0;4;68
12;145000;0;0;5;70
8;86000;1;0;5;70
1;17000;1;0;4;70
12;147000;0;0;5;70
7;81000;0;0;4;66
11;127000;1;0;5;63
4;60000;0;1;5;70
2;32000;1;1;4;60
5;51000;1;0;4;62
3;36000;0;0;4;74
3;37000;0;0;4;74
1;20000;0;0;4;78
2;26000;0;0;4;76
11;122000;0;0;5;73
2;21000;0;0;4;76
1;15000;0;1;4;74
10;104000;0;0;5;75
4;39000;1;0;5;80
6;73000;1;0;5;75
1;10000;0;1;4;74
9;90000;0;0;5;78
3;42000;0;1;5;78
11;118000;0;0;5;73
2;21000;0;0;4;76
10;93000;0;0;5;75
8;102000;0;0;5;80
5;51000;1;0;5;78
1;20000;0;0;4;78
6;88000;1;0;5;75
1;23000;0;1;4;74
6;61000;1;0;5;75
8;104000;0;0;5;80
1;17000;0;0;4;78
4;57000;0;0;4;72
4;49000;1;0;5;80
3;33000;0;0;4;74
8;68000;0;0;5;80
5;42000;1;0;5;78
4;48000;0;0;4;72
11;92000;0;0;5;73
11;93000;0;0;5;73
6;68000;1;0;5;75
5;72000;1;0;5;78
2;17000;0;0;4;76
10;92000;0;0;5;75
1;16000;0;0;4;78
10;126000;0;0;5;75
9;80000;0;0;5;78
3;42000;0;0;4;74
7;94000;1;0;5;73
11;144000;0;0;5;73
1;18000;0;0;4;78
8;68000;0;0;5;80
7;96000;1;0;5;73
10;105000;0;0;5;75
7;79000;1;0;5;73
11;112000;0;0;5;73
5;66000;1;0;5;78
11;98000;0;0;5;73
6;73000;0;0;5;85
3;32000;1;0;5;83
6;58000;0;0;5;85
6;56000;0;0;5;85
7;76000;0;0;5;83
2;35000;1;0;5;85
5;61000;0;0;5;88
6;77000;0;0;5;85
5;53000;0;0;5;88
1;15000;1;0;5;88
1;18000;1;0;5;88
6;70000;0;0;5;85
6;81000;0;0;5;85
2;23000;0;1;5;85
5;57000;0;0;5;88
2;21000;1;0;5;85
7;84000;0;0;5;83
2;31000;1;0;5;85
5;75000;0;0;5;88
7;68000;0;0;5;83
6;71000;0;0;5;85
2;25000;0;1;5;85
6;59000;0;0;5;85
4;50000;0;0;5;90
6;80000;0;0;5;85
5;42000;0;0;5;88
2;16000;1;0;5;85
3;45000;1;0;5;83
3;33000;1;0;5;83
4;45000;0;0;5;90
1;13000;1;0;5;88
3;42000;1;0;5;83
4;58000;0;0;5;90
1;18000;1;0;5;88
1;15000;1;0;5;88
2;34000;1;0;5;85
7;77000;0;0;5;83
2;17000;1;0;5;85
1;19000;1;1;5;83
6;67000;0;0;5;85
3;35000;1;0;5;83
2;25000;1;0;5;85
1;22000;1;0;5;88
3;45000;1;0;5;83
1;10000;1;0;5;88
6;59000;0;0;5;85
6;82000;0;0;5;85
3;32000;1;0;5;83
6;75000;0;0;5;85
4;55000;0;0;5;90
3;33000;0;0;5;93
1;11000;0;0;5;98
3;43000;0;0;5;93
3;39000;0;0;5;93
2;16000;0;0;5;95
1;20000;0;1;5;93
3;45000;0;0;5;93
2;34000;0;0;5;95
3;45000;0;0;5;93
2;28000;0;0;5;95
1;17000;0;1;5;93
1;17000;0;0;5;98
3;34000;0;0;5;93
2;29000;0;0;5;95
1;21000;0;0;5;98
3;42000;0;0;5;93
3;26000;0;0;5;93
1;17000;0;1;5;93
2;18000;0;0;5;95
2;24000;0;0;5;95
1;12000;0;0;5;98
3;29000;0;0;5;93
1;12000;0;0;5;98
2;22000;0;0;5;95
3;47000;0;0;5;93
3;30000;0;0;5;93
2;25000;0;0;5;95
3;44000;0;0;5;93
3;34000;0;0;5;93
2;23000;0;0;5;95
2;23000;0;0;5;95
3;49000;0;0;5;93
1;11000;0;0;5;98
3;40000;0;0;5;93
1;18000;0;0;5;98
2;24000;0;0;5;95
1;15000;0;0;5;98
1;15000;0;0;5;98
1;18000;0;0;5;98
2;28000;0;0;5;95
1;12000;0;0;5;98
2;33000;0;0;5;95
1;14000;0;1;5;93
3;37000;0;0;5;93
1;20000;0;0;5;98
2;23000;0;0;5;95
2;21000;0;0;5;95
3;41000;0;0;5;93
1;23000;0;0;5;98
3;41000;0;0;5;93
Тестовая выборка
16;198000;1;0;1;10
12;96000;0;1;3;6
11;135000;0;1;2;7
19;162000;1;0;1;9
11;147000;0;1;1;3
23;305000;0;0;1;9
13;126000;0;1;4;2
24;193000;0;0;1;8
17;163000;1;0;1;9
24;221000;0;0;1;8
17;214000;0;0;1;11
25;275000;0;0;2;15
22;294000;1;0;2;14
1;19000;1;0;1;18
10;93000;0;0;1;15
2;33000;0;1;1;17
21;275000;0;0;2;19
15;175000;0;0;1;13
14;114000;0;0;1;13
25;302000;1;0;2;11
4;61000;1;1;2;24
11;102000;0;0;2;29
23;210000;0;0;3;25
17;140000;1;0;3;28
21;220000;1;0;3;22
19;248000;1;0;3;25
22;178000;1;0;4;28
19;153000;1;0;3;25
15;167000;1;0;2;21
12;111000;0;0;2;28
24;269000;0;0;4;32
11;150000;1;0;3;38
9;127000;0;0;2;31
12;134000;1;0;3;36
2;30000;1;1;2;30
7;98000;0;1;4;38
2;18000;1;0;2;34
17;158000;0;0;3;35
3;33000;1;0;2;33
20;261000;0;0;3;30
15;170000;1;0;4;42
18;153000;0;0;4;44
19;233000;1;0;5;43
8;82000;0;0;3;48
18;152000;0;0;4;44
12;158000;1;0;4;48
20;244000;0;0;5;50
11;92000;1;0;4;50
16;132000;1;0;5;50
5;66000;1;1;4;42
3;41000;0;0;3;56
10;98000;1;0;4;52
15;137000;1;0;5;53
13;171000;0;0;4;54
4;40000;0;0;3;54
3;27000;0;0;3;56
6;59000;0;0;3;51
7;72000;1;0;4;58
4;49000;0;0;3;54
5;45000;0;0;3;52
9;86000;1;0;5;68
13;151000;0;0;5;68
8;68000;1;0;5;70
12;157000;0;0;5;70
12;159000;1;0;5;60
6;73000;1;0;4;60
3;39000;1;0;4;66
8;65000;0;0;4;64
12;146000;0;0;5;70
11;148000;1;0;5;63
6;73000;1;0;5;75
1;15000;0;1;4;74
1;15000;0;0;4;78
7;85000;1;0;5;73
1;17000;0;0;4;78
5;58000;1;0;5;78
5;60000;1;0;5;78
5;63000;1;0;5;78
3;43000;0;0;4;74
10;114000;0;0;5;75
3;30000;1;0;5;83
1;17000;1;1;5;83
2;21000;0;1;5;85
5;54000;0;0;5;88
2;26000;1;0;5;85
7;75000;0;0;5;83
4;57000;0;0;5;90
6;60000;0;0;5;85
3;46000;1;0;5;83
5;60000;0;0;5;88
1;19000;0;1;5;93
1;20000;0;0;5;98
2;16000;0;0;5;95
2;26000;0;0;5;95
2;32000;0;0;5;95
2;34000;0;0;5;95
2;20000;0;0;5;95
1;11000;0;0;5;98
3;33000;0;0;5;93
3;42000;0;0;5;93
Выборки были сгенерированы следующей программой
{============================================================================}
{ Программа генерации данных для CAR_PAY }
{ записывает в выходной файл случайно сгенерированные данные о автомобилях }
{ используется для демонстрации работы программы }
{============================================================================}
{ для записи результатов работы в файл вызывать как: }
{ GEN_CAR.EXE > <имя файла> }
{============================================================================}
const
TeachCount=500; {количество объектов обучающей выборки}
TestCount=100; {количество объектов тестовой выборки}
MinAge=1;
StepAge=1;
MaxAge=25;
MinBreak=1;
StepBreak=1;
MaxBreak=5;
PartCount=10;
{============================================================================}
type
TCar=record
Age:Byte;{возраст}
RunLength:LongInt;{пробег}
GoodCO2:Boolean;{соотвествие нормам по выделению CO-2}
CorrDef:Boolean;{наличие антикорозийной защиты}
BodyBreak:Byte;{повреждения корпуса }
Price:Real;{цена в [0..100] % от среднерыночной цены на новый авто данной марки}
end;
{============================================================================}
function GenRandom(Min,Step,Max:LongInt):LongInt;
begin
GenRandom:=LongInt(Random(((Max-Min) div Step)+1))*Step+Min;
end;
{============================================================================}
function BoolToByte(B:Boolean):Byte;
begin
if B then BoolToByte:=1 else BoolToByte:=0
end;
{============================================================================}
procedure GenInfo(var Car:TCar);
begin
Car.Age:=GenRandom(MinAge,StepAge,MaxAge);
Car.RunLength:=Car.Age*(10000+GenRandom(0,1000,5000)-2000)+GenRandom(0,1000,10000);
Car.GoodCO2:=Byte(Random(2))=0;
Car.CorrDef:=Byte(Random(5))=0;
Car.BodyBreak:=Byte(GenRandom(MinBreak,StepBreak,MaxBreak));
Car.Price:=1-((Car.Age*0.025)+
(BoolToByte(Car.GoodCO2)*0.1)+
(BoolToByte(Car.CorrDef)*Car.Age*0.05));
Car.Price:=Car.Price*(Car.BodyBreak)/MaxBreak;
{if Random(100)<=3 then Car.Price:=Car.Price+((5-Byte(Random(10)))/100);}
if Car.Price>1 then Car.Price:=1;
if Car.Price<0 then Car.Price:=0;
Car.Price:=Car.Price*100;
end;
{============================================================================}
procedure OutInfo(Car:TCar);
begin
Writeln(Car.Age,';',
Car.RunLength,';',
BoolToByte(Car.GoodCO2),';',
BoolToByte(Car.CorrDef),';',
Car.BodyBreak,';',
Car.Price:1:0);
end;
{============================================================================}
var
NP,I:Word;
Car:TCar;
begin
Randomize;
{вывод сведений о порядке следования полей TCar}
Writeln('Age|RunLength|GoodCO2|CorrDef|BodyBreak|Price');
{вывод объектов обучающей выборки}
for NP:=1 to PartCount do for I:=1 to TeachCount div PartCount do
begin
repeat GenInfo(Car) until (Car.Price>(NP-1)*(100 div PartCount))and(Car.Price<=NP*(100 div PartCount));
OutInfo(Car);
end;
{вывод объектов тестовой выборки}
Writeln;
for NP:=1 to PartCount do for I:=1 to TestCount div PartCount do
begin
repeat GenInfo(Car) until (Car.Price>(NP-1)*(100 div PartCount))and(Car.Price<=NP*(100 div PartCount));
OutInfo(Car);
end;
Writeln;
end.
Приложение 3. Обучающая и тестовая выборки задачи вывода о поведении цен на фондовой бирже
Данные представлены в виде:
Изм_проц_ставки; Изм_курса_$; Изм_проц_ставки_фед_резерва; Обращение_денег_федерального_резерва; Изме_цен
Обучающая выборка класса «Уровень цен снижается»
-1;-1;1;-1;-1
1;-1;1;0;-1
-1;-1;0;-1;-1
1;0;0;0;-1
0;0;1;-1;-1
1;0;0;-1;-1
1;-1;0;0;-1
1;1;1;-1;-1
0;-1;1;1;-1
0;0;1;-1;-1
1;0;1;-1;-1
0;-1;-1;-1;-1
1;0;1;1;-1
-1;0;1;-1;-1
1;-1;-1;0;-1
1;0;0;0;-1
-1;-1;1;0;-1
-1;-1;1;0;-1
0;-1;1;-1;-1
1;1;0;-1;-1
1;-1;-1;-1;-1
1;0;-1;-1;-1
1;0;0;-1;-1
1;-1;1;-1;-1
1;1;0;-1;-1
1;0;1;-1;-1
1;-1;1;0;-1
0;-1;1;-1;-1
1;0;1;-1;-1
1;1;1;0;-1
1;1;1;-1;-1
0;0;1;-1;-1
0;-1;0;0;-1
-1;-1;0;1;-1
0;-1;1;0;-1
0;-1;1;0;-1
1;-1;0;0;-1
0;0;1;-1;-1
0;-1;0;-1;-1
1;-1;0;-1;-1
1;-1;0;-1;-1
0;-1;1;1;-1
0;-1;1;-1;-1
1;-1;0;-1;-1
-1;-1;1;0;-1
1;-1;0;-1;-1
0;-1;1;1;-1
0;-1;1;1;-1
1;-1;1;1;-1
1;-1;1;0;-1
0;-1;1;-1;-1
-1;-1;1;0;-1
1;-1;0;1;-1
-1;-1;1;-1;-1
-1;-1;1;0;-1
0;-1;-1;-1;-1
1;-1;0;1;-1
1;0;1;1;-1
1;1;1;0;-1
1;0;0;0;-1
0;-1;1;0;-1
1;-1;0;0;-1
0;-1;1;1;-1
1;-1;0;0;-1
-1;0;1;-1;-1
1;-1;1;1;-1
0;-1;0;0;-1
1;0;1;-1;-1
0;0;0;-1;-1
1;0;1;-1;-1
1;-1;0;1;-1
-1;-1;1;-1;-1
1;-1;0;1;-1
-1;-1;1;0;-1
1;0;-1;-1;-1
1;-1;-1;0;-1
1;0;1;0;-1
-1;-1;1;1;-1
1;0;0;0;-1
1;0;-1;1;-1
1;0;1;0;-1
-1;0;1;-1;-1
0;-1;1;1;-1
1;0;1;1;-1
1;-1;-1;-1;-1
1;-1;-1;-1;-1
1;-1;1;0;-1
1;-1;0;-1;-1
1;1;1;0;-1
-1;-1;1;-1;-1
1;0;-1;-1;-1
1;0;0;-1;-1
1;0;-1;-1;-1
1;0;0;0;-1
1;-1;1;0;-1
1;-1;0;0;-1
1;0;1;0;-1
0;-1;0;0;-1
0;-1;0;0;-1
0;-1;-1;-1;-1
Обучающая выборка класса «Уровень цен без изменений»
-1;-1;-1;-1;0
-1;0;1;0;0
0;0;-1;-1;0
-1;0;0;-1;0
1;0;0;1;0
0;0;1;1;0
1;0;0;1;0
-1;1;1;-1;0
0;-1;-1;0;0
0;0;0;0;0
0;-1;0;1;0
-1;-1;0;0;0
1;0;-1;0;0
0;0;-1;-1;0
0;1;0;-1;0
0;-1;0;1;0
-1;-1;0;0;0
0;0;-1;-1;0
-1;0;0;-1;0
0;0;-1;-1;0
1;1;-1;-1;0
0;1;0;-1;0
-1;1;1;-1;0
1;1;1;1;0
0;1;0;-1;0
0;1;0;-1;0
-1;1;1;-1;0
0;0;0;0;0
1;1;1;1;0
1;0;0;1;0
0;0;0;0;0
0;-1;-1;0;0
0;0;-1;-1;0
0;-1;0;1;0
0;0;1;1;0
-1;0;1;0;0
1;1;0;0;0
-1;1;1;-1;0
1;1;0;0;0
-1;1;1;-1;0
0;0;-1;-1;0
1;1;0;0;0
-1;-1;1;1;0
1;0;0;1;0
0;0;-1;-1;0
-1;0;0;-1;0
-1;1;1;-1;0
0;-1;-1;0;0
1;1;1;1;0
1;1;1;1;0
1;1;1;1;0
0;0;-1;-1;0
1;0;-1;0;0
-1;1;1;-1;0
1;1;0;0;0
-1;-1;1;1;0
-1;0;1;0;0
-1;-1;-1;-1;0
-1;-1;0;0;0
1;1;1;1;0
0;0;0;0;0
0;-1;-1;0;0
-1;0;1;0;0
0;-1;0;1;0
-1;0;0;-1;0
1;1;-1;-1;0
1;1;-1;-1;0
1;0;-1;0;0
-1;0;1;0;0
-1;1;1;-1;0
1;0;0;1;0
-1;-1;-1;-1;0
0;-1;-1;0;0
-1;0;0;-1;0
0;0;0;0;0
1;-1;-1;1;0
1;1;-1;-1;0
-1;0;1;0;0
1;1;0;0;0
1;1;-1;-1;0
0;-1;0;1;0
0;1;0;-1;0
1;0;-1;0;0
0;0;-1;-1;0
-1;1;1;-1;0
0;0;-1;-1;0
1;1;0;0;0
-1;-1;0;0;0
0;-1;-1;0;0
-1;-1;1;1;0
1;1;1;1;0
-1;-1;0;0;0
0;1;1;0;0
0;1;1;0;0
0;0;0;0;0
-1;0;0;-1;0
0;0;1;1;0
-1;1;1;-1;0
-1;0;0;-1;0
1;0;0;1;0
Обучающая выборка класса «Уровень цен повышается»
1;0;-1;1;1
-1;-1;-1;0;1
-1;1;-1;-1;1
0;1;-1;0;1
-1;0;0;1;1
-1;0;-1;-1;1
1;1;0;1;1
0;0;-1;0;1
1;1;-1;0;1
-1;1;-1;1;1
-1;0;0;1;1
-1;0;0;0;1
-1;0;-1;0;1
-1;0;0;0;1
-1;1;0;1;1
0;1;0;1;1
0;1;0;1;1
1;1;-1;1;1
-1;0;0;0;1
-1;1;1;0;1
-1;1;-1;0;1
-1;0;0;1;1
1;1;-1;0;1
-1;1;0;-1;1
0;-1;-1;1;1
0;1;-1;0;1
-1;0;1;1;1
-1;0;1;1;1
0;1;-1;-1;1
1;1;-1;1;1
-1;0;0;0;1
-1;0;-1;-1;1
0;1;-1;-1;1
0;1;1;1;1
-1;1;1;0;1
1;0;-1;1;1
0;-1;-1;1;1
-1;1;0;0;1
0;1;1;1;1
0;-1;-1;1;1
0;0;0;1;1
-1;0;0;1;1
1;1;-1;1;1
-1;1;0;-1;1
-1;1;-1;1;1
1;0;-1;1;1
0;-1;-1;1;1
-1;-1;0;1;1
-1;1;-1;0;1
0;0;-1;1;1
0;1;1;1;1
0;1;0;1;1
1;1;-1;0;1
-1;0;-1;-1;1
0;1;1;1;1
0;1;0;1;1
-1;0;0;1;1
-1;0;-1;1;1
1;1;0;1;1
0;0;-1;0;1
0;0;-1;1;1
-1;1;1;0;1
0;0;-1;1;1
1;1;0;1;1
-1;0;-1;-1;1
0;1;-1;1;1
-1;1;0;-1;1
1;1;-1;0;1
0;0;0;1;1
-1;1;-1;0;1
0;0;0;1;1
-1;1;-1;1;1
-1;0;0;0;1
0;1;-1;0;1
1;1;0;1;1
0;0;-1;0;1
-1;-1;0;1;1
0;1;-1;0;1
-1;0;0;1;1
-1;1;0;1;1
1;1;-1;1;1
-1;0;-1;-1;1
0;1;-1;0;1
-1;1;1;1;1
-1;1;-1;-1;1
0;1;1;1;1
1;1;-1;0;1
0;1;-1;1;1
1;1;-1;1;1
-1;-1;-1;0;1
-1;-1;-1;0;1
-1;1;-1;1;1
-1;1;-1;-1;1
-1;1;-1;-1;1
0;0;0;1;1
-1;0;0;0;1
1;1;-1;1;1
-1;0;0;1;1
-1;0;-1;-1;1
-1;1;-1;0;1
Тестовая выборка класса «Уровень цен снижается»
1;-1;-1;-1;-1
1;-1;0;-1;-1
1;-1;0;-1;-1
1;0;0;-1;-1
1;1;0;-1;-1
-1;-1;1;-1;-1
-1;-1;1;-1;-1
1;0;0;-1;-1
-1;-1;1;0;-1
1;-1;1;1;-1
0;-1;1;1;-1
-1;-1;0;-1;-1
1;0;1;1;-1
1;-1;1;-1;-1
1;-1;0;-1;-1
1;-1;0;1;-1
1;-1;1;0;-1
0;-1;0;0;-1
0;-1;0;0;-1
1;-1;1;0;-1
0;0;1;0;-1
1;0;1;0;-1
0;1;1;-1;-1
-1;0;1;-1;-1
1;1;0;0;-1
1;-1;0;1;-1
1;0;1;1;-1
1;-1;1;0;-1
1;0;1;-1;-1
0;-1;1;0;-1
0;0;1;0;-1
1;0;1;0;-1
1;-1;0;-1;-1
0;0;0;-1;-1
0;0;1;0;-1
0;-1;1;1;-1
1;-1;1;1;-1
1;0;0;0;-1
1;-1;1;1;-1
1;-1;1;-1;-1
1;0;0;0;-1
1;0;1;1;-1
0;0;0;-1;-1
-1;-1;1;-1;-1
1;1;1;0;-1
1;0;1;-1;-1
0;0;0;-1;-1
1;-1;0;-1;-1
-1;-1;0;-1;-1
1;0;1;0;-1
0;0;0;-1;-1
-1;-1;0;-1;-1
1;0;1;1;-1
0;-1;-1;-1;-1
1;-1;0;-1;-1
1;-1;1;1;-1
0;-1;1;0;-1
-1;0;1;-1;-1
1;0;1;-1;-1
0;-1;-1;-1;-1
1;1;1;0;-1
0;-1;-1;-1;-1
1;-1;1;-1;-1
1;-1;1;1;-1
1;-1;1;0;-1
1;-1;0;-1;-1
1;-1;1;-1;-1
0;-1;0;0;-1
1;0;0;0;-1
1;0;0;-1;-1
0;-1;0;0;-1
1;1;1;-1;-1
-1;-1;1;-1;-1
-1;-1;1;0;-1
1;0;0;-1;-1
0;0;1;-1;-1
1;-1;1;1;-1
-1;-1;1;0;-1
-1;-1;1;-1;-1
1;0;1;-1;-1
1;1;1;0;-1
1;1;1;-1;-1
1;-1;1;-1;-1
1;0;1;-1;-1
1;-1;1;0;-1
1;1;0;-1;-1
0;-1;-1;-1;-1
1;-1;0;0;-1
-1;0;1;-1;-1
1;1;1;-1;-1
1;0;1;-1;-1
0;-1;1;1;-1
1;-1;0;0;-1
-1;-1;1;-1;-1
1;1;1;0;-1
1;-1;1;-1;-1
1;0;0;0;-1
0;-1;1;1;-1
1;1;1;-1;-1
1;0;0;0;-1
Тестовая выборка класса «Уровень цен без изменений»
0;0;1;1;0
-1;1;1;-1;0
0;-1;0;1;0
1;1;-1;-1;0
1;-1;-1;1;0
1;1;-1;-1;0
0;0;-1;-1;0
-1;-1;-1;-1;0
-1;-1;0;0;0
-1;0;1;0;0
1;1;1;1;0
1;-1;-1;1;0
0;0;-1;-1;0
1;0;0;1;0
-1;-1;-1;-1;0
-1;0;1;0;0
-1;0;0;-1;0
0;-1;-1;0;0
1;0;0;1;0
0;-1;-1;0;0
-1;0;0;-1;0
-1;0;1;0;0
-1;-1;-1;-1;0
-1;0;0;-1;0
1;-1;-1;1;0
1;0;-1;0;0
1;1;1;1;0
1;0;0;1;0
-1;1;1;-1;0
-1;-1;0;0;0
0;-1;0;1;0
0;-1;-1;0;0
-1;0;0;-1;0
1;0;-1;0;0
1;0;-1;0;0
-1;0;1;0;0
1;1;0;0;0
-1;0;0;-1;0
0;1;1;0;0
0;-1;0;1;0
1;1;1;1;0
1;1;-1;-1;0
1;0;0;1;0
1;1;-1;-1;0
-1;-1;0;0;0
1;0;0;1;0
1;0;0;1;0
-1;0;0;-1;0
1;0;-1;0;0
0;0;1;1;0
-1;1;1;-1;0
0;1;1;0;0
0;0;-1;-1;0
0;-1;0;1;0
1;0;0;1;0
-1;-1;-1;-1;0
1;-1;-1;1;0
0;1;1;0;0
-1;0;1;0;0
-1;-1;1;1;0
1;-1;-1;1;0
0;0;-1;-1;0
-1;0;0;-1;0
-1;-1;1;1;0
0;0;0;0;0
-1;1;1;-1;0
1;1;0;0;0
0;0;1;1;0
0;1;1;0;0
-1;0;0;-1;0
1;0;0;1;0
0;-1;0;1;0
-1;-1;0;1;0
0;1;0;-1;0
-1;-1;1;1;0
-1;0;1;0;0
-1;-1;-1;-1;0
-1;0;0;-1;0
1;1;-1;-1;0
0;0;-1;-1;0
1;-1;-1;1;0
-1;-1;-1;-1;0
0;-1;0;1;0
-1;0;-1;-1;0
1;0;0;1;0
1;0;0;1;0
0;0;0;0;0
1;1;-1;-1;0
-1;-1;1;1;0
-1;-1;1;1;0
0;0;0;0;0
0;0;1;1;0
0;0;1;1;0
1;1;1;1;0
-1;0;0;-1;0
0;0;-1;-1;0
1;1;1;1;0
0;1;0;-1;0
1;1;-1;-1;0
1;1;-1;0;0
Тестовая выборка класса «Уровень цен повышается»
0;0;-1;0;1
0;-1;-1;1;1
0;0;-1;1;1
0;0;-1;1;1
-1;1;-1;0;1
0;1;-1;-1;1
-1;1;-1;1;1
-1;1;0;1;1
-1;1;0;1;1
-1;0;0;0;1
-1;1;-1;0;1
-1;1;-1;1;1
0;1;-1;0;1
-1;1;0;0;1
0;1;0;1;1
-1;0;-1;-1;1
-1;1;1;1;1
0;0;-1;0;1
1;1;-1;1;1
-1;1;0;1;1
0;1;-1;-1;1
1;1;0;1;1
0;1;0;0;1
1;1;0;1;1
-1;1;0;1;1
-1;-1;-1;0;1
0;1;-1;1;1
0;0;-1;0;1
0;1;-1;-1;1
-1;1;-1;0;1
-1;1;-1;-1;1
0;1;1;1;1
0;0;-1;0;1
-1;1;0;-1;1
0;1;-1;-1;1
0;0;-1;1;1
-1;1;0;-1;1
1;1;0;1;1
-1;1;-1;0;1
-1;1;0;1;1
1;1;-1;0;1
1;1;-1;1;1
-1;0;0;0;1
0;1;-1;0;1
-1;-1;0;1;1
1;0;-1;1;1
0;0;-1;0;1
-1;-1;-1;0;1
0;0;-1;1;1
1;0;-1;1;1
-1;0;0;1;1
0;1;0;1;1
0;0;-1;0;1
0;0;-1;0;1
-1;1;-1;1;1
0;1;0;0;1
0;1;-1;-1;1
-1;1;1;0;1
-1;1;1;0;1
0;1;-1;0;1
0;1;-1;-1;1
-1;1;0;0;1
1;1;-1;1;1
-1;-1;0;1;1
1;1;-1;0;1
0;1;-1;0;1
-1;1;0;1;1
-1;1;1;0;1
0;1;-1;-1;1
-1;1;-1;-1;1
-1;1;0;-1;1
-1;1;-1;-1;1
-1;1;0;-1;1
-1;1;0;0;1
0;1;-1;0;1
-1;-1;-1;0;1
-1;0;1;1;1
-1;1;1;0;1
-1;0;0;1;1
0;1;1;1;1
1;1;0;1;1
0;1;0;0;1
0;1;1;1;1
-1;1;0;-1;1
-1;1;0;1;1
-1;1;1;1;1
-1;-1;-1;1;1
-1;1;0;-1;1
1;0;-1;1;1
0;1;0;1;1
1;1;-1;0;1
-1;0;-1;0;1
-1;-1;-1;0;1
-1;1;-1;0;1
0;-1;-1;1;1
0;0;-1;1;1
-1;1;-1;0;1
-1;0;1;1;1
0;0;-1;0;1
1;1;-1;0;1
Выборки были сгенерированы следующей программой
{============================================================================}
{ Программа генерации данных для CHCK_MRK }
{ записывает в выходной файл случайно сгенерированные данные о бирже }
{ используется для демонстрации работы программы }
{============================================================================}
{ для записи результатов работы в файл вызывать как: }
{ GEN_MRK.EXE > <имя файла> }
{============================================================================}
const
TeachCount=300; {количество объектов обучающей выборки}
TestCount=300; {количество объектов тестовой выборки}
{============================================================================}
type
TDynInfo=(GoDown,GoNone,GoUp);
TMarket=record
Stavka:TDynInfo; {изменение процентной ставки}
Kurs:TDynInfo; {изменение курса $}
StavkaReserv:TDynInfo; {изменение процентной ставки федерального резерва}
ObrReserv:TDynInfo; {обращение денеиг федерального резерва - изъятие, без измененний, добавление}
Prices:TDynInfo; {уровень цен на бирже}
end;
{============================================================================}
procedure GenDynInfo(var D:TDynInfo);
begin
case Random(3) of
0:D:=GoDown;
1:D:=GoNone;
2:D:=GoUp;
end;
end;
{============================================================================}
function D(Dyn:TDynInfo):ShortInt;
begin
case Dyn of
GoDown:D:=-1;
GoNone:D:= 0;
GoUp :D:=+1;
end;
end;
{============================================================================}
procedure GenInfo(var M:TMarket);
var
R:Real;
begin
GenDynInfo(M.Stavka);
GenDynInfo(M.Kurs);
GenDynInfo(M.StavkaReserv);
GenDynInfo(M.ObrReserv);
R:=(-1*D(M.Stavka))+(+1*D(M.Kurs))+(-1*D(M.StavkaReserv))+(+1*D(M.ObrReserv));
if Random(100)<=3 then R:=R+Byte(Random(3))-2;
if R<0 then M.Prices:=GoDown
else if R=0 then M.Prices:=GoNone
else M.Prices:=GoUp;
end;
{============================================================================}
procedure OutInfo(M:TMarket);
begin
Writeln(D(M.Stavka),';',D(M.Kurs),';',D(M.StavkaReserv),';',D(M.ObrReserv),';',D(M.Prices));
end;
{============================================================================}
var
I:Word;
M:TMarket;
begin
Randomize;
{вывод сведений о порядке следования полей TMarket}
Writeln('Stavka|Kurs|StavkaReserv|ObrReserv|Prices');
{вывод объектов обучающей выборки}
for I:=1 to TeachCount div 3 do
begin
repeat GenInfo(M) until M.Prices=GoDown; OutInfo(M);
end;
Writeln;
for I:=1 to TeachCount div 3 do
begin
repeat GenInfo(M) until M.Prices=GoNone; OutInfo(M);
end;
Writeln;
for I:=1 to TeachCount div 3 do
begin
repeat GenInfo(M) until M.Prices=GoUp; OutInfo(M);
end;
Writeln;
{вывод объектов обучающей выборки}
for I:=1 to TestCount div 3 do
begin
repeat GenInfo(M) until M.Prices=GoDown; OutInfo(M);
end;
Writeln;
for I:=1 to TestCount div 3 do
begin
repeat GenInfo(M) until M.Prices=GoNone; OutInfo(M);
end;
Writeln;
for I:=1 to TestCount div 3 do
begin
repeat GenInfo(M) until M.Prices=GoUp; OutInfo(M);
end;
Writeln;
end.
Приложение 4. Обучающая и тестовая выборки задачи прогнозирования объема ежедневных продаж
Выборки построены на основе ежедневных данных Сводно-Денежного Отчета Почтового отдела Тейковского почтамта, код 395 «Продажи коммерческих товаров», за период с марта 2003 по апрель 2004 года включительно.
Данные представлены в виде: день_недели; сумма
Просмотр данных сверху - вниз, слева – направо.
Обучающая выборка
5;5631.00
6;3949.58
1;9398.00
3;4920.65
4;7221.00
5;6749.09
6;2557.00
1;3390.57
2;4621.90
3;7071.00
4;5458.69
5;7980.00
6;4497.00
1;5676.98
2;3778.36
3;5531.43
4;4998.07
5;8008.00
6;1440.00
1;8685.00
2;14505.77
3;12116.15
4;10160.56
5;10129.47
6;7120.00
1;3187.50
2;2036.90
3;2940.35
4;3152.00
5;5117.15
6;4545.26
1;17659.48
2;4316.00
3;2868.62
4;9303.11
5;12880.00
6;3814.00
1;7386.81
2;15653.02
3;11320.05
4;5578.52
5;9689.00
6;5448.00
2;10787.61
3;4800.39
4;7751.00
5;14010.88
6;545.00
1;10062.57
2;3522.19
3;4654.15
4;12448.83
5;8384.28
1;4100.00
2;18514.00
3;5670.60
4;12137.76
5;9718.00
6;10402.00
1;13959.58
2;6824.52
3;6372.00
4;18615.00
5;8412.88
6;6041.00
1;16555.69
2;5853.00
3;8278.01
4;6666.00
5;2802.48
6;4162.00
1;9095.00
2;3480.00
3;7902.79
4;15890.79
5;5000.72
6;18191.15
1;20707.00
2;4966.00
3;8453.07
4;2979.03
5;4355.00
6;568.00
1;53739.79
2;6780.80
3;13482.48
4;4699.10
5;1640.81
6;15994.00
1;8892.00
2;13348.61
3;11917.10
4;10468.70
5;10875.62
6;1100.00
1;8843.30
2;7038.00
3;14096.54
6;5611.30
1;8100.50
2;15344.63
3;8420.80
4;2285.43
6;3583.00
1;3927.00
2;4955.49
3;10709.43
4;9546.68
5;3953.00
6;15471.00
1;6688.00
2;8997.46
3;11510.00
4;3619.00
5;11657.77
6;1634.00
1;18710.74
2;4869.00
3;7140.64
4;14047.00
5;2272.83
6;3584.00
1;42715.00
2;4568.79
3;10551.42
4;8572.88
5;21593.81
6;3072.50
1;6421.84
2;15585.00
3;8645.00
5;5474.00
6;12062.92
1;15234.32
2;13195.75
3;5518.64
4;13321.04
5;10949.00
6;1666.00
1;14926.19
2;1901.00
3;6851.00
4;975.00
5;6882.74
6;3974.00
1;25832.00
2;12735.81
3;5551.88
4;37112.76
5;1145.00
6;5228.15
1;12349.34
2;8156.14
3;17437.34
4;3206.27
5;6015.95
6;1625.00
1;12571.91
2;11419.52
3;9433.35
4;4535.00
5;16897.34
6;9091.00
1;8403.41
2;11973.00
3;2664.00
4;6781.54
5;11120.00
6;6262.00
1;13856.41
2;3657.65
3;11204.94
4;5447.50
5;3282.69
6;3994.00
1;6126.50
2;2879.19
3;10469.10
4;9570.98
5;31403.39
6;360.00
1;16141.00
2;11070.88
3;6787.00
4;8319.75
5;6598.56
6;5800.00
1;18840.00
2;7326.71
3;9737.91
4;13595.50
5;3234.00
6;2889.00
1;29076.58
2;6628.50
3;5841.50
4;5890.20
5;7389.97
6;3942.00
1;8470.50
2;4057.50
3;13109.87
4;5801.69
5;1907.72
6;11985.00
1;15162.00
2;31069.07
3;6222.50
4;4744.24
5;3420.00
6;6892.72
1;11029.81
2;21603.50
3;5530.49
4;8390.15
5;3713.00
6;5001.00
1;5097.67
2;10890.50
3;36003.36
4;9477.50
5;12836.65
6;1725.00
1;1931.47
2;8441.00
3;1140.00
4;2685.50
5;10436.53
6;35812.50
1;39817.79
2;3862.50
3;10104.86
4;13339.61
5;7789.00
6;4714.01
1;11798.39
2;5030.90
3;12670.94
4;25089.85
5;6864.98
6;4846.00
1;3055.12
2;7312.14
3;4976.76
4;19723.50
5;5043.17
6;11794.00
1;10001.00
2;11365.09
3;3795.02
4;4877.32
5;8307.52
6;10620.27
1;15895.39
2;40761.50
3;10404.91
4;13001.47
6;2534.68
1;9194.15
2;7181.10
3;11005.69
4;14207.57
5;4510.38
6;617.00
1;9944.94
2;19632.86
3;4097.50
4;9805.37
5;6309.00
6;12177.00
1;9822.36
2;8089.41
3;19114.42
4;9829.88
5;3644.50
6;4703.45
1;34164.00
2;3382.00
3;3973.15
4;21394.28
5;6546.39
6;12460.00
1;24548.00
2;14845.53
3;32310.38
4;16329.24
6;11525.50
1;24945.09
2;21496.50
3;13534.06
4;15486.79
5;6459.45
6;11875.00
1;19173.20
2;11478.00
3;5580.50
4;10893.66
5;17340.58
6;10103.00
1;29283.50
2;27845.07
3;16100.96
6;7314.00
1;14136.66
2;5462.03
4;8056.96
5;8758.90
6;6376.70
1;7508.71
2;10962.20
3;6837.88
4;6787.96
5;3799.86
6;6790.00
1;11869.65
2;9758.71
Тестовая выборка
3;6302.22
4;14280.00
5;26456.00
6;5423.00
1;7791.00
2;3851.00
3;5855.00
4;873.00
5;3974.38
6;4327.00
1;6758.50
2;5806.00
3;15787.58
4;7083.80
5;9065.19
1;19637.33
2;1807.67
3;2852.63
4;9794.34
5;3266.00
6;7685.00
1;10282.20
2;14536.25
3;4861.00
4;5899.00
5;46216.00
6;4236.30
2;18285.71
3;14141.20
4;11398.80
5;1505.32
6;6343.80
1;10904.40
2;4151.50
3;13478.50
4;3598.15
5;6681.41
6;1018.00
2;10153.80
3;13887.19
4;9017.82
5;9952.00
6;2875.00
1;18604.00
2;7401.78
3;14488.71
4;6140.49
5;6929.15
6;6725.00
1;10959.26
2;11717.54
3;12651.14
4;5339.90
5;6368.00
6;15738.30
1;5263.00
2;14966.40
3;5212.41
4;2049.50
5;5317.50
6;1577.00
1;9182.26
2;21211.46
3;3328.12
4;3321.80
5;2145.28
6;7538.00
1;9717.04
2;6715.90
3;4734.81
4;6516.82
5;36094.90
6;3240.90
1;11433.60
2;8546.18
3;19289.00
4;10372.00
5;3250.00
6;5795.40
1;9019.00
Приложение 5. Обучающая и тестовая выборки задачи прогнозирования объема денежных операций
Выборки построены на основе ежедневных данных Сводно-Денежного Отчета Почтового отдела Тейковского почтамта, суммированием всех кодов операций за день, за период с марта 2003 по апрель 2004 года включительно.
Данные представлены в виде: день_недели; сумма
Просмотр данных сверху - вниз, слева – направо.
Обучающая выборка
5;559716.83
6;729521.00
1;94774.61
3;481055.48
4;318247.95
5;354054.31
6;465226.68
1;133446.89
2;503160.64
3;398766.15
4;355808.02
5;376816.58
6;460472.25
1;150788.72
2;812476.81
3;341889.31
4;406458.45
5;338597.09
6;733553.99
1;107542.82
2;167466.39
3;87826.48
4;80513.38
5;66248.23
6;289489.40
1;123388.58
2;549932.98
3;369771.06
4;257269.50
5;288578.55
6;486785.14
1;190133.53
2;517556.27
3;356390.69
4;346443.33
5;368673.21
6;554241.96
1;190070.36
2;585116.71
3;265517.89
4;439654.28
5;396324.40
6;545643.31
2;743275.63
3;427242.44
4;401399.18
5;112015.44
6;43708.24
1;156623.74
2;798164.14
3;396464.15
4;265221.85
5;645640.19
1;111965.39
2;628590.59
3;373400.12
4;379678.07
5;335434.92
6;541237.18
1;187227.45
2;569140.46
3;371171.70
4;413964.87
5;366924.31
6;628460.36
1;193145.95
2;660921.59
3;361405.51
4;415324.60
5;91254.76
6;49801.26
1;88958.22
2;79135.13
3;322796.12
4;384259.60
5;461189.00
6;570117.99
1;167796.00
2;521515.87
3;386728.01
4;388040.83
5;312350.54
6;536054.61
1;264053.55
2;572146.00
3;412041.62
4;348770.88
5;382188.91
6;548948.16
1;199851.43
2;652416.25
3;464171.93
4;624340.98
5;616515.09
6;107068.24
1;112007.46
2;555500.14
3;379967.20
6;446211.54
1;190384.19
2;540788.48
3;581008.93
4;401602.85
6;350651.80
1;184218.40
2;576401.36
3;364580.22
4;454152.48
5;359508.87
6;593218.38
1;188691.54
2;826152.64
3;245415.30
4;384370.17
5;408012.81
6;584605.88
1;176221.32
2;604480.12
3;111120.07
4;94706.56
5;69177.86
6;43075.17
1;338487.70
2;690460.01
3;402495.55
4;370318.87
5;396507.17
6;493228.37
1;160265.88
2;676975.72
3;614347.30
5;357818.91
6;534402.19
1;242347.02
2;693782.98
3;338250.88
4;412087.31
5;423044.01
6;637022.64
1;176880.49
2;651861.78
3;412737.23
4;341210.42
5;107787.91
6;46895.05
1;127689.71
2;312290.67
3;371812.71
4;424003.45
5;392119.46
6;522488.97
1;142003.70
2;550883.47
3;382389.64
4;323476.57
5;327640.56
6;475367.58
1;216065.16
2;573891.85
3;410056.05
4;362858.33
5;369715.86
6;652343.85
1;195233.32
2;645714.78
3;358401.47
4;408923.56
5;415790.47
6;332362.81
1;91269.47
2;62999.97
3;81008.51
4;59395.50
5;286249.24
6;572809.45
1;184410.36
2;592223.03
3;338133.82
4;358825.82
5;390192.13
6;543660.45
1;187252.10
2;600222.01
3;383647.41
4;440068.25
5;442659.17
6;588970.79
1;167687.82
2;664198.26
3;497910.63
4;421960.07
5;375681.85
6;634268.92
1;227812.15
2;721295.76
3;120739.67
4;62945.01
5;72403.25
6;24599.52
1;105481.90
2;552194.12
3;406700.63
4;389973.26
5;347614.98
6;544316.15
1;145772.72
2;665881.53
3;374931.51
4;410554.96
5;421512.26
6;552505.79
1;236638.46
2;635240.69
3;492483.87
4;343352.01
5;441739.10
6;674156.24
1;187564.96
2;684106.25
3;492314.24
4;449484.27
5;455483.51
6;53800.44
1;71858.05
2;93387.92
3;305463.34
4;324929.01
5;385441.27
6;666302.52
1;208852.06
2;609049.14
3;357143.54
4;391452.36
5;384190.47
6;631172.89
1;211240.90
2;619894.39
3;434302.35
4;386584.17
5;395701.91
6;616229.86
1;200929.76
2;632640.21
3;395122.90
4;435991.39
5;682804.23
6;495786.54
1;110889.88
2;101083.20
3;88206.20
4;62682.30
5;76673.36
6;542781.84
1;192833.91
2;649828.30
3;418054.37
4;627522.96
6;512698.14
1;211357.61
2;683836.95
3;409020.42
4;354854.36
5;392703.54
6;638794.36
1;221436.80
2;603669.54
3;442286.79
4;460739.88
5;441852.16
6;735127.53
1;191610.89
2;817105.69
3;366482.69
4;98951.05
5;64792.83
6;37867.42
1;157986.58
2;555144.61
3;421354.89
4;438294.35
5;387076.22
6;570362.82
1;168797.17
2;625090.43
3;412416.49
4;680669.37
6;562642.61
1;344116.12
2;657456.40
3;488812.86
4;467901.77
5;440650.61
6;683480.26
1;261348.40
2;937805.93
3;519627.99
4;514144.23
5;284067.26
6;98404.38
1;165922.08
Тестовая выборка
2;144410.12
3;60182.10
6;902331.71
1;155181.93
2;861996.97
4;408089.75
5;394814.34
6;580103.20
1;146009.84
2;625960.83
3;380443.44
4;348008.59
5;424511.41
6;595986.88
1;228100.43
2;682642.76
3;591541.99
4;570685.27
5;843445.11
6;630122.78
1;178027.12
2;151958.46
3;99544.17
4;64765.62
5;63054.66
6;77321.13
1;161381.83
2;813382.60
3;461267.23
4;395212.59
5;409831.31
6;612006.71
1;237239.05
2;619606.10
3;385789.64
4;428346.50
5;347638.45
6;677574.69
1;331929.76
2;611964.71
3;437273.62
4;473371.44
5;566490.54
6;707460.12
2;834131.56
3;604193.47
4;288927.97
5;117582.01
6;96805.04
1;91009.45
2;533653.66
3;397634.59
4;407704.22
5;383153.38
6;755949.72
2;226378.22
3;605743.53
4;432363.75
5;420565.79
6;535219.29
1;244329.02
2;596278.39
3;357531.76
4;385390.10
5;387544.49
6;721825.52
1;148197.23
2;829962.70
3;546787.73
4;463006.83
5;240355.90
6;82125.83
1;92329.76
2;104252.95
3;72565.30
4;289777.86
5;363312.51
6;674123.98
1;221840.08
2;621234.90
3;389391.23
4;357140.81
5;405634.27
6;659714.95
1;167946.92
2;654828.51
3;343331.54
4;361890.01
5;437108.34
6;687845.54
1;211491.34
2;700926.28
3;809428.45
4;820006.93
5;616860.38
6;120631.05
1;92021.50
Приложение 6. Исходные тексты программ
Приложение 6.1. модуль PATTRСGN
Unit PattRcgn; {Pattern ReCoGNition}
{==========================================================================}
{ простые признаки и объекты, состоящие из простых признаков }
{==========================================================================}
interface
{==========================================================================}
const
MaxCondCount=50;
MaxC_Count=10;
CIdTrue=1; {константы индексов состояний Boolean-Style признака}
CIdFalse=2;
{==========================================================================}
Type
PCondArr=^TCondArr;
TCondArr=array[1..MaxCondCount] of Real;
{простой признак объекта}
TComponentStyle=(Stl_Free,Stl_Boolean,Stl_Digital);
PComponent=^TComponent;
TComponent=object
Style:TComponentStyle;
CondCount:Word;
Min,Max,Len:Real; MinBase:Boolean;{fields for Digital-Style only}
Cond:PCondArr;
constructor InitFree(aCondCount:Word);
constructor InitBoolean;
constructor InitDigital(aCondCount:Byte;aMin,aLen,aMax:Real;aMinBase:Boolean);
destructor Done;
procedure SetCond(Index:Byte;Value:Real);
function GetCond(Index:Byte):Real;
procedure SetDCond(Value:Real); {for Digital-Style only}
function NextExistCond(PrevIndex:Byte):Byte; {zero if not found}
private
end;
{==========================================================================}
type
PCArr=^TCArr;
TCArr=Array[1..MaxC_Count] of PComponent;
PPRObject=^TPRObject;
TPRObject=object
ExistCondCount:Real;
C_Count:Byte;
C:PCArr;
constructor Init;
destructor Done;
procedure AddComponent(P:PComponent);
end;
{==========================================================================}
type
PDescItem=^TDescItem;
TDescItem=array[1..MaxC_Count] of Byte;
procedure InitDesc(D:PDescItem;Obj:PPRObject;ClassComp:Byte);
function FindNextDesc(D:PDescItem;Obj:PPRObject;ClassComp:Byte):Boolean;
function ObjCond(D:PDescItem;Obj:PPRObject):Real;
{==========================================================================}
function min(a,b:Real):real;
function max(a,b:Real):real;
{==========================================================================}
procedure Error(Msg:String);
{==========================================================================}
implementation
{==========================================================================}
procedure Error(Msg:String);
begin
Writeln(#7,Msg);
Halt(1);
end;
{==========================================================================}
constructor TComponent.InitFree(aCondCount:Word);
begin
Style:=Stl_Free;
CondCount:=aCondCount;
if (CondCount<1)or(CondCount>MaxCondCount) then Error('TComponent.InitFree:Wrong CondCount!');
GetMem(Cond,SizeOf(Real)*CondCount);
FillChar(Cond^,SizeOf(Real)*CondCount,#0);
end;
constructor TComponent.InitBoolean;
begin
Style:=Stl_Boolean;
CondCount:=2; {true, false}
GetMem(Cond,SizeOf(Real)*CondCount);
FillChar(Cond^,SizeOf(Real)*CondCount,#0);
end;
constructor TComponent.InitDigital(aCondCount:Byte;aMin,aLen,aMax:Real;aMinBase:Boolean);
begin
Style:=Stl_Digital;
CondCount:=aCondCount;
if (CondCount<1)or(CondCount>MaxCondCount) then Error('TComponent.InitDigital:Wrong CondCount!');
GetMem(Cond,SizeOf(Real)*CondCount);
FillChar(Cond^,SizeOf(Real)*CondCount,#0);
Min:=aMin;
Max:=aMax;
Len:=aLen;
MinBase:=aMinBase;
end;
destructor TComponent.Done;
begin
FreeMem(Cond,SizeOf(Real)*CondCount);
end;
procedure TComponent.SetCond(Index:Byte;Value:Real);
begin
if (Index<1)or(Index>CondCount) then Error('TComponent.SetCond:Wrong index!');
if (Value<0)or(Value>1) then Error('TComponent.SetCond:Wrong value!');
Cond^[Index]:=Value;
end;
function TComponent.GetCond(Index:Byte):Real;
begin
if (Index<1)or(Index>CondCount) then Error('TComponent.GetCond:Wrong index!');
GetCond:=Cond^[Index];
end;
procedure TComponent.SetDCond(Value:Real); {for Digital-Style only}
var
Index:Byte;
CurMin,CurMax:Real;
begin
if Style<>Stl_Digital then Error('TComponent.SetDCond:For DIGITAL-Style only!');
FillChar(Cond^,SizeOf(Real)*CondCount,#0);
CurMin:=Min;
CurMax:=Min+Len;
for Index:=1 to CondCount do
begin
if (((MinBase=false)and(CurMin<Value))or((MinBase=True)and(Min<Value)))
and(Value<=CurMax) then Cond^[Index]:=1;
CurMin:=CurMax-((Len*CondCount-(Max-Min))/(CondCount-1));
CurMax:=CurMin+Len;
end;
if Value<=Min then Cond^[1]:=1;
if Value>=Max then Cond^[CondCount]:=1;
end;
function TComponent.NextExistCond(PrevIndex:Byte):Byte;
var
Ret:Byte;
I:Byte;
begin
Ret:=0;
for I:=PrevIndex+1 to CondCount do if Cond^[I]<>0 then
begin
Ret:=I;
Break;
end;
NextExistCond:=Ret;
end;
{==========================================================================}
constructor TPRObject.Init;
begin
C_Count:=0;
ExistCondCount:=0;
C:=nil;
end;
destructor TPRObject.Done;
var
OldCCount:Byte;
begin
OldCCount:=C_Count;
While C_Count<>0 do
begin
Dispose(C^[C_Count],Done);
Dec(C_Count);
end;
if OldCCount<>0 then FreeMem(C,SizeOf(PComponent)*OldCCount);
end;
procedure TPRObject.AddComponent(P:PComponent);
var
NewC:PCArr;
I:Byte;
begin
if C_Count>=MaxC_Count then Error('TPRObject.AddComponent:Too many components!');
Inc(C_Count);
GetMem(NewC,SizeOf(PComponent)*C_Count);
for I:=1 to C_Count-1 do NewC^[I]:=C^[I];
if C<>nil then FreeMem(C,SizeOf(PComponent)*(C_Count-1));
C:=NewC;
C^[C_Count]:=P;
end;
{==========================================================================}
procedure InitDesc(D:PDescItem;Obj:PPRObject;ClassComp:Byte);
var
I:Byte;
LastComp:Byte;
begin
FillChar(D^,SizeOf(TDescItem),#0);
LastComp:=Obj^.C_Count; if LastComp=ClassComp then Dec(LastComp);
for I:=1 to Obj^.C^[LastComp]^.CondCount do if Obj^.C^[LastComp]^.GetCond(I)<>0 then
begin
D^[LastComp]:=I;
end;
end;
function FindNextDesc(D:PDescItem;Obj:PPRObject;ClassComp:Byte):Boolean;
var
NumC:Byte;
begin
if D^[ClassComp]<>0 then Error('FindNextDesc:Недопустимое использование класса!');
NumC:=Obj^.C_Count; if NumC=ClassComp then Dec(NumC);
repeat
D^[NumC]:=Obj^.C^[NumC]^.NextExistCond(D^[NumC]);
if D^[NumC]=0
then Dec(NumC)
else Break;
if (NumC<>0)and(NumC=ClassComp) then Dec(NumC);
until NumC=0;
FindNextDesc:=NumC<>0;
end;
function ObjCond(D:PDescItem;Obj:PPRObject):Real;
var
I:Byte;
Ret:Real;
begin
Ret:=1;
for I:=1 to Obj^.C_Count do if D^[I]<>0 then Ret:=min(Ret,Obj^.C^[I]^.GetCond(D^[I]));
ObjCond:=Ret;
end;
{==========================================================================}
function min(a,b:Real):real;
begin
if a<b then min:=a else min:=b;
end;
function max(a,b:Real):real;
begin
if a>b then max:=a else max:=b;
end;
{==========================================================================}
end.
Приложение 6.2. CHCK_CRD
{============================================================================}
{ Классифицирование заемщиков по их способности вернуть кредит }
{ входной файл - обучающая и тестовая выборки, разделенные пустыми строками }
{ данные о одном заемщике в виде: }
{ Credit;Age;Property;Income;WasInJail;HaveFriends;HaveHighShool;GiveCredit }
{ расположение выборок: }
{ обучающая для GiveCredit=true }
{ обучающая для GiveCredit=false }
{ тестовая для GiveCredit=true }
{ тестовая для GiveCredit=false }
{============================================================================}
Uses
Crt,
Objects,
PattRCGN;
{============================================================================}
const
{индексы признаков}
CIdAge=1;
CIdProperty=2;
CIdIncome=3;
CIdWasInJail=4;
CIdHaveFriends=5;
CIdHaveHighShool=6;
CIdGiveCredit=7;
{индексы состояний собственности}
CIdPropHouse=1;
CIdPropQuarter=2;
CIdPropCar=3;
{константы обучающей выборки}
ClassCount=2;
{шаги состояния}
StepIncome=5/100;
StepAge=25;
{============================================================================}
var
TeachSet:Array[1..ClassCount] of PCollection; {of PPRObject}
StatArr:Array[1..ClassCount] of record
TestCount:Word; {количество тестовых объектов данного класса}
TotalOut:Word; {количество тестовых объектов, отнесенных к данному классу}
RightOut:Word; {количестов тестовых объектов правильно классифицированных}
end;
{============================================================================}
procedure Init;
var
I:Byte;
begin
for I:=1 to ClassCount do TeachSet[I]:=New(PCollection, Init(1,1));
FillChar(StatArr,SizeOf(StatArr),#0);
end;
{============================================================================}
procedure Done;
var
I:Byte;
begin
for I:=1 to ClassCount do
begin
While TeachSet[I]^.Count<>0 do
begin
Dispose(PPRObject(TeachSet[I]^.At(0)),Done);
TeachSet[I]^.AtDelete(0);
end;
Dispose(TeachSet[I], Done);
end;
end;
{============================================================================}
function NewCustomer(InfoS:String):PPRObject;
{*****************}
function CutFirstElem(var S:String):String;
begin
if Pos(';',S)=0 then
begin
CutFirstElem:=S;
S:='';
end else
begin
CutFirstElem:=Copy(S,1,Pos(';',S)-1);
S:=Copy(S,Pos(';',S)+1,Length(S));
end;
end;
{*****************}
function MyVal(S:String):Real;
var
V:Real;
Temp:Integer;
begin
Val(S,V,Temp);
MyVal:=V;
end;
{*****************}
var
Obj:PPRObject;
Credit:Real;
S,S2:String;
begin
Obj:=New(PPRObject, Init);
{Credit}
Credit:=MyVal(CutFirstElem(InfoS));
{Age}
{Obj^.AddComponent(New(PComponent, InitDigital(50,15,3,100,false)));}
Obj^.AddComponent(New(PComponent, InitDigital((100-20)div StepAge,20,StepAge,100,false)));
Obj^.C^[CIdAge]^.SetDCond(MyVal(CutFirstElem(InfoS)));
{Property}
Obj^.AddComponent(New(PComponent, InitFree(3)));
S:=CutFirstElem(InfoS);
repeat
While S[1]=' ' do S:=S+Copy(S,2,Length(S));
if S='' then Break;
if Pos(' ',S)=0 then
begin
S2:=S;
S:=''
end else
begin
S2:=Copy(S,1,Pos(' ',S)-1);
S:=Copy(S,Pos(' ',S)+1,Length(S));
end;
if S2='House' then Obj^.C^[CIdProperty]^.SetCond(CIdPropHouse,1)
else if S2='Quarter' then Obj^.C^[CIdProperty]^.SetCond(CIdPropQuarter,1)
else if S2='Car' then Obj^.C^[CIdProperty]^.SetCond(CIdPropCar,1)
else Error('NewCustomer:Unknown property item "'+S2+'"!');
until S='';
{Income}
{Obj^.AddComponent(New(PComponent, InitDigital(25,0,0.05,1,false)));}
Obj^.AddComponent(New(PComponent, InitDigital(Round(1/StepIncome),0,StepIncome,1,false)));
Obj^.C^[CIdIncome]^.SetDCond(MyVal(CutFirstElem(InfoS))/Credit);
{WasInJail}
Obj^.AddComponent(New(PComponent, InitBoolean));
S:=CutFirstElem(InfoS);
if S='1'
then Obj^.C^[CIdWasInJail]^.SetCond(CIdTrue,1)
else Obj^.C^[CIdWasInJail]^.SetCond(CIdFalse,1);
{HaveFriends}
Obj^.AddComponent(New(PComponent, InitBoolean));
S:=CutFirstElem(InfoS);
if S='1'
then Obj^.C^[CIdHaveFriends]^.SetCond(CIdTrue,1)
else Obj^.C^[CIdHaveFriends]^.SetCond(CIdFalse,1);
{HaveHighShool}
Obj^.AddComponent(New(PComponent, InitBoolean));
S:=CutFirstElem(InfoS);
if S='1'
then Obj^.C^[CIdHaveHighShool]^.SetCond(CIdTrue,1)
else Obj^.C^[CIdHaveHighShool]^.SetCond(CIdFalse,1);
{GiveCredit}
Obj^.AddComponent(New(PComponent, InitBoolean));
S:=CutFirstElem(InfoS);
if S='1'
then Obj^.C^[CIdGiveCredit]^.SetCond(CIdTrue,1)
else Obj^.C^[CIdGiveCredit]^.SetCond(CIdFalse,1);
{done}
NewCustomer:=Obj;
end;
{============================================================================}
procedure CalcExistCondCount(Obj:PPRObject);
var
Desc:TDescItem;
begin
Obj^.ExistCondCount:=0;
InitDesc(@Desc,Obj,CIdGiveCredit);
repeat
Obj^.ExistCondCount:=Obj^.ExistCondCount+ObjCond(@Desc,Obj);
until FindNextDesc(@Desc,Obj,CIdGiveCredit)=false;
end;
{============================================================================}
procedure ReadTeachSet(idClass:Byte;var F:Text);
var
S:String;
Obj:PPRObject;
begin
Writeln('Загрузка обучающей выборки класса #',IdClass);
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Obj:=NewCustomer(S);
CalcExistCondCount(Obj);
TeachSet[IdClass]^.Insert(Obj);
Write('.');
end;
Writeln;
end;
{============================================================================}
procedure TestWork(IdClass:Byte;var F:Text);
var
S:String;
Obj:PPRObject;
Desc:TDescItem;
NumClass:Byte;
NumObj:Byte;
CommonCond:Array[1..ClassCount,1..255] of Real;
CurObjCond:Real;
AvrComp:Array[1..ClassCount] of Real;
SumAvrComp:Real;
MaxInd:Byte;
begin
Writeln('Обработка тестовой выборки класса #',IdClass);
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Obj:=NewCustomer(S);
Write(S);
{calc ExistCondCount}
Obj^.ExistCondCount:=0;
FillChar(CommonCond,SizeOf(CommonCond),#0);
InitDesc(@Desc,Obj,CIdGiveCredit);
repeat
CurObjCond:=ObjCond(@Desc,Obj);
Obj^.ExistCondCount:=Obj^.ExistCondCount+CurObjCond;
if CurObjCond<>0 then for NumClass:=1 to ClassCount do for NumObj:=1 to TeachSet[NumClass]^.Count do
begin
CommonCond[NumClass,NumObj]:=CommonCond[NumClass,NumObj]+
min(CurObjCond,ObjCond(@Desc,PPRObject(TeachSet[NumClass]^.At(NumObj-1))));
end;
until FindNextDesc(@Desc,Obj,CIdGiveCredit)=false;
{calc COMP}
for NumClass:=1 to ClassCount do for NumObj:=1 to TeachSet[NumClass]^.Count do
CommonCond[NumClass,NumObj]:=CommonCond[NumClass,NumObj]/
(Obj^.ExistCondCount+
PPRObject(TeachSet[NumClass]^.At(NumObj-1))^.ExistCondCount-
CommonCond[NumClass,NumObj]);
{calc Average COMP}
FillChar(AvrComp,SizeOf(AvrComp),#0);
for NumClass:=1 to ClassCount do for NumObj:=1 to TeachSet[NumClass]^.Count do
AvrComp[NumClass]:=AvrComp[NumClass]+CommonCond[NumClass,NumObj];
SumAvrComp:=0;
for NumClass:=1 to ClassCount do
begin
AvrComp[NumClass]:=AvrComp[NumClass]/TeachSet[NumClass]^.Count;
SumAvrComp:=SumAvrComp+AvrComp[NumClass];
end;
{find max in average COMP}
MaxInd:=1;
for NumClass:=2 to ClassCount do if AvrComp[NumClass]>AvrComp[MaxInd] then MaxInd:=NumClass;
GotoXY(50,WhereY);
Write(' #',MaxInd,' ',100*AvrComp[MaxInd]/SumAvrComp:5:1,'%');
{fill StatArr}
Inc(StatArr[IdClass].TestCount);
Inc(StatArr[MaxInd].TotalOut);
if MaxInd=IdClass then Inc(StatArr[MaxInd].RightOut);
{done}
Dispose(Obj, Done);
Writeln;
end;
Writeln;
end;
{============================================================================}
procedure ShowStatArr;
var
NumObj:Word;
NumClass:Byte;
I:Byte;
SumK1,SumK2,SumK3:Real;
begin
SumK1:=0; SumK2:=0; SumK3:=0;
{work}
Writeln(' # Обуч. Тест. Распознано Выведено К.точности К.доверия К.Качества');
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
for I:=1 to ClassCount do
begin
Write(' ',I:2,' ');
Write(' ',TeachSet[I]^.Count:3,' ');
Write(' ',StatArr[I].TestCount:3,' ');
Write(' ',StatArr[I].RightOut:3,' ');
Write(' ',StatArr[I].TotalOut:3,' ');
if StatArr[I].TestCount<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TestCount:1:2,' ');
SumK1:=SumK1+StatArr[I].RightOut/StatArr[I].TestCount;
end else Write(' ---- ');
if StatArr[I].TotalOut<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TotalOut:1:2,' ');
SumK2:=SumK2+StatArr[I].RightOut/StatArr[I].TotalOut;
end else Write(' ---- ');
if (StatArr[I].TestCount<>0)and(StatArr[I].TotalOut<>0)
then begin
Write(' ',Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut)):1:2);
SumK3:=SumK3+Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut));
end else Write(' ----');
Writeln;
end;
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
Writeln(' ',
' ',SumK1/ClassCount:1:2,' ',
' ',SumK2/ClassCount:1:2,' ',
' ',SumK3/ClassCount:1:2);
end;
{============================================================================}
var
F:Text;
begin
ClrScr;
if ParamCount=0 then Error('Need to be: '+ParamStr(0)+' <data_file>');
Init;
Assign(F,ParamStr(1)); Reset(F);
Readln(F); {skip header}
ReadTeachSet(CIdTrue,F);
ReadTeachSet(CIdFalse,F);
TestWork(CIdTrue,F);
TestWork(CIdFalse,F);
ShowStatArr;
Close(F);
Done;
end.
Приложение 6.3. CAR_PAY
{============================================================================}
{ Оценка стоимости подержанных автомобилей в процентах от стоимости нового }
{ автомобиля данной марки }
{ Данные поступают в виде: }
{ Age|RunLength|GoodCO2|CorrDef|BodyBreak|Price }
{ Тестовая выборка отделена от обучающей пустой строкой }
{============================================================================}
Uses
Crt,
Objects,
PattRCGN;
{============================================================================}
const
{индексы признаков}
CIdAge=1;
CIdRunLength=2;
CIdGoodCO2=3;
CIdCorrDef=4;
CIdBodyBreak=5;
CIdPrice=6;
{костанты обучающей выборки}
ClassCount=10;
MaxTeachSetSize=500;
{шаги состояния}
StepAge=4; {1 2 3 4}
StepRun=40000; {10000 20000 30000 40000}
{============================================================================}
var
TeachSet:PCollection; {of PPRObject}
StatArr:Array[1..ClassCount] of record
TestCount:Word; {количество тестовых объектов данного класса}
TotalOut:Word; {количество тестовых объектов, отнесенных к данному классу}
RightOut:Word; {количестов тестовых объектов правильно классифицированных}
end;
Otkl:Real;
{============================================================================}
procedure Init;
var
I:Byte;
begin
TeachSet:=New(PCollection, Init(1,1));
FillChar(StatArr,SizeOf(StatArr),#0);
end;
{============================================================================}
procedure Done;
begin
While TeachSet^.Count<>0 do
begin
Dispose(PPRObject(TeachSet^.At(0)),Done);
TeachSet^.AtDelete(0);
end;
Dispose(TeachSet, Done);
end;
{============================================================================}
function NewCar(InfoS:String):PPRObject;
{*****************}
function CutFirstElem(var S:String):String;
begin
if Pos(';',S)=0 then
begin
CutFirstElem:=S;
S:='';
end else
begin
CutFirstElem:=Copy(S,1,Pos(';',S)-1);
S:=Copy(S,Pos(';',S)+1,Length(S));
end;
end;
{*****************}
function MyVal(S:String):Real;
var
V:Real;
Temp:Integer;
begin
Val(S,V,Temp);
MyVal:=V;
end;
{*****************}
var
Obj:PPRObject;
Credit:Real;
S,S2:String;
I:Byte;
begin
Obj:=New(PPRObject, Init);
{Age}
Obj^.AddComponent(New(PComponent, InitDigital(20 div StepAge,0,StepAge,20,false)));
Obj^.C^[CIdAge]^.SetDCond(MyVal(CutFirstElem(InfoS)));
{RunLength}
Obj^.AddComponent(New(PComponent, InitDigital(200000 div StepRun,10000,StepRun,200000,false)));
Obj^.C^[CIdRunLength]^.SetDCond(MyVal(CutFirstElem(InfoS)));
{GoodCO2}
Obj^.AddComponent(New(PComponent, InitBoolean));
S:=CutFirstElem(InfoS);
if S='1'
then Obj^.C^[CIdGoodCO2]^.SetCond(CIdTrue,1)
else Obj^.C^[CIdGoodCO2]^.SetCond(CIdFalse,1);
{CorrDef}
Obj^.AddComponent(New(PComponent, InitBoolean));
S:=CutFirstElem(InfoS);
if S='1'
then Obj^.C^[CIdCorrDef]^.SetCond(CIdTrue,1)
else Obj^.C^[CIdCorrDef]^.SetCond(CIdFalse,1);
{BodyBreak}
Obj^.AddComponent(New(PComponent, InitDigital(5,1,1,5,false)));
Obj^.C^[CIdBodyBreak]^.SetDCond(MyVal(CutFirstElem(InfoS)));
{Price}
Obj^.AddComponent(New(PComponent, InitFree(ClassCount)));
S:=CutFirstElem(InfoS);
for I:=1 to ClassCount do if MyVal(S)<=I*100/ClassCount then
begin
{if I<>1 then Obj^.C^[CIdPrice]^.SetCond(I-1,0.5);
if I<>ClassCount then Obj^.C^[CIdPrice]^.SetCond(I+1,0.5);}
Obj^.C^[CIdPrice]^.SetCond(I,1);
Break;
end;
{done}
NewCar:=Obj;
end;
{============================================================================}
procedure CalcExistCondCount(Obj:PPRObject);
var
Desc:TDescItem;
begin
Obj^.ExistCondCount:=0;
InitDesc(@Desc,Obj,CIdPrice);
repeat
Obj^.ExistCondCount:=Obj^.ExistCondCount+ObjCond(@Desc,Obj);
until FindNextDesc(@Desc,Obj,CIdPrice)=false;
end;
{============================================================================}
procedure ReadTeachSet(var F:Text);
var
S:String;
Obj:PPRObject;
begin
Writeln('Загрузка обучающей выборки');
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Obj:=NewCar(S);
CalcExistCondCount(Obj);
TeachSet^.Insert(Obj);
if TeachSet^.Count>MaxTeachSetSize then Error('ReadTeachSet:Too big teach set size!');
Write('.');
end;
Writeln;
end;
{============================================================================}
procedure TestWork(var F:Text);
var
S:String;
Obj:PPRObject;
Desc:TDescItem;
NumClass:Byte;
NumObj:Word;
CommonCond:Array[1..MaxTeachSetSize] of Real;
CurObjCond:Real;
AvrComp:Array[1..ClassCount] of Real;
SumAvrComp:Real;
MaxInd:Byte;
TeachCount:Array[1..ClassCount] of Word;
TestCount:Word;
begin
Otkl:=0;
TestCount:=0;
{calc TeachCount}
FillChar(TeachCount,SizeOf(TeachCount),#0);
for NumObj:=1 to TeachSet^.Count do for NumClass:=1 to ClassCount do
if PPRObject(TeachSet^.At(NumObj-1))^.C^[CIdPrice]^.GetCond(NumClass)<>0
then Inc(TeachCount[NumClass]);
{work}
Writeln('Обработка тестовой выборки');
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Inc(TestCount);
Obj:=NewCar(S);
Write(S);
{calc ExistCondCount}
Obj^.ExistCondCount:=0;
FillChar(CommonCond,SizeOf(CommonCond),#0);
InitDesc(@Desc,Obj,CIdPrice);
repeat
CurObjCond:=ObjCond(@Desc,Obj);
Obj^.ExistCondCount:=Obj^.ExistCondCount+CurObjCond;
if CurObjCond<>0 then for NumObj:=1 to TeachSet^.Count do
begin
CommonCond[NumObj]:=CommonCond[NumObj]+min(CurObjCond,ObjCond(@Desc,PPRObject(TeachSet^.At(NumObj-1))));
end;
until FindNextDesc(@Desc,Obj,CIdPrice)=false;
{calc COMP}
FillChar(AvrComp,SizeOf(AvrComp),#0);
for NumObj:=1 to TeachSet^.Count do
begin
CommonCond[NumObj]:=CommonCond[NumObj]/
(Obj^.ExistCondCount+
PPRObject(TeachSet^.At(NumObj-1))^.ExistCondCount-
CommonCond[NumObj]);
for NumClass:=1 to ClassCount do
if (PPRObject(TeachSet^.At(NumObj-1))^.C^[CIdPrice]^.GetCond(NumClass)<>0)and(TeachCount[NumClass]<>0) then
AvrComp[NumClass]:=AvrComp[NumClass]+CommonCond[NumObj];
end;
{Calc Average COMP}
SumAvrComp:=0;
for NumClass:=1 to ClassCount do if TeachCount[NumClass]<>0 then
begin
AvrComp[NumClass]:=AvrComp[NumClass]/TeachCount[NumClass];
SumAvrComp:=SumAvrComp+AvrComp[NumClass];
end;
{find max in average COMP}
MaxInd:=1;
for NumClass:=2 to ClassCount do if AvrComp[NumClass]>AvrComp[MaxInd] then MaxInd:=NumClass;
GotoXY(40,WhereY);
for NumClass:=1 to ClassCount do if Obj^.C^[CIdPrice]^.GetCond(NumClass)<>0 then Write(' #',NumClass);
GotoXY(50,WhereY);
for NumClass:=1 to ClassCount do if AvrComp[MaxInd]=AvrComp[NumClass] then Write(' #',NumClass);
Write(' ',100*AvrComp[MaxInd]/SumAvrComp:5:1,'%');
{fill StatArr}
for NumClass:=1 to ClassCount do
begin
if Obj^.C^[CIdPrice]^.GetCond(NumClass)<>0 then
begin
Inc(StatArr[NumClass].TestCount);
if AvrComp[MaxInd]=AvrComp[NumClass] then Inc(StatArr[NumClass].RightOut);
Otkl:=Otkl+Abs(Integer(MaxInd)-NumClass);
end;
if AvrComp[MaxInd]=AvrComp[NumClass] then Inc(StatArr[NumClass].TotalOut);
end;
{done}
Dispose(Obj, Done);
Writeln;
end;
Otkl:=Otkl/TestCount;
Writeln;
end;
{============================================================================}
procedure ShowStatArr;
var
NumObj:Word;
NumClass:Byte;
I:Byte;
TeachCount:Array[1..ClassCount] of Word;
SumK1,SumK2,SumK3:Real;
begin
SumK1:=0; SumK2:=0; SumK3:=0;
{calc TeachCount}
FillChar(TeachCount,SizeOf(TeachCount),#0);
for NumObj:=1 to TeachSet^.Count do for NumClass:=1 to ClassCount do
if PPRObject(TeachSet^.At(NumObj-1))^.C^[CIdPrice]^.GetCond(NumClass)<>0
then Inc(TeachCount[NumClass]);
{work}
Writeln(' # Обуч. Тест. Распознано Выведено К.точности К.доверия К.Качества');
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
for I:=1 to ClassCount do
begin
Write(' ',I:2,' ');
Write(' ',TeachCount[I]:3,' ');
Write(' ',StatArr[I].TestCount:3,' ');
Write(' ',StatArr[I].RightOut:3,' ');
Write(' ',StatArr[I].TotalOut:3,' ');
if StatArr[I].TestCount<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TestCount:1:2,' ');
SumK1:=SumK1+StatArr[I].RightOut/StatArr[I].TestCount;
end else Write(' ---- ');
if StatArr[I].TotalOut<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TotalOut:1:2,' ');
SumK2:=SumK2+StatArr[I].RightOut/StatArr[I].TotalOut;
end else Write(' ---- ');
if (StatArr[I].TestCount<>0)and(StatArr[I].TotalOut<>0)
then begin
Write(' ',Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut)):1:2);
SumK3:=SumK3+Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut));
end else Write(' ----');
Writeln;
end;
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
Writeln(' ',
' ',SumK1/ClassCount:1:2,' ',
' ',SumK2/ClassCount:1:2,' ',
' ',SumK3/ClassCount:1:2);
Writeln('Среднее отклонение: ',Otkl*(100/ClassCount):1:1,'%');
end;
{============================================================================}
var
F:Text;
begin
ClrScr;
if ParamCount=0 then Error('Need to be: '+ParamStr(0)+' <data_file>');
Init;
Assign(F,ParamStr(1)); Reset(F);
Readln(F); {skip header}
ReadTeachSet(F);
TestWork(F);
ShowStatArr;
Close(F);
Done;
end.
Приложение 6.4. CHCK_MRK
{============================================================================}
{ Классификация поведения уровня цен на фондовой бирже (снижение,нет,рост) }
{ Данные поступают в виде: }
{ Stavka|Kurs|StavkaReserv|ObrReserv|Prices }
{ расположение выборок: }
{ обучающая для Prices=GoDown }
{ обучающая для Prices=GoNone }
{ обучающая для Prices=GoUp }
{ тестовая для Prices=GoDown }
{ тестовая для Prices=GoNone }
{ тестовая для Prices=GoUp }
{============================================================================}
Uses
Crt,
Objects,
PattRCGN;
{============================================================================}
const
{индексы признаков}
CIdStavka=1;
CIdKurs=2;
CIdStavkaReserv=3;
CIdObrReserv=4;
CIdPrices=5;
{индексы состояний}
CIDGoDown=1;
CIdGoNone=2;
CIdGoUp=3;
{константы обучающей выборки}
ClassCount=3;
{============================================================================}
var
TeachSet:Array[1..ClassCount] of PCollection; {of PPRObject}
StatArr:Array[1..ClassCount] of record
TestCount:Word; {количество тестовых объектов данного класса}
TotalOut:Word; {количество тестовых объектов, отнесенных к данному классу}
RightOut:Word; {количестов тестовых объектов правильно классифицированных}
end;
{============================================================================}
procedure Init;
var
I:Byte;
begin
for I:=1 to ClassCount do TeachSet[I]:=New(PCollection, Init(1,1));
FillChar(StatArr,SizeOf(StatArr),#0);
end;
{============================================================================}
procedure Done;
var
I:Byte;
begin
for I:=1 to ClassCount do
begin
While TeachSet[I]^.Count<>0 do
begin
Dispose(PPRObject(TeachSet[I]^.At(0)),Done);
TeachSet[I]^.AtDelete(0);
end;
Dispose(TeachSet[I], Done);
end;
end;
{============================================================================}
function NewMarket(InfoS:String):PPRObject;
{*****************}
function CutFirstElem(var S:String):String;
begin
if Pos(';',S)=0 then
begin
CutFirstElem:=S;
S:='';
end else
begin
CutFirstElem:=Copy(S,1,Pos(';',S)-1);
S:=Copy(S,Pos(';',S)+1,Length(S));
end;
end;
{*****************}
function MyVal(S:String):Real;
var
V:Real;
Temp:Integer;
begin
Val(S,V,Temp);
MyVal:=V;
end;
{*****************}
var
Obj:PPRObject;
S:String;
I:Byte;
begin
Obj:=New(PPRObject, Init);
for I:=1 to 5 do
begin
S:=CutFirstElem(InfoS);
Obj^.AddComponent(New(PComponent, InitFree(3)));
case Round(MyVal(S)) of
-1:Obj^.C^[I]^.SetCond(CIdGoDown,1);
0:Obj^.C^[I]^.SetCond(CIdGoNone,1);
+1:Obj^.C^[I]^.SetCond(CIdGoUp,1);
else Error('NewMarket:Unknown data format!');
end;
end;
NewMarket:=Obj;
end;
{============================================================================}
procedure CalcExistCondCount(Obj:PPRObject);
var
Desc:TDescItem;
begin
Obj^.ExistCondCount:=0;
InitDesc(@Desc,Obj,CIdPrices);
repeat
Obj^.ExistCondCount:=Obj^.ExistCondCount+ObjCond(@Desc,Obj);
until FindNextDesc(@Desc,Obj,CIdPrices)=false;
end;
{============================================================================}
procedure ReadTeachSet(idClass:Byte;var F:Text);
var
S:String;
Obj:PPRObject;
begin
Writeln('Загрузка обучающей выборки класса #',IdClass);
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Obj:=NewMarket(S);
CalcExistCondCount(Obj);
TeachSet[IdClass]^.Insert(Obj);
Write('.');
end;
Writeln;
end;
{============================================================================}
procedure TestWork(IdClass:Byte;var F:Text);
var
S:String;
Obj:PPRObject;
Desc:TDescItem;
NumClass:Byte;
NumObj:Byte;
CommonCond:Array[1..ClassCount,1..255] of Real;
CurObjCond:Real;
AvrComp:Array[1..ClassCount] of Real;
SumAvrComp:Real;
MaxInd:Byte;
begin
Writeln('Обработка тестовой выборки класса #',IdClass);
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Obj:=NewMarket(S);
Write(S);
{calc ExistCondCount}
Obj^.ExistCondCount:=0;
FillChar(CommonCond,SizeOf(CommonCond),#0);
InitDesc(@Desc,Obj,CIdPrices);
repeat
CurObjCond:=ObjCond(@Desc,Obj);
Obj^.ExistCondCount:=Obj^.ExistCondCount+CurObjCond;
if CurObjCond<>0 then for NumClass:=1 to ClassCount do for NumObj:=1 to TeachSet[NumClass]^.Count do
begin
CommonCond[NumClass,NumObj]:=CommonCond[NumClass,NumObj]+
min(CurObjCond,ObjCond(@Desc,PPRObject(TeachSet[NumClass]^.At(NumObj-1))));
end;
until FindNextDesc(@Desc,Obj,CIdPrices)=false;
{calc COMP}
for NumClass:=1 to ClassCount do for NumObj:=1 to TeachSet[NumClass]^.Count do
CommonCond[NumClass,NumObj]:=CommonCond[NumClass,NumObj]/
(Obj^.ExistCondCount+
PPRObject(TeachSet[NumClass]^.At(NumObj-1))^.ExistCondCount-
CommonCond[NumClass,NumObj]);
{calc Average COMP}
FillChar(AvrComp,SizeOf(AvrComp),#0);
for NumClass:=1 to ClassCount do for NumObj:=1 to TeachSet[NumClass]^.Count do
AvrComp[NumClass]:=AvrComp[NumClass]+CommonCond[NumClass,NumObj];
SumAvrComp:=0;
for NumClass:=1 to ClassCount do
begin
AvrComp[NumClass]:=AvrComp[NumClass]/TeachSet[NumClass]^.Count;
SumAvrComp:=SumAvrComp+AvrComp[NumClass];
end;
{find max in average COMP}
MaxInd:=1;
for NumClass:=2 to ClassCount do if AvrComp[NumClass]>AvrComp[MaxInd] then MaxInd:=NumClass;
GotoXY(50,WhereY);
Write(' #',MaxInd,' ',100*AvrComp[MaxInd]/SumAvrComp:5:1,'%');
{fill StatArr}
Inc(StatArr[IdClass].TestCount);
Inc(StatArr[MaxInd].TotalOut);
if MaxInd=IdClass then Inc(StatArr[MaxInd].RightOut);
{done}
Dispose(Obj, Done);
Writeln;
end;
Writeln;
end;
{============================================================================}
procedure ShowStatArr;
var
NumObj:Word;
NumClass:Byte;
I:Byte;
SumK1,SumK2,SumK3:Real;
begin
SumK1:=0; SumK2:=0; SumK3:=0;
{work}
Writeln(' # Обуч. Тест. Распознано Выведено К.точности К.доверия К.Качества');
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
for I:=1 to ClassCount do
begin
Write(' ',I:2,' ');
Write(' ',TeachSet[I]^.Count:3,' ');
Write(' ',StatArr[I].TestCount:3,' ');
Write(' ',StatArr[I].RightOut:3,' ');
Write(' ',StatArr[I].TotalOut:3,' ');
if StatArr[I].TestCount<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TestCount:1:2,' ');
SumK1:=SumK1+StatArr[I].RightOut/StatArr[I].TestCount;
end else Write(' ---- ');
if StatArr[I].TotalOut<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TotalOut:1:2,' ');
SumK2:=SumK2+StatArr[I].RightOut/StatArr[I].TotalOut;
end else Write(' ---- ');
if (StatArr[I].TestCount<>0)and(StatArr[I].TotalOut<>0)
then begin
Write(' ',Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut)):1:2);
SumK3:=SumK3+Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut));
end else Write(' ----');
Writeln;
end;
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
Writeln(' ',
' ',SumK1/ClassCount:1:2,' ',
' ',SumK2/ClassCount:1:2,' ',
' ',SumK3/ClassCount:1:2);
end;
{============================================================================}
var
F:Text;
begin
ClrScr;
if ParamCount=0 then Error('Need to be: '+ParamStr(0)+' <data_file>');
Init;
Assign(F,ParamStr(1)); Reset(F);
Readln(F); {skip header}
ReadTeachSet(CIdGoDown,F);
ReadTeachSet(CIdGoNone,F);
ReadTeachSet(CIdGoUp,F);
TestWork(CIdGoDown,F);
TestWork(CIdGoNone,F);
TestWork(CIdGoUp,F);
ShowStatArr;
Close(F);
Done;
end.
Приложение 6.5. PRF
{ прогнозирование по Почтовому отделу ОСП Тейковский почтамт }
Uses
Crt,
Objects,
PattRCGN;
{===========================================================================}
const
HistoryLen=5; {1 2 3 4 5}
MaxCntCount=500;
{Class constants}
ClassCount=25; {5 10 15 20 25}
MinClassRange= 0;
MaxClassRange=200;
StepRange=(MaxClassRange-MinClassRange)/ClassCount;
CIdClass=2; {index of Class-component}
{===========================================================================}
Type
PContainer=^TContainer;
TContainer=record
C:Array[1..HistoryLen] of PPRObject;
CondCount:Real;
Class:Byte;
end;
{===========================================================================}
procedure Error(Msg:String);
begin
Writeln(#7,Msg);
Halt(1);
end;
{===========================================================================}
var
StatArr:Array[1..ClassCount] of record
TeachCount:Word;
TestCount:Word;
TotalOut:Word;
RightOut:Word;
end;
Obj:PCollection; {of PPRObject}
Cnt:PCollection; {of PContainer}
PrevObjValue:Real;
MaxObjCondCount:LongInt;
TeachCount:Word;
Otkl:Real;
{===========================================================================}
function NewObj(InfoS:String):PPRObject;
{*****************}
function CutFirstElem(var S:String):String;
begin
if Pos(';',S)=0 then
begin
CutFirstElem:=S;
S:='';
end else
begin
CutFirstElem:=Copy(S,1,Pos(';',S)-1);
S:=Copy(S,Pos(';',S)+1,Length(S));
end;
end;
{*****************}
function MyVal(S:String):Real;
var
V:Real;
Temp:Integer;
begin
Val(S,V,Temp);
MyVal:=V;
end;
{*****************}
var
Ret:PPRObject;
Buff,V:Real;
I:Byte;
begin
Ret:=New(PPRObject, Init);
{add First item}
if CIdClass=2 then
begin
if Pos(';',InfoS)=0 then Error('NewObj:Need two of components!');
Ret^.AddComponent(New(PComponent, InitFree(7)));
Ret^.C^[1]^.SetCond(Round(MyVal(CutFirstElem(InfoS))),1)
end else if Pos(';',InfoS)<>0 then CutFirstElem(InfoS);
{add Class component}
Ret^.AddComponent(New(PComponent, InitFree(ClassCount)));
Buff:=MyVal(CutFirstElem(InfoS));
if Obj^.Count=0 then V:=100 else V:=100*Buff/PrevObjValue;
PrevObjValue:=Buff;
for I:=1 to ClassCount do if (V>=MinClassRange+(I-1)*StepRange)and(V<=MinClassRange+I*StepRange) then
begin
Ret^.C^[CIdClass]^.SetCond(I,1);
Break;
end;
if V<=MinClassRange then Ret^.C^[CIdClass]^.SetCond(1,1);
if V>=MaxClassRange then Ret^.C^[CIdClass]^.SetCond(ClassCount,1);
NewObj:=Ret;
end;
{===========================================================================}
procedure Init;
begin
Obj:=New(PCollection, Init(1,1));
Cnt:=New(PCollection, Init(1,1));
FillChar(StatArr, SizeOf(StatArr),#0);
Otkl:=0;
end;
{===========================================================================}
procedure Done;
begin
While Obj^.Count<>0 do
begin
Dispose(PPRObject(Obj^.At(0)),Done);
Obj^.AtDelete(0);
end;
Dispose(Obj, Done);
While Cnt^.Count<>0 do
begin
Dispose(PContainer(Cnt^.At(0)));
Cnt^.AtDelete(0);
end;
Dispose(Cnt,Done);
end;
{===========================================================================}
function NewContainer(NumObj:Word):PContainer;
var
Ret:PContainer;
I:Word;
begin
Ret:=New(Pcontainer);
for I:=1 to HistoryLen do Ret^.C[I]:=Obj^.At(NumObj-HistoryLen-1+I-1);
Ret^.CondCount:=0;
Ret^.Class:=0;
for I:=1 to ClassCount do if PPRObject(Obj^.At(NumObj-1))^.C^[CIDClass]^.GetCond(I)=1 then
begin
Ret^.Class:=I;
{if I>1 then PPRObject(Obj^.At(NumObj-1))^.C^[CIDClass]^.SetCond(I-1,0.3);
if I<ClassCount then PPRObject(Obj^.At(NumObj-1))^.C^[CIDClass]^.SetCond(I+1,0.3);
if I>2 then PPRObject(Obj^.At(NumObj-1))^.C^[CIDClass]^.SetCond(I-2,0.1);
if I<ClassCount-1 then PPRObject(Obj^.At(NumObj-1))^.C^[CIDClass]^.SetCond(I+2,0.1);}
Break;
end;
NewContainer:=Ret;
end;
{===========================================================================}
type
PCDesc=^TCDesc;
TCDesc=array[1..HistoryLen] of LongInt;
procedure DescItemByLongInt(D:PDescItem;L:LongInt;C_Count:Byte);
var
I:Byte;
begin
FillChar(D^,SizeOf(TDescItem),#0);
for I:=1 to C_Count-1 do {C_Count must be in [1,2]}
begin
D^[I]:=L div (ClassCount+1);
L:=L mod (ClassCount+1);
end;
D^[C_Count]:=L;
end;
procedure InitCDesc(D:PCDesc);
begin
FillChar(D^,SizeOf(TCDesc),#0);
D^[HistoryLen]:=1;
end;
function FindNextCDesc(D:PCDesc;P:PContainer):Boolean;
{*************************}
function FindObjInThisCond(Index:Byte):Real;
var
DObj:TDescItem;
I:Byte;
R:Real;
L:LongInt;
BegC,FinC:Byte;
begin
{find StartC,FinC}
FinC:=Index;
if Index=1 then BegC:=0
else if Index=HistoryLen then BegC:=HistoryLen-1
else begin
BegC:=0;
for I:=1 to Index-1 do
if D^[I]=0
then FinC:=HistoryLen
else Inc(BegC);
end;
{find in C}
L:=D^[Index];
DescItemByLongInt(@DObj,L,P^.C[1]^.C_Count);
I:=BegC+1;
repeat
R:=ObjCond(@DObj,P^.C[I]);
Inc(I);
until (I>FinC)or(R<>0);
FindObjInThisCond:=R;
end;
{*************************}
var
Ret:Boolean;
I:Byte;
begin
Ret:=True;
I:=HistoryLen;
repeat
if D^[I]<>MaxObjCondCount then
begin
Inc(D^[I]);
if FindObjInThisCond(I)<>0 then Break;
end else
begin
D^[I]:=0;
Dec(I);
end;
until I<1;
if I<1 then Ret:=False;
FindNextCDesc:=Ret;
end;
function FoundInCDesc(D:PCDesc;P:PContainer):Real;
{********************}
function PG(NumCol,NumObj:Byte):Real;
var
I:Byte;
Max:Real;
Buff:Real;
DObj:TDescItem;
CurObj:PPRObject;
begin
if (NumCol>HistoryLen)and(NumObj>HistoryLen) then PG:=1
else if (NumCol>HistoryLen)and(NumObj<=HistoryLen) then PG:=0
else if (NumCol<=HistoryLen)and(NumObj>HistoryLen) then PG:=0
else if D^[NumCol]=0 then
begin
for I:=NumObj to HistoryLen do
begin
Buff:=PG(NumCol+1,I);
if (I=NumObj)or(Buff>Max) then Max:=Buff;
end;
PG:=Max;
end else
begin
CurObj:=P^.C[NumObj];
DescItemByLongInt(@DObj,D^[NumCol],CurObj^.C_Count);
{calc PG}
PG:=min(ObjCond(@DObj,CurObj),PG(NumCol+1,NumObj+1));
end;
end;
{********************}
begin
FoundInCDesc:=PG(1,1);
end;
procedure CalcCondCount(P:PContainer);
var
D:TCDesc;
begin
P^.CondCount:=0;
InitCDesc(@D);
repeat
P^.CondCount:=P^.CondCount+FoundInCDesc(@D,P);
until FindNextCDesc(@D,P)=false;
end;
{===========================================================================}
procedure WorkTestCnt(P:PContainer);
var
CommonCond:Array[1..MaxCntCount] of Real;
D:TCDesc;
I:Word;
R:Real;
AvrComP:Array[1..ClassCount] of Real;
MaxInd:Byte;
begin
if Cnt^.Count>MaxCntCount then Error('WorkTestCnt:Too many containers!');
Write('FactClass=',P^.Class);
{find all Cond`s}
FillChar(AvrComp,SizeOf(AvrComp),#0);
FillChar(CommonCond,SizeOf(CommonCond),#0);
P^.CondCount:=0;
InitCDesc(@D);
repeat
R:=FoundInCDesc(@D,P);
P^.CondCount:=P^.CondCount+R;
if R<>0 then for I:=1 to TeachCount do
CommonCond[I]:=CommonCond[I]+min(R,FoundInCDesc(@D,PContainer(Cnt^.At(I-1))));
until FindNextCDesc(@D,P)=false;
{comp}
for I:=1 to TeachCount {without this Container} do
AvrComp[PContainer(Cnt^.At(I-1))^.Class]:=AvrComp[PContainer(Cnt^.At(I-1))^.Class]+
(
CommonCond[I]/(P^.CondCount+PContainer(Cnt^.At(I-1))^.CondCount-CommonCond[I])
);
for I:=1 to ClassCount do
begin
if StatArr[I].TeachCount<>0
then AvrComp[I]:=AvrComp[I]/StatArr[I].TeachCount
else AvrComp[I]:=0;
{Write(' ',AvrComp[I]:7:4);}
end;
{find MaxInd}
MaxInd:=1;
for I:=2 to ClassCount do if AvrComp[I]>AvrComp[MaxInd] then MaxInd:=I;
Write(' [',MaxInd,']');
{fill StatArr}
Inc(StatArr[MaxInd].TotalOut);
if MaxInd=P^.Class
then Inc(StatArr[MaxInd].RightOut)
else Otkl:=Otkl+Abs(Integer(MaxInd)-P^.Class);
{done}
Writeln;
end;
{===========================================================================}
procedure ShowStatArr;
var
NumObj:Word;
NumClass:Byte;
I:Byte;
SumK1,SumK2,SumK3:Real;
begin
SumK1:=0; SumK2:=0; SumK3:=0;
{work}
Writeln(' # Обуч. Тест. Распознано Выведено К.точности К.доверия К.Качества');
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
for I:=1 to ClassCount do
begin
Write(' ',I:2,' ');
Write(' ',StatArr[I].TeachCount:3,' ');
Write(' ',StatArr[I].TestCount:3,' ');
Write(' ',StatArr[I].RightOut:3,' ');
Write(' ',StatArr[I].TotalOut:3,' ');
if StatArr[I].TestCount<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TestCount:1:2,' ');
SumK1:=SumK1+StatArr[I].RightOut/StatArr[I].TestCount;
end else Write(' ---- ');
if StatArr[I].TotalOut<>0
then begin
Write(' ',StatArr[I].RightOut/StatArr[I].TotalOut:1:2,' ');
SumK2:=SumK2+StatArr[I].RightOut/StatArr[I].TotalOut;
end else Write(' ---- ');
if (StatArr[I].TestCount<>0)and(StatArr[I].TotalOut<>0)
then begin
Write(' ',Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut)):1:2);
SumK3:=SumK3+Sqrt((StatArr[I].RightOut/StatArr[I].TestCount)*(StatArr[I].RightOut/StatArr[I].TotalOut));
end else Write(' ----');
Writeln;
end;
Writeln('=== ===== ===== ========== ======== ========== ========= ==========');
Writeln(' ',
' ',SumK1/ClassCount:1:2,' ',
' ',SumK2/ClassCount:1:2,' ',
' ',SumK3/ClassCount:1:2);
Writeln('Среднее отклонение: ',Otkl*(100/ClassCount):1:1,'%');
end;
{============================================================================}
var
F:Text;
S:String;
NumObj:Word;
I:Word;
begin
if ParamCount=0 then Error(ParamStr(0)+' <file_name>');
Init;
ClrScr;
Assign(F,ParamStr(1)); Reset(F);
{read Obj`s}
Write('Load objs ');
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Obj^.Insert(NewObj(S));
Write('.');
end;
Writeln;
{calc MaxObjCondCount}
MaxObjCondCount:=1;
for I:=1 to PPRObject(Obj^.At(0))^.C_Count do
MaxObjCondCount:=MaxObjCondCount*(PPRObject(Obj^.At(0))^.C^[I]^.CondCount+1);
Dec(MaxObjCondCount);
{generate teachset containers}
Write('Generate containers ');
for NumObj:=HistoryLen+1 to Obj^.Count do
begin
Cnt^.Insert(NewContainer(NumObj));
CalcCondCount(Cnt^.At(Cnt^.Count-1));
Inc(StatArr[PContainer(Cnt^.At(Cnt^.Count-1))^.Class].TeachCount);
Write('.');
end;
TeachCount:=Cnt^.Count;
Writeln;
{work with test set}
Writeln('Work with test set');
While not(Eof(F)) do
begin
Readln(F,S);
if S='' then Break;
Obj^.Insert(NewObj(S));
Cnt^.Insert(NewContainer(Obj^.Count));
Inc(StatArr[PContainer(Cnt^.At(Cnt^.Count-1))^.Class].TestCount);
WorkTestCnt(Cnt^.At(Cnt^.Count-1));
end;
{show stat arr}
Otkl:=Otkl/(Cnt^.Count-TeachCount);
ShowStatArr;
{done}
Close(F);
Sound(100); Delay(50); Sound(500); Delay(50); Sound(100); Delay(50); NoSound;
Done;
end.
|