новости  материалы  справочник  форум  гостевая  ссылки  
Новости
Материалы
  Логические подходы
  Нейронные сети
  Генетические алгоритмы
  Разное
  Публикации
  Алгоритмы
  Применение
Справочник
Форум
Гостевая книга
Ссылки
О сайте
 

Приложения

Приложение 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.


Предыдущая Содержание Следующая